128
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
//
end;
T.Free;
end;
procedure TdmServer.DataModuleCreate(Sender: TObject);
129
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;
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;
130
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);
var
//
UserKey, UserTypeKey : Integer;
CI : TConnectionInfo;
Blocked : Boolean;
begin
//
UserKey := GetUserKey (User, Password, Blocked, UserTypeKey);
if (UserTypeKey <> 1) and (UserTypeKey <> 2) and (UserTypeKey <> 9) then
raise Exception.Create('Данному типу пользователей доступ закрыт');
if (Blocked = True) then raise Exception.Create('Вход в систему невозможен.
Ваш аккаунт заблокирован.');
valid := UserKey > 0;
131
if (valid = False) then
raise Exception.Create('Неверная пара логин/пароль.');
if valid = true then
begin
CI := ConnectionList.GetConnectionKey(GetCurrentThreadId);
CI.UserKey := UserKey;
CI.UserTypeKey := UserTypeKey;
end;
end;
procedure TdmServer.DSServerClassGetClass(DSServerClass: TDSServerClass;
var PersistentClass: TPersistentClass);
begin
//
PersistentClass := udssmRemoteData.TdssmRemoteData;
end;
procedure TdmServer.DSTCPServerTransportConnect(
Event: TDSTCPConnectEventObject);
var
//
CI : TConnectionInfo;
begin
//
CI := ConnectionList.AddConnection(Windows.GetCurrentThreadId);
CI.IP := Event.Channel.ChannelInfo.ClientInfo.IpAddress;
CI.Channel := Event.Channel;
end;
procedure TdmServer.DSTCPServerTransportDisconnect(
Event: TDSTCPDisconnectEventObject);
begin
132
//
ConnectionList.DelConnection(GetCurrentThreadId);
end;
procedure TdmServer.SendMessage (Email : string; Subject : string; Msg :
TStringList);
var
ServerAddress : String; ServerPort : Integer; Login : String; Password : String;
Q : TADOQuery;
IdSMTP : TIdSMTP;
IdMsg : TIdMessage;
IdText : TIdText;
begin
//
Q := dmServer.GetQuery('select * from Параметры where Код = 1');
try
ServerAddress := Trim(Q.FieldByName ('Email_Адрес_сервера').Value);
Login := Trim(Q.FieldByName ('Email').Value);
Password := Q.FieldByName ('Email_Пароль').Value;
ServerPort := Q.FieldByName ('Email_Порт').AsInteger;
Email := Trim(Email);
if (Email = '') then
raise Exception.Create('Email получателя не задан');
if (ServerPort <= 0) then
raise Exception.Create('Порт почтового сервера не задан. См.
"Параметры"');
if (ServerAddress = '') then
raise Exception.Create('Адрес почтового сервера не задан. См.
"Параметры"');
if (Login = '') then
raise Exception.Create('Адрес электронной почты не задан. См.
"Параметры"');
133
if (Password = '') then
raise Exception.Create('Пароль для электронной почты не задан. См.
"Параметры"');
IdSMTP := TIdSMTP.Create(nil);
try
IdSMTP.Disconnect;
IdSMTP.Port := ServerPort;
IdSMTP.Host := ServerAddress;
IdSMTP.AuthType := satDefault;
IdSMTP.Username := Login;
IdSMTP.Password := Password;
IdSMTP.ConnectTimeout := 1000;
IdSMTP.Connect;
IdMsg := TIdMessage.Create (nil);
try
IdMsg.Subject := Subject; //текст темы сообщения
IdMsg.ContentType := 'multipart/mixed; charset=windows-1251';
IdMsg.Recipients.EMailAddresses := Email; //указываем адрес
получателя
IdMsg.From.Address := Login; //указываем автора письма
IdMsg.Date := Now; //дата отправки письма может
быть любой
IdText := TIdText.Create(IdMsg.MessageParts, Msg);
try
IdText.CharSet := 'windows-1251';
IdSMTP.Send (IdMsg);
finally
IdText.Free;
134
end;
finally
//
IdMsg.Free;
end;
finally
IdSMTP.Free;
end;
finally
Q.Free;
end;
end;
end.
unit ufAnalyserParams;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls, Vcl.DBCtrls;
type
TfAnalyserParams = class(TForm)
bOk: TButton;
bCancel: TButton;
DateTimePicker1: TDateTimePicker;
Label1: TLabel;
DateTimePicker2: TDateTimePicker;
Label2: TLabel;
135
eDaysCount: TEdit;
lDaysCount: TLabel;
eK: TEdit;
lK: TLabel;
lB: TLabel;
eB: TEdit;
Label3: TLabel;
dblcbProduct: TDBLookupComboBox;
procedure FormCreate(Sender: TObject);
procedure bOkClick(Sender: TObject);
procedure FormKeyPress(Sender: TObject; var Key: Char);
private
{ Private declarations }
FDate1, FDate2 : TDateTime;
FDaysCount : Integer;
FK : Double;
FB : Double;
FProductID : Integer;
public
{ Public declarations }
property Date1 : TDateTime read FDate1;
property Date2 : TDateTime read FDate2;
property DaysCount : Integer read FDaysCount;
property K : Double read FK;
property B : Double read FB;
property ProductID : Integer read FProductID;
end;
var
fAnalyserParams: TfAnalyserParams;
136
implementation
{$R *.dfm}
uses udmData;
procedure TfAnalyserParams.bOkClick(Sender: TObject);
begin
//
FDate1 := DateTimePicker1.Date;
FDate2 := DateTimePicker2.Date;
if (VarIsNull(dblcbProduct.KeyValue) = true) then
raise Exception.Create('Необходимо выбрать товар');
FProductID := dblcbProduct.KeyValue;
if (FDate1 >= FDate2) then
raise Exception.Create('Дата начала периода должна быть меньше даны
окончания периода');
try
//
FDaysCount := StrToInt (eDaysCount.Text);
if (FDaysCount <= 0) then
raise Exception.Create('Прогнозируемый период должен быть больше
нуля');
except
//
raise Exception.Create('В поле "'+lDaysCount.Caption+'" может находиться
только целое положительное число');
137
Exit;
end;
try
//
FK := StrToFloat (eK.Text);
if (FK <= 0) or (FK >= 1) then
raise Exception.Create('Error Message');
except
//
raise Exception.Create('В поле "'+lK.Caption+'" может находиться
вещественное значение в интервале (0, 1)');
Exit;
end;
try
//
FB := StrToFloat (eB.Text);
if (FB <= 0) or (FB >= 1) then
raise Exception.Create('Error Message');
except
//
raise Exception.Create('В поле "'+lB.Caption+'" может находиться
вещественное значение в интервале (0, 1)');
Exit;
end;
ModalResult := mrOk;
end;
procedure TfAnalyserParams.FormCreate(Sender: TObject);
begin
//