118
Модель подпроцесса заключения договоров с поставщиками
Модель подпроцесса оперативного управления поставками
119
Модель подпроцесса оценки результатов поставок
120
Модель подпроцесса составления претензий к поставщикам
121
Листинг основных программных модулей
unit udmServer;
interface
uses
System.SysUtils, System.Classes, IndyPeerImpl, Datasnap.DSCommonServer,
Datasnap.DSServer, Datasnap.DSTCPServerTransport, Datasnap.DSAuth,
Data.DB,
Data.Win.ADODB, uConnectionList, uConnectionInfo, Windows, Forms,
Dialogs,
Controls, IniFiles, Data.DBXFirebird, Data.FMTBcd, Data.SqlExpr,
Datasnap.DBClient, Datasnap.Provider, Variants, DBXJSON,
IdSMTP, IdMessage, IdAttachmentFile, IdMessageParts, IdText,
IdBaseComponent,
IdComponent, IdTCPConnection, IdTCPClient, IdExplicitTLSClientServerBase,
IdMessageClient, IdSMTPBase;
const c_Settings_File = 'Settings.ini';
c_Settings_Setion_Base = 'Base';
c_Settings_Setion_Base_FileName = 'FileName';
c_Settings_Setion_Server = 'Server';
c_Settings_Setion_Server_Port = 'Port';
type
/// <summary>
/// Базовый класс сервера
/// </summary>
TdmServer = class(TDataModule)
/// <summary>
122
/// Компонент аутентификации
/// </summary>
DSAuthenticationManager: TDSAuthenticationManager;
/// <summary>
/// Транспорт сервера
/// </summary>
/// <link>aggregationByValue</link>
DSTCPServerTransport: TDSTCPServerTransport;
/// <summary>
/// Компонент определения серверного класса
/// </summary>
/// <link>aggregationByValue</link>
DSServerClass: TDSServerClass;
/// <summary>
/// Компонент управления сервером
/// </summary>
DSServer: TDSServer;
/// <summary>
/// Компонент соединения с базой данных
/// </summary>
adoConnection: TADOConnection;
/// <summary>
/// Обработчик события "Определение серверного класса"
/// </summary>
procedure DSServerClassGetClass(DSServerClass: TDSServerClass;
var PersistentClass: TPersistentClass);
/// <summary>
/// Обработчик события "Аутентификация"
/// </summary>
procedure DSAuthenticationManagerUserAuthenticate(Sender: TObject;
const Protocol, Context, User, Password: string; var valid: Boolean;
UserRoles: TStrings);
123
/// <summary>
/// Обработчик события "Установка TCP соединения"
/// </summary>
procedure DSTCPServerTransportConnect(Event:
TDSTCPConnectEventObject);
/// <summary>
/// Обработчик события "Создание модуля данных"
/// </summary>
procedure DataModuleCreate(Sender: TObject);
/// <summary>
/// Обработчик события "Разрыв TCP соединения"
/// </summary>
procedure DSTCPServerTransportDisconnect(
Event: TDSTCPDisconnectEventObject);
private
{ Private declarations }
/// <summary>
/// Настройки сервера
/// </summary>
FSettings : TIniFile;
public
{ Public declarations }
/// <summary>
/// Метод определения идентификатора пользователя через логин и
пароль
/// </summary>
function GetUserKey (Login, Password : String; var Blocked : Boolean; var
UserType : Integer) : Integer;
/// <summary>
/// Метод выгрузки набора данных через имя таблицы (запроса)
/// </summary>
124
function GetTable (TableName : String) : TADOTable;
/// <summary>
/// Метод выгрузки набора данных через SQL запрос
/// </summary>
function GetQuery (SQL : String) : TADOQuery;
/// <summary>
/// Метод выполнения запроза
/// </summary>
function ExecQuery (SQL : String) : Integer;
/// <summary>
/// Метод оповещении всех активных клиентов об изменении состояния
склада
/// </summary>
procedure BroadcastStorageProductChanged;
/// <summary>
/// Метод оповещении всех активных клиентов об изменении перечня
товаров
/// </summary>
procedure BroadcastProductChanged;
/// <summary>
/// Метод отправки письма по электронной почте
/// </summary>
procedure SendMessage (Email : string; Subject : string; Msg : TStringList);
/// <summary>
/// Настройки сервера
/// </summary>
/// <link>association</link>
property Settings: TIniFile read FSettings;
end;
125
var
dmServer: TdmServer;
implementation
{$R *.dfm}
uses udssmRemoteData;
procedure TdmServer.BroadcastStorageProductChanged;
var
//
Msg : TJSONString;
begin
//
Msg := TJSONString.Create ('StorageProductChanged');
DSServer.BroadcastMessage('SystemCallback', Msg);
end;
procedure TdmServer.BroadcastProductChanged;
var
//
Msg : TJSONString;
begin
//
Msg := TJSONString.Create ('ProductChanged');
DSServer.BroadcastMessage('SystemCallback', Msg);
end;
126
function TdmServer.GetTable (TableName : String) : TADOTable;
begin
//
Result := TADOTable.Create(nil);
try
//
Result.Connection := adoConnection;
Result.TableName := TableName;
Result.Open;
except
//
on E : Exception do
begin
//
Result.Free;
raise;
end;
end;
end;
function TdmServer.GetQuery (SQL : String) : TADOQuery;
begin
//
Result := TADOQuery.Create(nil);
try
//
Result.Connection := adoConnection;
Result.SQL.Text := SQL;
Result.Open;
except
//
on E : Exception do
127
begin
//
Result.Free;
raise;
end;
end;
end;
function TdmServer.ExecQuery (SQL : String) : Integer;
var
//
R : TADOQuery;
begin
//
R := TADOQuery.Create(nil);
try
//
R.Connection := adoConnection;
R.SQL.Text := SQL;
Result := R.ExecSQL;
finally
R.Free;
end;
end;
function TdmServer.GetUserKey (Login, Password : String; var Blocked :
Boolean; var UserType : Integer) : Integer;
var
//
T : TADOQuery;