alexey.zablotskiy/LMS-2_ReportAPI
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

linux

Browse Source
This commit is contained in:
Алексей Заблоцкий 2023-10-19 13:08:34 +03:00
parent 2df92e04a1
commit f6fb6db5d7
15 changed files with 125 additions and 97 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitignore vendored
View File

@ -12,7 +12,7 @@
*.o
*.or
*.a
*.log
# Lazarus autogenerated files (duplicated info)
*.rst
*.rsj

BIN
U:/Apache/Apache24/cgi-bin/lms_cgi
View File

Binary file not shown.

27
cgi_daemon.pas
View File

@ -5,7 +5,7 @@ unit cgi_daemon;
interface
uses
Classes, SysUtils, DaemonApp, ConnectionsDmUnit;
Classes, SysUtils, DaemonApp, ConnectionsDmUnit,eventlog;
type
TLMSReportCGI=class;
@ -14,6 +14,7 @@ type
TDaemonThread=class(TThread)
fOwner: TLMSReportCGI;
fData: TConnectionsDM;
fLogger: TEventLog;
procedure Execute;override;
function sleepMin(n: integer): boolean;
constructor Create(AOwner: TLMSReportCGI);
@ -36,7 +37,8 @@ var
LMSReportCGI: TLMSReportCGI;
implementation
uses
LazLogger;
procedure RegisterDaemon;
begin
RegisterDaemonClass(TLMSReportCGI)
@ -48,6 +50,14 @@ end;
procedure TLMSReportCGI.DataModuleCreate(Sender: TObject);
begin
//{$IFDEF WINDOWS}
self.Logger.Active:=false;
self.Logger.AppendContent:=true;
self.Logger.LogType := ltFile;
self.Logger.FileName := format('%s/server.log',[extractfilepath(paramstr(0))]);
self.Logger.Active:=true;
//{$ENDIF}
self.logger.Info('TLMSReportCGI.DataModuleCreate');
workThread := TDaemonThread.create(self);
end;
@ -58,13 +68,15 @@ end;
procedure TLMSReportCGI.DataModuleStart(Sender: TCustomDaemon; var OK: Boolean);
begin
logger.Info('start daemon thread');
workThread.Start;
logger.Info('daemon thread started');
OK := true;
end;
procedure TLMSReportCGI.DataModuleStop(Sender: TCustomDaemon; var OK: Boolean);
begin
debugln('stop daemon thread');
workThread.Terminate;
end;
@ -72,13 +84,19 @@ end;
procedure TDaemonThread.Execute;
begin
fData := TConnectionsDM.Create(nil);
flogger.Info('TDaemonThread.Execute');
fData := TConnectionsDM.CreateWithLog(fLogger);
try
fData.logger := fLogger;
fData.log(self,'logging');
flogger.Info('TDaemonThread.Execute.1');
fData.Start;
flogger.Info('TDaemonThread.Execute.2');
while not terminated do
begin
if sleepMin(2) then
fData.Idle(self);
flogger.Info('TDaemonThread.Idle');
end;
fData.Stop;
finally
@ -102,6 +120,7 @@ constructor TDaemonThread.Create(AOwner: TLMSReportCGI);
begin
inherited Create(true);
fOwner:=AOwner;
fLogger:=AOwner.Logger;
end;

12
cgidm.pas
View File

@ -48,6 +48,7 @@ type
procedure log(Sender: TObject; msg: string);
procedure LogError(Sender: TObject; e: Exception; msg: string);
procedure ExecuteSQL(ASQL: string);
constructor CreateWithLogger(ALogger: TLogger);
end;
var
@ -62,9 +63,9 @@ uses
procedure TNIDBDM.DataModuleCreate(Sender: TObject);
begin
log(self,'connecting');
log(sender,'TnnzConnection.Create');
fcon := TnnzConnection.Create(self);
log(sender,'TnnzConnection.Create.ok');
end;
@ -359,5 +360,12 @@ begin
connection.ExecuteSQL(ASQL);
end;
constructor TNIDBDM.CreateWithLogger(ALogger: TLogger);
begin
fLogger := ALogger;
log(nil,'TNIDBDM.Create');
inherited Create(nil);
end;
end.

55
connectionsdmunit.pas
View File

