127
Приложение. Листинг программных модулей
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>
128
TdmServer = class(TDataModule)
/// <summary>
/// Компонент аутентификации
/// </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>
129
procedure DSAuthenticationManagerUserAuthenticate(Sender: TObject;
const Protocol, Context, User, Password: string; var valid: Boolean;
UserRoles: TStrings);
/// <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>
130
function GetUserKey (Login, Password : String; var Blocked : Boolean; var
UserType : Integer) : Integer;
/// <summary>
/// Метод выгрузки набора данных через имя таблицы (запроса)
/// </summary>
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>
131
/// <link>association</link>
property Settings: TIniFile read FSettings;
end;
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
//
132
Msg : TJSONString;
begin
//
Msg := TJSONString.Create ('ProductChanged');
DSServer.BroadcastMessage('SystemCallback', Msg);
end;
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);
133
try
//
Result.Connection := adoConnection;
Result.SQL.Text := SQL;
Result.Open;
except
//
on E : Exception do
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;
134
end;
function TdmServer.GetUserKey (Login, Password : String; var Blocked :
Boolean; var UserType : Integer) : Integer;
var
//
T : TADOQuery;
begin
//
Result := 0;
T := TADOQuery.Create (nil);
T.Connection := adoConnection;
T.SQL.Text := 'select * from Пользователь where Логин = ' + QuotedStr
(Login);
try
//
T.Active := true;
if (T.RecordCount > 0) then
begin
//
if T.FieldByName('Пароль').AsString = Password then
begin
//
Result := T.FieldByName('Код').AsInteger;
UserType := T.FieldByName('Код_Тип_пользователя').AsInteger;
Blocked := T.FieldByName('Блокировать_доступ').AsBoolean;
end;
end;
finally
135
//
end;
T.Free;
end;
procedure TdmServer.DataModuleCreate(Sender: TObject);
function GetDataBaseName : String;
begin
//
Result := Settings.ReadString(c_Settings_Setion_Base,
c_Settings_Setion_Base_FileName, 'Base.mdb');
if (ExtractFilePath(Result) = '') then
begin
//
Result := ExtractFilePath(Application.ExeName) + Result;
end;
end;
begin
//
FSettings := TIniFile.Create (ExtractFilePath (Application.ExeName) + '\' +
c_Settings_File);
if adoConnection.Connected = true then
begin
ShowMessage ('adoConnection.Connected = true. Приложение будет
закрыто.');
Application.Terminate;
end;
136
adoConnection.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;' +
'Data Source=' + GetDataBaseName + ';' +
'Persist Security Info=False';
try
//
DSTCPServerTransport.Port :=
Settings.ReadInteger(c_Settings_Setion_Server,
c_Settings_Setion_Server_Port,
5000);
DSServer.Start;
adoConnection.Connected := True;
except
//
on E : Exception do
begin
//
Application.MainForm.Show;
MessageDlg (E.Message, mtError, [mbOK], 0);
MessageDlg ('Приложение будет закрыто.', mtInformation, [mbOK],
0);
Application.Terminate;
end;
end;
end;
procedure TdmServer.DSAuthenticationManagerUserAuthenticate(Sender:
TObject;
const Protocol, Context, User, Password: string; var valid: Boolean;
UserRoles: TStrings);