Статья: Web Services и MS Visual FoxPro Часть 2

• Новые методы разработки приложений.
• Проблема.
• Дизайн. Создание базы данных.

Приступим к созданию более сложного примера, сделав который Вы получите необходимые навыки для применения технологии в повседневной жизни и не только. Мы постараемся рассказать Вам, как рекомендует Microsoft создавать приложения с нуля, условно разбив этот путь на три основных части:

В последнее время очень модно стало для разработки моделей баз данных использование всевозможных средств визуального моделирования даже на основе языка UML. Ваш покорный слуга написал на эту тему диссертацию, и чтоб не провалить ее окончательно присоединился к группе товарищей, которые предложили специальное расширение UML, чтобы с его помощью можно было создавать графические модели баз данных.

В этом направлении все сильно запущено, но все-таки воспользуемся привычным для западного человека графическим изображением модели базы данных, применив для этого ERM диаграмму и условно-бесплатный редактор QSEE Superlight. В общем-то ничего сложного для своего примера мы брать и не собирались:

*/--------------------------------------------------------------------------/*
*
* MS VFP version..: 9.0 (так как применим новые данные совместимые с SQL Server)
* Program-ID......: DB_CREATE.PRG
* Purpose.........: Создание базы данных для проекта обмена сообщениями внутри 
*                   компании. Данная база данных должна находится в дирректории
*                   где Ваш Web Service (это сделано только для простоты
*                   понимания данного проекта)
* Project Manager.: 
* Programmer......: Sergey Chavlytko
* Start...........: 22/05/2005
* Last edited.....: 07/06/2005
*
* (С) www.sergey.co.uk 2005
*/--------------------------------------------------------------------------/*
SET SAFETY OFF
CLOSE DATABASES ALL
PUBLIC m.pcpath
m.pcpath='C:\WS_MESSAGE\SERVER\'
* Так-как у нас SET SAFETY OFF
* предыдущая база будет удалена без предупреждения
IF FILE(m.pcpath+'\DBWS.DBC')
  DELETE DATABASE (m.pcpath+'DBWS') DELETETABLES 
ENDIF
* собственно создаем базу данных
CREATE DATABASE (m.pcpath+'DBWS')

CREATE TABLE m.pcpath+'USERS' CODEPAGE=1251( ;
  User_ID INTEGER NOT NULL AUTOINC NEXTVALUE 1 STEP 1 PRIMARY KEY, ;
  User_nick CHARACTER(10) NOT NULL, ;
  PASSWORD CHARACTER(10) NOT NULL, ;
  email VARCHAR(40), ;
  city VARCHAR(30), ;
  admin NUMERIC(1,0), ;
  isblocked NUMERIC(1,0), ;
  register T NOT NULL, ;
  lastvisit T  ;
  )

* В нижеследующей таблице устанавливаем постоянные соотношения
* один ко многим с таблицей User
* хотя, в принципе, они нам и не нужны
CREATE TABLE  m.pcpath+'Mes_Header' CODEPAGE=1251( ;
  Mes_ID	INTEGER NOT NULL AUTOINC NEXTVALUE 1 STEP 1 PRIMARY KEY , ;
  User_from INTEGER NOT NULL REFERENCES USERS TAG User_ID, ;
  User_to INTEGER NOT NULL REFERENCES USERS TAG User_ID, ;
  WASUPDATED T NOT NULL, ;
  TITLE VARCHAR(100), ;
  published T NOT NULL ;
  )
INDEX on TTOD(WASUPDATED) TAG WASUPDATED ADDITIVE 

* здесь устанавливаем постоянное соотношение
* один ко многим с таблицей Mes_Header
* применение типа Blob для Message устраняет много проблем в будущем
* при передаче данных
CREATE TABLE m.pcpath+'Mes_body' CODEPAGE=1251( ;
  Reply_ID INTEGER NOT NULL AUTOINC NEXTVALUE 1 STEP 1 PRIMARY KEY, ;
  Mes_ID INTEGER NOT NULL REFERENCES Mes_Header TAG Mes_ID, ;
  User_from INTEGER NOT NULL REFERENCES USERS TAG User_ID, ;  
  MESSAGE W, ;
  published T ;
  )

* добавим сразу несколько необходимых записей
* Пользователь ALL (или вроде как код для широковещательного сообщения
* очень важно ввести его первой записью, чтобы код был равен 1)
* пароль выбираем случайным образом, чтобы никто не писал от его имени
INSERT INTO (m.pcpath+'USERS') (User_nick, PASSWORD,admin ,register , lastvisit  ) ;
  VALUES;
  ('ALL',SYS(2015),0,DATETIME(),DATETIME())
* администратора (для реальной системы рекомендуется сменить пароль)
INSERT INTO (m.pcpath+'USERS') (User_nick, PASSWORD,admin ,register , lastvisit  ) ;
  VALUES;
  ('admin','admin',1,DATETIME(),DATETIME())
* добавляем просто пользователя для тестирования
* здесь можете добавить себя
INSERT INTO (m.pcpath+'USERS') (User_nick, PASSWORD,admin ,register , lastvisit  ) ;
  VALUES;
  ('sergey','sergey',1,DATETIME(),DATETIME())
* теперь добавим тестовое сообщение
INSERT INTO (m.pcpath+'Mes_Header') (User_from , User_to, WASUPDATED, TITLE, published) ;
VALUES ;
(2,1,DATETIME(),'Добро пожаловать в систему обмена сообщениями', DATETIME())  
INSERT INTO (m.pcpath+'Mes_body')  (Mes_ID,User_from ,MESSAGE,published ) ;
VALUES ;
(1,2,'Собственно поздравление.'+CHR(13)+'Надеемся, что все будет работать.', DATETIME())  

* покажем, что у нас получилось
*DISPLAY TABLES
*DISPLAY DATABASE
* чистим за собой
CLOSE DATABASES

Далее создаем хранимые процедуры - "рабочие лошадки" нашего приложения. Существует мнение, что работать с базами данных следует только через хранимые процедуры. В принципе, хороший похдод, тем более, что все изменения в структуре Ваших данных и даже смену СУБД можно производить без смены клиента. Еще одно удобство - это ориентированность на наше WEB приложение (простота и прозрачность): клиент послал запрос в виде параметров хранимой процедуры, а в ответ получил результат. Все просто и надежно. Думаю, начав подобным образом разрабатывать приложения, Вы выбьете почву из под противников FoxPro, ибо они используют аналогичный подход и очень этим гордятся.

Все хранимые процедуры начинаются с SP (это перевод на английский ХП - Stored Procedures). Далее в названии используется английское наименование функции (для больших задач рекомендуется после SP использовать имя модуля, а затем название выполняемой функции). Теперь небольшое лирическое отступление об использовании английского языка. В принципе, можно использовать и русский, но столкнувшись с некоторыми проблемами совместимости, я пришел к выводу - использовать все-таки английский. Это хорошая практика, так как неизвестно, куда Вас закинет судьба работать завтра - может в ОАЭ, где никто не говорит по-русски, но смогут понять Ваш код на английском.

Приведу текст всех Хранимых Процедур:

*/--------------------------------------------------------------------------/*
* Текст всех ХП находится в sp_procedures.txt
* Для создания всех ХП из текстового файла запустите Create_SP.PRG
*/--------------------------------------------------------------------------/*

*/--------------------------------------------------------------------------/*
*
* MS VFP version..: 9.0
* Program-ID......: sp_chk_admin.PRG
* Purpose.........: Проверка на наличие прав администратора по user_id
* Project Manager.:
* Programmer......: Sergey Chavlytko
* Start...........: 22/05/2005
* Last edited.....: 22/05/2005
*
* (С) www.sergey.co.uk 2005
*/--------------------------------------------------------------------------/*
PROCEDURE sp_chk_admin
PARAMETERS m.lcuser_id
SET DELETED ON
PRIVATE m.lnreturn_parameter
m.lnreturn_parameter=-1
IF m.lcuser_id>0
  SELECT admin FROM USERS WHERE User_ID=m.lcuser_id  INTO CURSOR user_exists
  IF user_exists.admin >0
    m.lnreturn_parameter=user_exists.admin
  ENDIF
ENDIF
IF USED('USERS')
  USE IN USERS
ENDIF
IF USED('USER_EXISTS')
  USE IN user_exists
ENDIF

RETURN m.lnreturn_parameter

*/--------------------------------------------------------------------------/*
*
* MS VFP version..: 9.0
* Program-ID......: sp_message_read.PRG
* Purpose.........: Чтение заголовков сообщений с сервера
* Project Manager.:
* Programmer......: Sergey Chavlytko
* Start...........: 22/05/2005
* Last edited.....: 22/05/2005
*
* (С) www.sergey.co.uk 2005
*/--------------------------------------------------------------------------/*
PROCEDURE sp_message_read
PARAMETERS m.lddate, m.lcUser_nick, m.lcpassword, m.lndays_show
SET DELETED ON
PRIVATE m.lnuser_id, m.lnadmin, lcXML
STORE 0 TO m.lnadmin, m.lnuser_id
m.lnuser_id=sp_user_login_id(m.lcUser_nick, m.lcpassword)
lcXML=-1 && в случае неуспеха ответ в числовом виде
IF m.lnuser_id>0
  m.lnadmin=sp_chk_admin(m.lnuser_id)
  IF m.lnadmin>0 && это администратор, значит есть доступ ко всем сообщениям
    SELECT Mes_Header.*,User_nick, city FROM Mes_Header ;
      LEFT OUTER JOIN USERS ON Mes_Header.User_from=USERS.User_ID ;
      WHERE TTOD(Mes_Header.WASUPDATED) >= ;
      DATE(YEAR(m.lddate),MONTH(m.lddate),DAY(m.lddate)) - m.lndays_show ;
      INTO CURSOR CUR_TEMP &&
  ELSE && обычный пользователь
    SELECT Mes_Header.*,User_nick, city FROM Mes_Header ;
      LEFT OUTER JOIN USERS ON Mes_Header.User_from=USERS.User_ID ;
      WHERE (Mes_Header.User_to=1 OR Mes_Header.User_to=m.lnuser_id or ;
      Mes_Header.User_from=m.lnuser_id) AND ;
      TTOD(Mes_Header.WASUPDATED) >= ;
      DATE(YEAR(m.lddate),MONTH(m.lddate),DAY(m.lddate)) - m.lndays_show ;
      INTO CURSOR CUR_TEMP &&
  ENDIF
  SELECT CUR_TEMP
  IF RECCOUNT()>0
    CURSORTOXML("CUR_TEMP","lcXML",1,1,0,"1")
  ENDIF
ENDIF
CLOSE TABLES ALL
RETURN lcXML

*/--------------------------------------------------------------------------/*
*
* MS VFP version..: 9.0
* Program-ID......: sp_user_login_xml.PRG
* Purpose.........: Проверка пароля и имени пользователя
* Project Manager.:
* Programmer......: Sergey Chavlytko
* Start...........: 22/05/2005
* Last edited.....: 06/05/2005
*
* (С) www.sergey.co.uk 2005
*/--------------------------------------------------------------------------/*
PROCEDURE sp_user_login_xml
PARAMETERS m.User_nick, m.PASSWORD
SET DELETED ON
PRIVATE m.lcXML
m.lcXML=-1 && в случае неуспеха ответ в числовом виде
IF LEN(m.User_nick)>=3 AND LEN(m.PASSWORD)>3
  SELECT User_ID, User_nick, admin, ISBLOCKED FROM USERS WHERE  ;
  UPPER(USERS.User_nick)==UPPER(m.User_nick) ;
    AND UPPER(USERS.PASSWORD)==UPPER(m.PASSWORD) INTO CURSOR user_exists
  IF RECCOUNT('USER_EXISTS')>0 AND EMPTY(user_exists.ISBLOCKED)
* у нас есть такой пользователь
    CURSORTOXML('user_exists',"lcXML",1,1,0,"1")
  ENDIF
ENDIF
IF USED('USER_EXISTS')
  USE IN user_exists
ENDIF
IF USED('USERS')
  USE IN USERS
ENDIF
RETURN m.lcXML

*/--------------------------------------------------------------------------/*
*
* MS VFP version..: 9.0
* Program-ID......: sp_user_login_id.PRG
* Purpose.........: Проверка пароля и имени пользователя
* Project Manager.:
* Programmer......: Sergey Chavlytko
* Start...........: 22/05/2005
* Last edited.....: 06/05/2005
*
* (С) www.sergey.co.uk 2005
*/--------------------------------------------------------------------------/*
PROCEDURE sp_user_login_id
PARAMETERS m.User_nick, m.PASSWORD
SET DELETED ON
PRIVATE m.lnreturn_parameter
m.lnreturn_parameter=-1 && в случае неуспеха ответ в числовом виде
IF LEN(m.User_nick)>=3 AND LEN(m.PASSWORD)>3
  SELECT User_ID, User_nick, admin, ISBLOCKED FROM USERS WHERE  ;
  UPPER(USERS.User_nick)==UPPER(m.User_nick) ;
    AND UPPER(USERS.PASSWORD)==UPPER(m.PASSWORD) INTO CURSOR user_exists
  IF RECCOUNT('USER_EXISTS')>0 AND EMPTY(user_exists.ISBLOCKED)
* у нас есть такой пользователь
    m.lnreturn_parameter=user_exists.User_ID
  ENDIF
ENDIF
IF USED('USER_EXISTS')
  USE IN user_exists
ENDIF
IF USED('USERS')
  USE IN USERS
ENDIF
RETURN m.lnreturn_parameter


*/--------------------------------------------------------------------------/*
*
* MS VFP version..: 9.0
* Program-ID......: sp_users_read_xml.PRG
* Purpose.........: Чтение списка пользователей с сервера
* Project Manager.:
* Programmer......: Sergey Chavlytko
* Start...........: 31/05/2005
* Last edited.....: 31/05/2005
*
* (С) www.sergey.co.uk 2005
*/--------------------------------------------------------------------------/*
PROCEDURE sp_users_read_xml
PARAMETERS m.lcUser_nick, m.lcpassword
SET DELETED ON
PRIVATE m.lnuser_id, lcXML
STORE 0 TO m.lnuser_id
m.lnuser_id=sp_user_login_id(m.lcUser_nick, m.lcpassword)
lcXML=-1 && в случае неуспеха ответ в числовом виде
IF m.lnuser_id>0
  SELECT User_ID, User_nick FROM USERS ;
    INTO CURSOR CUR_TEMP
  IF RECCOUNT('CUR_TEMP')>0
    CURSORTOXML("CUR_TEMP","lcXML",1,1,0,"1")
  ENDIF
ENDIF
CLOSE TABLES ALL
RETURN lcXML


*/--------------------------------------------------------------------------/*
*
* MS VFP version..: 9.0
* Program-ID......: sp_new_message_add.PRG
* Purpose.........: Добавление нового сообщения в таблицы Mes_Header, Mes_body
*                   а так-же обновляем информацию у клиента
* Project Manager.:
* Programmer......: Sergey Chavlytko
* Start...........: 30/05/2005
* Last edited.....: 04/06/2005
*
* (С) www.sergey.co.uk 2005
*/--------------------------------------------------------------------------/*
PROCEDURE sp_new_message_add
PARAMETERS m.User_nick, m.PASSWORD , m.lnUser_to, m.lcTITLE, m.lcMes_Body
SET DELETED ON
SET MULTILOCKS ON
PRIVATE m.lnreturn_parameter, m.lnuser_id, m.lnmes_id

m.lnreturn_parameter=-1
m.lnuser_id=sp_user_login_id(m.User_nick, m.PASSWORD)
IF m.lnuser_id>0
  BEGIN TRANSACTION
  TRY
    INSERT INTO Mes_Header (User_from , User_to, WASUPDATED, TITLE, published) ;
      VALUES ;
      (m.lnuser_id,m.lnUser_to,DATETIME(),ALLTRIM(m.lcTITLE), DATETIME())
    m.lnmes_id=GETAUTOINCVALUE(0)
    INSERT INTO Mes_body  (Mes_ID,User_from,MESSAGE,published ) ;
      VALUES ;
      (m.lnmes_id,m.lnuser_id, m.lcMes_Body, DATETIME())
    UPDATE USERS SET lastvisit = DATETIME() WHERE User_ID=m.lnuser_id
    END TRANSACTION
    m.lnreturn_parameter=1
  CATCH TO oException
    ROLLBACK
  FINALLY
  ENDTRY
ENDIF
CLOSE TABLES ALL
RETURN m.lnreturn_parameter


*/--------------------------------------------------------------------------/*
*
* MS VFP version..: 9.0
* Program-ID......: sp_thread_read.PRG
* Purpose.........: Чтение всего потока одного сообщения с сервера
* Project Manager.:
* Programmer......: Sergey Chavlytko
* Start...........: 04/06/2005
* Last edited.....: 06/06/2005
*
* (С) www.sergey.co.uk 2005
*/--------------------------------------------------------------------------/*
PROCEDURE sp_thread_read
PARAMETERS m.lcUser_nick, m.lcpassword, m.lnmes_id
SET DELETED ON
PRIVATE m.lnuser_id, m.lnadmin, lcXML
STORE 0 TO m.lnadmin, m.lnuser_id
m.lnuser_id=sp_user_login_id(m.lcUser_nick, m.lcpassword)
lcXML=-1 && в случае неуспеха ответ в числовом виде
IF m.lnuser_id>0
  SELECT Mes_body.*,User_nick, city FROM Mes_body ;
    LEFT OUTER JOIN USERS ON Mes_body.User_from=USERS.User_ID ;
    WHERE Mes_ID=m.lnmes_id ;
    INTO CURSOR CUR_TEMP &&
  SELECT CUR_TEMP
  IF RECCOUNT()>0
    CURSORTOXML("CUR_TEMP","lcXML",1,1,0,"1")
  ENDIF
ENDIF
CLOSE TABLES ALL
RETURN lcXML

*/--------------------------------------------------------------------------/*
*
* MS VFP version..: 9.0
* Program-ID......: sp_existed_message_add.PRG
* Purpose.........: Добавление нового сообщения в таблицу Mes_body
*                   а так-же обновляем информацию у клиента
* Project Manager.:
* Programmer......: Sergey Chavlytko
* Start...........: 05/05/2005
* Last edited.....: 06/06/2005
*
* (С) www.sergey.co.uk 2005
*/--------------------------------------------------------------------------/*
PROCEDURE sp_existed_message_add
PARAMETERS m.User_nick, m.PASSWORD ,  m.lcMes_Body, m.lnmes_id
SET DELETED ON
SET MULTILOCKS ON
PRIVATE m.lnreturn_parameter, m.lnuser_id
m.lnreturn_parameter=-1
m.lnuser_id=sp_user_login_id(m.User_nick, m.PASSWORD)
IF m.lnuser_id>0
  BEGIN TRANSACTION
  TRY
    INSERT INTO Mes_body  (Mes_ID,User_from,MESSAGE,published ) ;
      VALUES ;
      (m.lnmes_id,m.lnuser_id, m.lcMes_Body, DATETIME())
    UPDATE USERS SET lastvisit = DATETIME() WHERE User_ID=m.lnuser_id
    END TRANSACTION
    m.lnreturn_parameter=1
  CATCH TO oException
    ROLLBACK
  FINALLY
  ENDTRY
ENDIF
CLOSE TABLES ALL
RETURN m.lnreturn_parameter

*/--------------------------------------------------------------------------/*
*
* MS VFP version..: 9.0
* Program-ID......: sp_message_delete.PRG
* Purpose.........: Удаление всего потока сообщения с сервера
* Project Manager.:
* Programmer......: Sergey Chavlytko
* Start...........: 05/06/2005
* Last edited.....: 05/06/2005
*
* (С) www.sergey.co.uk 2005
*/--------------------------------------------------------------------------/*
PROCEDURE sp_message_delete
PARAMETERS m.lcUser_nick, m.lcpassword, m.lnmes_id
SET DELETED ON
SET MULTILOCKS ON
PRIVATE m.lnuser_id, m.lnadmin, lcXML
STORE 0 TO m.lnadmin, m.lnuser_id
m.lnuser_id=sp_user_login_id(m.lcUser_nick, m.lcpassword)
m.lnadmin=sp_chk_admin(m.lnuser_id)
m.lnreturn_parameter=-1 && в случае неуспеха ответ в числовом виде
IF m.lnuser_id>0 AND m.lnadmin>0
  BEGIN TRANSACTION
  TRY
    DELETE FROM Mes_Header WHERE Mes_ID=m.lnmes_id
    DELETE FROM Mes_body WHERE Mes_ID=m.lnmes_id
    UPDATE USERS SET lastvisit = DATETIME() WHERE User_ID=m.lnuser_id
    END TRANSACTION
    m.lnreturn_parameter=1
  CATCH TO oException
    ROLLBACK
  FINALLY
  ENDTRY
ENDIF
CLOSE TABLES ALL
RETURN m.lnreturn_parameter

*/--------------------------------------------------------------------------/*
*
* MS VFP version..: 9.0
* Program-ID......: sp_answer_delete.PRG
* Purpose.........: Удаление одного ответа из сообщения с сервера
* Project Manager.:
* Programmer......: Sergey Chavlytko
* Start...........: 05/06/2005
* Last edited.....: 05/06/2005
*
* (С) www.sergey.co.uk 2005
*/--------------------------------------------------------------------------/*
PROCEDURE sp_answer_delete
PARAMETERS m.lcUser_nick, m.lcpassword, m.lnReply_id, m.lnmes_id
SET DELETED ON
SET MULTILOCKS ON
PRIVATE m.lnuser_id, m.lnadmin, lcXML
STORE 0 TO m.lnadmin, m.lnuser_id
m.lnuser_id=sp_user_login_id(m.lcUser_nick, m.lcpassword)
m.lnadmin=sp_chk_admin(m.lnuser_id)
m.lnreturn_parameter=-1 && в случае неуспеха ответ в числовом виде
IF m.lnuser_id>0 AND m.lnadmin>0
  BEGIN TRANSACTION
  TRY
    DELETE FROM Mes_body WHERE Reply_ID=m.lnReply_id
*     теперь смотрим - остались ли еще сообщения и если нет - то удаляем
*     и заголовок сообщения
    SELECT COUNT(Mes_ID) AS RECORDS ;
      FROM Mes_body ;
      WHERE Mes_ID=m.lnmes_id ;
      INTO CURSOR CUR_TEMP
    SELECT CUR_TEMP
    IF CUR_TEMP.RECORDS=0
      DELETE FROM Mes_Header WHERE Mes_ID=m.lnmes_id
    ENDIF
    UPDATE USERS SET lastvisit = DATETIME() WHERE User_ID=m.lnuser_id
    END TRANSACTION
    m.lnreturn_parameter=1
  CATCH TO oException
    ROLLBACK
  FINALLY
  ENDTRY
ENDIF
CLOSE TABLES ALL
RETURN m.lnreturn_parameter

*/--------------------------------------------------------------------------/*
*
* MS VFP version..: 9.0
* Program-ID......: sp_users_profile_read_xml.PRG
* Purpose.........: Чтение профиля пользователя с сервера
* Project Manager.:
* Programmer......: Sergey Chavlytko
* Start...........: 06/06/2005
* Last edited.....: 06/06/2005
*
* (С) www.sergey.co.uk 2005
*/--------------------------------------------------------------------------/*
PROCEDURE sp_users_profile_read_xml
PARAMETERS m.lcUser_nick, m.lcpassword, m.lnUserProfile_ID
SET DELETED ON
PRIVATE m.lnuser_id, lcXML, m.lnadmin
STORE 0 TO m.lnuser_id
m.lnuser_id=sp_user_login_id(m.lcUser_nick, m.lcpassword)
m.lnadmin=sp_chk_admin(m.lnuser_id)
lcXML=-1 && в случае неуспеха ответ в числовом виде
IF m.lnuser_id>0 AND m.lnadmin>0
  SELECT * FROM USERS ;
    INTO CURSOR CUR_TEMP WHERE User_ID=m.lnUserProfile_ID READWRITE NOFILTER
  IF RECCOUNT('CUR_TEMP')=0
    SELECT CUR_TEMP
    APPEND BLANK
  ENDIF
  CURSORTOXML("CUR_TEMP","lcXML",1,1,0,"1")
ENDIF
CLOSE TABLES ALL
RETURN lcXML

*/--------------------------------------------------------------------------/*
*
* MS VFP version..: 9.0
* Program-ID......: sp_users_add_edit.PRG
* Purpose.........: Добавление/изменение профиля клиента
* Project Manager.:
* Programmer......: Sergey Chavlytko
* Start...........: 06/06/2005
* Last edited.....: 06/06/2005
*
* (С) www.sergey.co.uk 2005
*/--------------------------------------------------------------------------/*
PROCEDURE sp_users_add_edit
PARAMETERS m.lcUser_nick, m.lcpassword, m.lnUserProfile_ID, m.lcXML_Cursor
SET DELETED ON
SET MULTILOCKS ON
PRIVATE m.lnuser_id, m.lnadmin, lcXML
STORE 0 TO m.lnadmin, m.lnuser_id
m.lnuser_id=sp_user_login_id(m.lcUser_nick, m.lcpassword)
m.lnadmin=sp_chk_admin(m.lnuser_id)
m.lnreturn_parameter=-1 && в случае неуспеха ответ в числовом виде
IF m.lnuser_id>0 AND m.lnadmin>0 AND !EMPTY(m.lcXML_Cursor)
  XMLTOCURSOR(m.lcXML_Cursor,'TMCURSOR',4)
  SELECT TMCURSOR
  IF RECCOUNT()>0 && у нас есть работа
    IF m.lnUserProfile_ID>0 && обновление существующих данных
      BEGIN TRANSACTION
      TRY
* это конечно узкое место, но нам хотелось все сделать с помощью CRUD команд
        UPDATE USERS SET  User_nick=TMCURSOR.User_nick, PASSWORD = TMCURSOR.PASSWORD,;
          email=TMCURSOR.email, city=TMCURSOR.city,admin = TMCURSOR.admin, ;
          ISBLOCKED=TMCURSOR.ISBLOCKED ;
          WHERE User_ID=m.lnUserProfile_ID
        END TRANSACTION
        m.lnreturn_parameter=1
      CATCH TO oException
        ROLLBACK
      FINALLY
      ENDTRY
    ELSE && добавление нового клиента
      BEGIN TRANSACTION
      TRY
        INSERT INTO USERS ;
          (User_nick,         PASSWORD ,         email,        city,         ;
          admin         , register,  lastvisit,  ISBLOCKED          ) ;
          VALUES ;
          (TMCURSOR.User_nick,TMCURSOR.PASSWORD,TMCURSOR.email,TMCURSOR.city,;
          TMCURSOR.admin, DATETIME(), DATETIME(),TMCURSOR.ISBLOCKED)
        END TRANSACTION
        m.lnreturn_parameter=1
      CATCH TO oException
        ROLLBACK
      FINALLY
      ENDTRY
    ENDIF
  ELSE && нечего делать
  ENDIF
ENDIF
CLOSE TABLES ALL
RETURN m.lnreturn_parameter

*/-----------------------------------------------------------------------/*
*
* MS VFP version..: 9.0 
* Program-ID......: Create_SP.PRG
* Purpose.........: Создание Хранимых Процедур для базы данных DBWS.DBC
* Project Manager.: 
* Programmer......: Sergey Chavlytko
* Start...........: 22/05/2005
* Last edited.....: 05/06/2005
*
* (С) www.sergey.co.uk 2005
*/--------------------------------------------------------------------------/*
PUBLIC m.pcpath
m.pcpath='C:\WS_MESSAGE\SERVER\'
OPEN DATABASE (m.pcpath+'DBWS.DBC')
APPEND PROCEDURES FROM (m.pcpath+'SP_PROCEDURES.TXT') as 1251 OVERWRITE 
CLOSE DATABASES

*/--------------------------------------------------------------------------/*
*
* MS VFP version..: 9.0
* Program-ID......: sp_message_delete.PRG
* Purpose.........: Удаление всего потока сообщения с сервера
* Project Manager.:
* Programmer......: Sergey Chavlytko
* Start...........: 05/06/2005
* Last edited.....: 05/06/2005
*
* (С) www.sergey.co.uk 2005
*/--------------------------------------------------------------------------/*
PROCEDURE sp_message_delete
PARAMETERS m.lcUser_nick, m.lcpassword, m.lnmes_id
SET DELETED ON
SET MULTILOCKS ON
PRIVATE m.lnuser_id, m.lnadmin, lcXML
STORE 0 TO m.lnadmin, m.lnuser_id
m.lnuser_id=sp_user_login_id(m.lcUser_nick, m.lcpassword)
m.lnadmin=sp_chk_admin(m.lnuser_id)
m.lnreturn_parameter=-1 && в случае неуспеха ответ в числовом виде

CLOSE TABLES ALL
SELECT 0
USE MES_HEADER SHARED
=CURSORSETPROP("Buffering" ,5,'MES_HEADER' )
SELECT 0
USE MES_BODY SHARED
=CURSORSETPROP("Buffering" ,5,'MES_BODY' )
SELECT 0
USE USERS ALIAS USERS SHARED
=CURSORSETPROP("Buffering" ,5,'USERS' )
SELECT 0

IF m.lnuser_id>0 AND m.lnadmin>0

  LOCAL llRollBack
  llRollBack=.F.

  BEGIN TRANSACTION
  DELETE FROM MES_HEADER WHERE Mes_ID=m.lnmes_id
  DELETE FROM MES_BODY WHERE Mes_ID=m.lnmes_id
  UPDATE USERS SET lastvisit = DATETIME() WHERE User_ID=m.lnuser_id

  IF !TABLEUPDATE(2,.T.,'MES_HEADER')
    llRollBack=.T.
  ELSE
    IF !TABLEUPDATE(2,.T.,'MES_BODY')
      llRollBack=.T.
    ELSE
      IF !TABLEUPDATE(2,.T.,'USERS')
        llRollBack=.T.
      ENDIF
    ENDIF
  ENDIF
  IF llRollBack
    ROLLBACK
  ELSE
    END TRANSACTION
    m.lnreturn_parameter=1
  ENDIF

ENDIF
CLOSE TABLES ALL
RETURN m.lnreturn_parameter