@ -5,8 +5,8 @@ unit ConnectionsDmUnit;
interface
uses
Classes, Contnrs, SysUtils, types, process, cgiDM, reportDMUnit, LNet,
lnetbase,tcpserver, tcpthreadhelper, DCPsha1, extTypes,syncobjs, baseconnection;
Classes, Contnrs, SysUtils, types, process, cgiDM, reportDMUnit, LNet,eventlog,
lnetbase,tcpserver, tcpthreadhelper, DCPsha1, extTypes,syncobjs, baseconnection,LazLoggerBase,LazLogger;
type
@ -32,7 +32,7 @@ type
fDataPort: integer;
fDataBase: string;
fServicePort: integer;
fLogger: TEventLog;
fTimeOut: integer;
LogLock: TCriticalSection;
fRunning: boolean;
@ -51,6 +51,7 @@ type
property DataHost: string read fDataHost;
property DataPort: integer read fDataPort;
property DataBase: string read fDataBase;
property Logger: TEventLog read fLogger write fLogger;
procedure Log(Sender: TObject; msg: string);
procedure Start;
procedure Stop;
@ -59,7 +60,7 @@ type
function ProcessRequest(Sender: TMainThread;
const CommandID:DWORD; const Param:QWord; const ACommand: string; const Fields: TStrings; const iParams: TParamArray; const Data: TStream;
out Code: DWORD; out RetValue: QWord; out Answer: string; out rValues: TStrings; out iValues: TParamArray; out ByteData: TStream ): boolean;
constructor CreateWithLog(ALogger: TEventLog);
end;
var
@ -77,13 +78,21 @@ uses
procedure TConnectionsDM.DataModuleCreate(Sender: TObject);
begin
MainCon := TNIDBDM.Create(nil);
MainCon.logger:=@log;
log(sender,'datamodulecreate-0');
fRunning := false;
log(sender,'datamodulecreate.1');
LogLock := TCriticalSection.Create;
conList := TList.Create;
log(sender,'datamodulecreate.2');
MainCon := TNIDBDM.CreateWithLogger(@log);
log(sender,'datamodulecreate.3');
MainCon.logger:=@log;
LoadConfig;
fRunning := false;
log(sender,'datamodulecreate.4');
input := TServerMainThread.Create(@log,fServicePort,@ProcessRequest);
log(sender,'datamodulecreate.ok');
end;
procedure TConnectionsDM.DataModuleDestroy(Sender: TObject);
@ -236,7 +245,7 @@ begin
if ACommand='login' then
begin
UserName :=Fields.Values['user'];
if ProcessLogin(UserName,EncryptText(Fields.Values['password']),UserID) then
if ProcessLogin(UserName,EncryptText(Fields.Values['password'],Hash),UserID) then
begin
con := NewConnection;
con.User:=UserName;
@ -336,6 +345,12 @@ begin
end;
constructor TConnectionsDM.CreateWithLog(ALogger: TEventLog);
begin
fLogger:=Alogger;
inherited Create(nil);
end;
function TConnectionsDM.ProcessLogin(UserName, UserPassword: string; out UserID: integer): boolean;
var
ASQL: string;
@ -482,28 +497,16 @@ procedure TConnectionsDM.Log(Sender: TObject; msg: string);
var
f: TextFile;
begin
if not assigned(fLogger) then exit;
try
try
if fLogFolder='' then exit;
LogLock.Enter;
try
AssignFile(f, fLogFolder);
if fileexists(fLogFolder) then
append(f)
else
rewrite(f);
// assignefile(fLogFolder
if Sender is TComponent then
writeln(f,DateTimeToStr(NOW()),#09,Sender.ClassName,'-',(Sender as TComponent).Name, #09, Msg)
flogger.Debug(DateTimeToStr(NOW())+#09+Sender.ClassName+'-'+(Sender as TComponent).Name+#09+Msg)
else if Assigned(Sender) then
writeln(f,DateTimeToStr(NOW()),#09,Sender.ClassName, #09, Msg)
flogger.Debug(DateTimeToStr(NOW())+#09+Sender.ClassName+ #09+ Msg)
else
writeln(f,DateTimeToStr(NOW()),#09, #09, Msg);
closeFile(f);
finally
logLock.Leave;
end;
flogger.Debug(DateTimeToStr(NOW())+#09+ #09+ Msg);
except on e: Exception do
raise;
end;

BIN
lms_cgi_server
View File

Binary file not shown.

2
lms_cgi_server.ini
View File

@ -4,4 +4,4 @@ port=7079
database=lms
[PARAMS]
port=6543
log=D:\PROJECTS\LAZARUS\LMS\out\server.log
log=/var/log/nintegra/cgireport.log

BIN
lmsreport Executable file
View File

Binary file not shown.

11
lmsreport.lpr
View File

@ -21,18 +21,7 @@ begin
RequireDerivedFormResource:=True;
Application.Scaled:=True;
Application.Initialize;
if paramstr(1)='console' then
begin
Application.CreateForm(TCGIServerGUI, CGIServerGUI);
Application.Run;
end
else
begin
Application.CreateForm(TConnectionsDM,ConnectionsDM);
ConnectionsDM.start;
while ConnectionsDM.running do
sleep(1000);
end;
end.

45
maintcpserver.lfm
View File

@ -8,7 +8,7 @@ object CGIServerGUI: TCGIServerGUI
ClientWidth = 870
OnCreate = FormCreate
OnDestroy = FormDestroy
LCLVersion = '2.2.4.0'
LCLVersion = '2.2.0.4'
object Panel1: TPanel
Left = 0
Height = 50
@ -45,14 +45,14 @@ object CGIServerGUI: TCGIServerGUI
Width = 368
Align = alLeft
Caption = 'Запрос'
ClientHeight = 239
ClientWidth = 364
ClientHeight = 240
ClientWidth = 366
TabOrder = 1
object Keys: TMemo
Left = 0
Height = 216
Top = 23
Width = 364
Height = 210
Top = 30
Width = 366
Align = alClient
Lines.Strings = (
'user=nnz'
@ -62,11 +62,11 @@ object CGIServerGUI: TCGIServerGUI
end
object edtRequest: TComboBox
Left = 0
Height = 23
Height = 30
Top = 0
Width = 364
Width = 366
Align = alTop
ItemHeight = 15
ItemHeight = 0
ItemIndex = 3
Items.Strings = (
'version'
@ -91,40 +91,41 @@ object CGIServerGUI: TCGIServerGUI
Width = 497
Align = alClient
Caption = 'Ответ'
ClientHeight = 239
ClientWidth = 493
ClientHeight = 240
ClientWidth = 495
TabOrder = 2
object edtAnswer: TEdit
Left = 0
Height = 23
Height = 30
Top = 25
Width = 493
Width = 495
Align = alTop
OnDblClick = edtAnswerDblClick
TabOrder = 0
end
object retValues: TMemo
Left = 0
Height = 88
Top = 71
Width = 493
Height = 75
Top = 85
Width = 495
Align = alClient
TabOrder = 1
end
object intValues: TListBox
Left = 0
Height = 80
Top = 159
Width = 493
Top = 160
Width = 495
Align = alBottom
ItemHeight = 0
TabOrder = 2
TopIndex = -1
end
object edtQValue: TEdit
Left = 0
Height = 23
Top = 48
Width = 493
Height = 30
Top = 55
Width = 495
Align = alTop
TabOrder = 3
end
@ -132,7 +133,7 @@ object CGIServerGUI: TCGIServerGUI
Left = 0
Height = 25
Top = 0
Width = 493
Width = 495
Align = alTop
TabOrder = 4
end

5
maintcpserver.pas
View File

@ -69,12 +69,13 @@ begin
ConnectionsDM := Server;
cmdDone := true;
started := false;
SendButton.Enabled := false;
SendButton.Enabled := Paramstr(1)='client';
StartButton.Enabled := not SendButton.Enabled;
end;
procedure TCGIServerGUI.SendButtonClick(Sender: TObject);
begin
if not started then exit;
if not started and StartButton.enabled then exit;
client := TClientMainThread.Create(edtRequest.Text,Keys.Lines,@Server.log,'localhost',6543,@onAnswer);
LogQuery(0,edtRequest.Text,Keys.Lines,0,0,[]);
cmdDone := false;

1
tcpclient.pas
View File

@ -60,6 +60,7 @@ end;
procedure TClientMainThread.execute;
begin
doStart;
log(self,'start main thread');
Connect.Connect(Host,Port);
while not terminated do

1
tcpserver.pas
View File

@ -60,6 +60,7 @@ procedure TServerMainThread.execute;
var
n: integer;
begin
doStart;
log(self,'start main thread');
Connect.Listen(Port);
n := 0;

27
tcpthreadhelper.pas
View File

@ -85,10 +85,12 @@ type
fclients: TList;
flogger: TLogger;
fThreadClass: TConnectionThreadClass;
fStarted:boolean;
function getThread(index: TLSocket): TConnectionThread;
procedure TerminateClients;
protected
procedure Log(Sender:TObject; msg: string);
procedure doStart; virtual;
public
property Port: integer read fPort;
property Connect: TLTCP read fCon;
@ -100,7 +102,7 @@ type
procedure Accept(aSocket: TLSocket);
procedure doDisconnect(aSocket: TLSocket);
procedure doConnect(aSocket: TLSocket);
procedure doTerminate;override;
procedure TerminatedSet;override;
procedure NetError(const msg: string; aSocket: TLSocket);
constructor Create(AThreadClass: TConnectionThreadClass; ALogger: TLogger; APort: integer);
destructor Destroy; override;
@ -148,8 +150,7 @@ begin
log(self,GuidToString(clt.ID));
clt.Terminate;
clt.WaitFor;
clt.Free;
clt.free;
except on e: Exception do
begin
log(self, '!!ERROR Destroy ' + e.Message);
@ -166,6 +167,11 @@ begin
fLogger(Sender,Msg);
end;
procedure TMainThread.doStart;
begin
fStarted := true;
end;
procedure TMainThread.RemoveClient(clt: TConnectionThread);
begin
fclients.Remove(clt);
@ -221,8 +227,6 @@ begin
if clt.terminated then exit;
log(self,format('disconnected %s on %d ',[GUIDToString(clt.ID), aSocket.Handle]));
clt.Terminate;
clt.WaitFor;
clt.free;
fclients.remove(clt);
except on e: Exception do
@ -245,9 +249,10 @@ begin
clt.Start;
end;
procedure TMainThread.doTerminate;
procedure TMainThread.TerminatedSet;
begin
inherited doTerminate();
inherited TerminatedSet();
if fStarted then
TerminateClients;
end;
@ -266,6 +271,7 @@ constructor TMainThread.Create(AThreadClass: TConnectionThreadClass;
ALogger: TLogger; APort: integer);
begin
inherited Create(true);
fStarted := false;
fThreadClass:=AThreadClass;
fCon := TLTcp.Create(nil);
fclients := TList.Create;
@ -970,6 +976,7 @@ var
i,d1,d2 : integer;
begin
inherited Create(true);
//FreeOnTerminate:=true;
fCache := TRoundBuffer.Create(10000);
fSocket := ASocket;
fOwner := AOwner;
@ -980,10 +987,8 @@ end;
destructor TConnectionThread.Destroy;
begin
log('Destroy');
fCache.Free;
fOwner.removeClient(self);
log('Destroy2');
inherited Destroy;
end;
@ -1018,14 +1023,14 @@ begin
end;
end;
Cache.Close;
Socket.Disconnect();
log('terminated');
//Socket.Disconnect();
end;
procedure TConnectionThread.TerminatedSet;
begin
log('terminate required');
Cache.Close;
fOwner.removeClient(self);
end;
{ TClientThread }

32
xpaccessunit.pas
View File

@ -1,41 +1,41 @@
unit xpAccessUnit;
{$H+}
interface
function EncryptText(const AText: String) : String;
function MySQLPassword(const AText: Ansistring) : Ansistring;
uses
DCPcrypt2;
function EncryptText(const AText: String; aHash: TDCP_hash) : String;
function MySQLPassword(const AText: Ansistring; aHash: TDCP_hash) : Ansistring;
implementation
uses
SysUtils,
Variants, DCPsha1, DCPdes,
ConnectionsDmUnit;
Variants;
function DecryptText(const AText: string) : string;
begin
Result := AText;
end;
function EncryptText(const AText: String) : String;
function EncryptText(const AText: String; aHash: TDCP_hash): String;
begin
Result := String(MySQLPassword(AnsiString(StringReplace(AText, '\', '\\', [rfReplaceAll, rfIgnoreCase]))));
Result := String(MySQLPassword(AnsiString(StringReplace(AText, '\', '\\', [rfReplaceAll, rfIgnoreCase])),aHash));
end;
function MySQLPassword(const AText: Ansistring) : Ansistring;
function MySQLPassword(const AText: Ansistring; aHash: TDCP_hash): Ansistring;
var
Digest: packed array[0..19] of byte;
i: integer;
begin
Result := '*';
ConnectionsDM.Hash.Init;
ConnectionsDM.Hash.UpdateStr(AText);
ConnectionsDM.Hash.Final(Digest);
ConnectionsDM.Hash.Burn;
ConnectionsDM.Hash.Init;
ConnectionsDM.Hash.Update(Digest,20);
ConnectionsDM.Hash.Final(Digest);
ConnectionsDM.Hash.Burn;
aHash.Init;
aHash.UpdateStr(AText);
aHash.Final(Digest);
aHash.Burn;
aHash.Init;
aHash.Update(Digest,20);
aHash.Final(Digest);
aHash.Burn;
for i:= 0 to 19 do
Result := Result + AnsiString(IntToHex(Digest[i], 2));
end;