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

logging

Browse Source
This commit is contained in:
Алексей Заблоцкий 2023-10-19 15:14:52 +03:00
parent 675fa2a89a
commit e9066d84e0
15 changed files with 168 additions and 184 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

Binary file not shown.

26
baseconnection.pas
View File

@ -46,7 +46,7 @@ type
function CheckArgs(out Errors: TStrings): boolean; virtual; abstract;
function ParseCommand(ACode: DWORD; iParam: QWORD; ACommand: string; Args: TStrings; intArgs: TParamArray; CmdData: TStream; out Errors: TStrings): boolean;
function ParseArguments(Args: TStrings; out Errors: TStrings): boolean; virtual; abstract;
procedure Log(msg: string);
procedure Log(ALevel:TLogLevel; msg: string);
function ProcessOptionValues(ParamName: string; out Answer: string; out RetValue: QWORD; out OptionValues: TStrings): boolean; virtual; abstract;
end;
TCommandClass=class of TCommand;
@ -89,7 +89,7 @@ type
User: string;
UserID: integer;
LastAccess: TDateTime;
procedure Log(sender: TObject; msg: string);
procedure Log(ALevel:TLogLevel;sender: TObject; msg: string);
property Created: TDateTime read fCreated;
property LastReceive: TDateTime read fCommandReceived;
property LastComplete: TDateTime read fCommandCompleted;
@ -153,7 +153,7 @@ end;
destructor TBaseConnection.Destroy;
begin
log(self,'Destroy');
log(mtExtra,self,'Destroy');
Processor.Free;
Commands.Free;
DoneCommands.Free;
@ -168,7 +168,7 @@ var
cc: TCommandClass;
cmd: TCommand;
begin
log(self,'AddCommand '+ACommandClass+ ' '+ACommandName);
log(mtDebug,self,'AddCommand '+ACommandClass+ ' '+ACommandName);
fCommandReceived:=Now();
cc := TCommandCollection.Find(ACommandClass,ACommandName);
if assigned(cc) then
@ -203,7 +203,7 @@ end;
function TBaseConnection.RunCommand(ACommand: TCommand): boolean;
begin
ACommand.doRun();
log(Self,'complete '+ACommand.CommandID);
log(mtDebug,Self,'complete '+ACommand.CommandID);
fCommandCompleted:=Now();
inc(nCommandReady);
end;
@ -238,7 +238,7 @@ begin
if LastAccess>d then d := LastAccess;
if (now()-d)*24*60>fTimeout then
begin
log(self,'TIMEOUT');
log(mtInfo,self,'TIMEOUT');
terminate;
end
else
@ -268,23 +268,23 @@ begin
end;
end;
procedure TBaseConnection.Log(sender: TObject; msg: string);
procedure TBaseConnection.Log(ALevel: TLogLevel; sender: TObject; msg: string);
begin
if assigned(fLogger) then
flogger(sender,msg);
flogger(ALevel,sender,msg);
end;
procedure TBaseConnection.Execute;
var
cmd: TCommand;
begin
log(self,'started');
log(mtExtra,self,'started');
while not terminated do
begin
while Commands.Count>0 do
begin
cmd := Commands.Objects[0] as TCommand;
log(self,format('run(%s) %s %s ',[cmd.CommandID,cmd.CommandName, cmd.CommandSubClass]));
log(mtDebug,self,format('run(%s) %s %s ',[cmd.CommandID,cmd.CommandName, cmd.CommandSubClass]));
try
RunCommand(cmd);
finally
@ -296,7 +296,7 @@ begin
if fCheckConnect then Idle;
sleep(200);
end;
log(self,'finished');
log(mtExtra,self,'finished');
end;
function TBaseConnection.ProcessOptionValues(ReportName, ParamName: string;
@ -421,9 +421,9 @@ begin
result := ParseArguments(fData.Keys,Errors);
end;
procedure TCommand.Log(msg: string);
procedure TCommand.Log(ALevel: TLogLevel; msg: string);
begin
connect.log(self, self.CommandID+#09+msg)
connect.log(ALevel,self, self.CommandID+#09+msg)
end;
end.

21
cgi_daemon.pas
View File

@ -50,14 +50,14 @@ end;
procedure TLMSReportCGI.DataModuleCreate(Sender: TObject);
begin
//{$IFDEF WINDOWS}
self.Logger.Active:=false;
{$IFDEF WINDOWS}
self.Logger.AppendContent:=true;
self.Logger.LogType := ltFile;
self.Logger.FileName := format('%s/server.log',[extractfilepath(paramstr(0))]);
{$ENDIF}
self.logger.Identification:='LMS-Report-Service';
self.Logger.Active:=true;
//{$ENDIF}
self.logger.Info('TLMSReportCGI.DataModuleCreate');
workThread := TDaemonThread.create(self);
end;
@ -68,15 +68,14 @@ end;
procedure TLMSReportCGI.DataModuleStart(Sender: TCustomDaemon; var OK: Boolean);
begin
logger.Info('start daemon thread');
logger.Info('Запуск сервиса');
workThread.Start;
logger.Info('daemon thread started');
OK := true;
end;
procedure TLMSReportCGI.DataModuleStop(Sender: TCustomDaemon; var OK: Boolean);
begin
debugln('stop daemon thread');
debugln('Останов сервиса');
workThread.Terminate;
end;
@ -84,24 +83,20 @@ end;
procedure TDaemonThread.Execute;
begin
flogger.Info('TDaemonThread.Execute');
flogger.debug('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
if sleepMin(5) then
fData.Idle(self);
flogger.Info('TDaemonThread.Idle');
end;
fData.Stop;
finally
fData.free;
end;
flogger.debug('TDaemonThread.Execute.complete');
end;
function TDaemonThread.sleepMin(n: integer): boolean;

27
cgidm.pas
View File

@ -45,7 +45,7 @@ type
function GetData(ASQL: string): TDataSet;
function CheckUser(const login,password: string; out UserID: integer): boolean;
procedure OpenConnection;
procedure log(Sender: TObject; msg: string);
procedure log(ALevel: TLogLevel; Sender: TObject; msg: string);
procedure LogError(Sender: TObject; e: Exception; msg: string);
procedure ExecuteSQL(ASQL: string);
constructor CreateWithLogger(ALogger: TLogger);
@ -63,15 +63,14 @@ uses
procedure TNIDBDM.DataModuleCreate(Sender: TObject);
begin
log(sender,'TnnzConnection.Create');
log(mtDebug,sender,'TnnzConnection.Create');
fcon := TnnzConnection.Create(self);
log(sender,'TnnzConnection.Create.ok');
end;
procedure TNIDBDM.DataModuleDestroy(Sender: TObject);
begin
log(sender,'destroy');
log(mtDebug,sender,'destroy');
fcon.Connected:=false;
fcon.free;
end;
@ -288,7 +287,7 @@ end;
function TNIDBDM.QueryValue(ASQL: string; Default: string): string;
begin
log(self,'QueryValue'#13#10+ASQL);
log(mtDebug,self,'QueryValue'#13#10+ASQL);
with TnnzQuery.Create(self) do
try
Connection := fcon;
@ -302,7 +301,7 @@ end;
function TNIDBDM.QueryIntValue(ASQL: string): integer;
begin
log(self,'QueryIntValue'#13#10+ASQL);
log(mtDebug,self,'QueryIntValue'#13#10+ASQL);
with TnnzQuery.Create(self) do
try
Connection := fcon;
@ -317,7 +316,7 @@ end;
function TNIDBDM.GetData(ASQL: string): TDataSet;
begin
log(self,'getData '#13#10+ASQL);
log(mtDebug,self,'getData '#13#10+ASQL);
result := TnnzQuery.Create(self);
with result as TnnzQuery do
begin
@ -331,39 +330,39 @@ end;
function TNIDBDM.CheckUser(const login, password: string; out UserID: integer
): boolean;
begin
log(self,'CheckUser');
log(mtInfo,self,'CheckUser '+login);
UserID := QueryIntValue(format('Select coalesce((select min(p.mid) from people p where login=%s and password=%s),0) ',[StringAsSQL(login),StringAsSQl(password)]));
result := UserID>0;
end;
procedure TNIDBDM.OpenConnection;
begin
log(self,'OpenConnection');
log(mtDebug,self,'OpenConnection');
fcon.Connected:=true;
fcon.Identify;
end;
procedure TNIDBDM.log(Sender: TObject; msg: string);
procedure TNIDBDM.log(ALevel: TLogLevel; Sender: TObject; msg: string);
begin
if assigned(flogger) then
flogger(Sender,msg);
flogger(ALevel,Sender,msg);
end;
procedure TNIDBDM.LogError(Sender: TObject; e: Exception; msg: string);
begin
log(Sender,'!!ERROT at '+msg+#13#10+e.ClassName+#13#10+e.message);
log(mtERROR,Sender,'!!ERROT at '+msg+#13#10+e.ClassName+#13#10+e.message);
end;
procedure TNIDBDM.ExecuteSQL(ASQL: string);
begin
log(self,'ExecuteSQL '+ASQL);
log(mtDebug,self,'ExecuteSQL '+ASQL);
connection.ExecuteSQL(ASQL);
end;
constructor TNIDBDM.CreateWithLogger(ALogger: TLogger);
begin
fLogger := ALogger;
log(nil,'TNIDBDM.Create');
log(mtDebug,nil,'TNIDBDM.Create');
inherited Create(nil);
end;

17
cgireport.pas
View File

@ -5,7 +5,7 @@ unit cgiReport;
interface
uses
Classes, SysUtils, baseconnection;
Classes, SysUtils, baseconnection, extTypes;
type
{ TReportCommand }
@ -13,7 +13,7 @@ type
private
procedure CreateVariablesTable;
procedure UpdateCodeWithArguments(var code: string);
procedure SetStage(Sender:TObject; stageName: string);
procedure SetStage(ALevel:TLogLevel; Sender:TObject; stageName: string);
public
ReportID: integer;
ReportName: string;
@ -32,7 +32,7 @@ type
implementation
uses
cgiDM,extTypes,reportDMUnit, types, strutils, LazUTF8;
cgiDM,reportDMUnit, types, strutils, LazUTF8;
{ TReportCommand }
procedure TReportCommand.CreateVariablesTable;
@ -54,7 +54,8 @@ begin
Code := StringReplace(Code,'{#user}',inttostr(self.Connect.UserID),[rfReplaceAll]);
end;
procedure TReportCommand.SetStage(Sender: TObject; stageName: string);
procedure TReportCommand.SetStage(ALevel: TLogLevel; Sender: TObject;
stageName: string);
begin
fcurrentStage:=format('выполняется (%s)',[stageName]);
end;
@ -111,14 +112,14 @@ var
vs: string;
vi: integer;
begin
log('FillVars');
log(mtDebug,'FillVars');
script := format('insert into tmp_report_variables(name,value_string,var_type) values(''UserName'',%s,0); ',[TNIDBDM.StringAsSQL(self.Connect.User)]);
ASQL := format('select name,query from xp_report_variables where xp_rpt_id=%d and var_type=0',[ReportID]);
with connect.Processor.GetData(ASQL) do
try
while not eof do
begin
log(FieldByName('name').asString);
log(mtDebug, FieldByName('name').asString);
q := FieldByName('query').AsString;
UpdateCodeWithArguments(q);
try
@ -139,7 +140,7 @@ begin
try
while not eof do
begin
log(FieldByName('name').asString);
log(mtDebug, FieldByName('name').asString);
q := FieldByName('query').AsString;
UpdateCodeWithArguments(q);
try
@ -177,7 +178,7 @@ begin
end;
ReportTitle := connect.Processor.QueryValue(format('select r.name from xp_report_cgi g join xp_report r on r.xp_rpt_id=g.xp_rpt_id where cgi_name=%s',[TNidbDM.StringAsSQL(ReportName)]));
CreateVariablesTable;
log(ReportTitle);
log(mtInfo,'Построение отчета '+ReportTitle);
connect.ReportProcessor.RecordID:=ReportID;
fcurrentStage := 'исполняется (подготовка)';
try

53
connectionsdmunit.pas
View File

@ -24,7 +24,6 @@ type
procedure DataModuleCreate(Sender: TObject);
procedure DataModuleDestroy(Sender: TObject);
private
fLogFolder: string;
MainCon: TNIDBDM;
conlist: TList;
Input: TServerMainThread;
@ -34,7 +33,6 @@ type
fServicePort: integer;
fLogger: TEventLog;
fTimeOut: integer;
LogLock: TCriticalSection;
fRunning: boolean;
function getConnection(ID: string): TBaseConnection;
function NewConnection: TBaseConnection;
@ -52,7 +50,7 @@ type
property DataPort: integer read fDataPort;
property DataBase: string read fDataBase;
property Logger: TEventLog read fLogger write fLogger;
procedure Log(Sender: TObject; msg: string);
procedure Log(ALevel: TLogLevel; Sender: TObject; msg: string);
procedure Start;
procedure Stop;
procedure Idle(Sender: TObject);
@ -78,26 +76,16 @@ uses
procedure TConnectionsDM.DataModuleCreate(Sender: TObject);
begin
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;
log(sender,'datamodulecreate.4');
input := TServerMainThread.Create(@log,fServicePort,@ProcessRequest);
log(sender,'datamodulecreate.ok');
end;
procedure TConnectionsDM.DataModuleDestroy(Sender: TObject);
begin
log(Sender,'Destroy');
log(mtExtra,Sender,'Destroy');
ClearConnections;
if fRunning then
@ -107,7 +95,6 @@ begin
end;
Input.Free;
MainCon.Free;
LogLock.Free;
conList.Free;
end;
@ -137,7 +124,7 @@ begin
result.Host:=DataHost;
result.port:=DataPort;
result.DataBase:=DataBase;
log(self, 'New '+result.ConnectionID);
log(mtDebug, self, 'New '+result.ConnectionID);
result.Init;
end;
@ -150,7 +137,7 @@ begin
for i := conList.Count-1 downto 0 do
if TBaseConnection(conlist[i]).ConnectionID=ID then
begin
log(self,'terminate '+ID);
log(mtDebug,self,'terminate '+ID);
TBaseConnection(conlist[i]).terminate;
exit;
end;
@ -162,7 +149,7 @@ var
i: integer;
con: TBaseConnection;
begin
log(self,'ClearConnections');
log(mtDebug, self,'ClearConnections');
for i := 0 to conList.Count-1 do
begin
con := TBaseConnection(conlist[i]);
@ -183,7 +170,7 @@ begin
con := TBaseConnection(conlist[i]);
if con.Finished then
begin
log(self,'Destroy terminated '+con.ConnectionID);
log(mtDebug, self,'Destroy terminated '+con.ConnectionID);
con.free;
conlist.delete(i);
end;
@ -206,7 +193,7 @@ var
userName,conID,cmdID: string;
cmd: TCommand;
begin
log(Self,'Process Request '+ACommand);
log(mtInfo, Self,'Process Request '+ACommand);
ClearTerminated;
result := false;
RetValue := 0;
@ -485,36 +472,40 @@ begin
fDataPort := ini.ReadInteger('DATA','port',7079);
fDataBase:= ini.ReadString('DATA','database','');
fServicePort := ini.ReadInteger('PARAMS','port',6543);
flogFolder:=ini.ReadString('PARAMS','log','');
fTimeOut:=ini.ReadInteger('PARAMS','timeout',CONNECT_TIMEOUT);
log(self,format('server %s:%d/%s',[fDataHost,fDataPort,fDataBase]));
log(mtInfo,self,format('server %s:%d/%s',[fDataHost,fDataPort,fDataBase]));
finally
ini.free;
end;
end;
procedure TConnectionsDM.Log(Sender: TObject; msg: string);
procedure TConnectionsDM.Log(ALevel: TLogLevel; Sender: TObject; msg: string);
var
f: TextFile;
s: string;
begin
if not assigned(fLogger) then exit;
try
// assignefile(fLogFolder
if Sender is TComponent then
flogger.Debug(DateTimeToStr(NOW())+#09+Sender.ClassName+'-'+(Sender as TComponent).Name+#09+Msg)
else if Assigned(Sender) then
flogger.Debug(DateTimeToStr(NOW())+#09+Sender.ClassName+ #09+ Msg)
s := Sender.ClassName+'-'+(Sender as TComponent).Name
else if assigned(Sender) then
s := Sender.ClassName
else
flogger.Debug(DateTimeToStr(NOW())+#09+ #09+ Msg);
except on e: Exception do
raise;
s := '[NIL]';
s := DateTimeToStr(NOW())+#09+s+#09+Msg;
case ALevel of
mtError: fLogger.Error(s);
mtWarning: fLogger.Warning(s);
mtInfo: flogger.Info(s);
mtDebug: fLogger.Debug(s);
end;
except
end;
end;
procedure TConnectionsDM.Start;
begin
log(self,'Start');
MainCon.connection.RemoteHost:=DataHost;
MainCon.connection.RemotePort:=DataPort;
MainCon.connection.Database:=DataBase;

13
exttypes.pas
View File

@ -28,7 +28,8 @@ const
type
TBuffer=Array of Byte;
TParamArray=Array of QWORD;
TLogger=procedure(Sender: TObject; Msg: String) of object;
TLogLevel=(mtError,mtWarning,mtInfo,mtDebug,mtExtra);
TLogger=procedure(ALevel: TLogLevel; Sender: TObject; Msg: String ) of object;
EFormatException=class(Exception);
{ TConnectionThread }
@ -73,7 +74,7 @@ procedure CopyBytes(var Dest: PByte; const Data: dword); overload;
procedure CopyBytes(var Dest: PByte; const Data: qword); overload;
procedure CopyBytes(var Dest: PByte; const Data: TBuffer); overload;
procedure CopyParamArray(const Source: TParamArray; out Dest: TParamArray);
procedure LogStrings(logger: TLogger;Sender: TObject;Name: string; Data: TStrings);
procedure LogStrings(ALevel: TLogLevel; logger: TLogger;Sender: TObject;Name: string; Data: TStrings);
implementation
procedure CopyParamArray(const Source: TParamArray; out Dest: TParamArray);
var
@ -85,16 +86,16 @@ begin
Dest[i] := Source[i];
end;
procedure LogStrings(logger: TLogger; Sender: TObject; Name: string;
Data: TStrings);
procedure LogStrings(ALevel: TLogLevel; logger: TLogger; Sender: TObject;
Name: string; Data: TStrings);
var
i: integer;
begin
if assigned(logger) and assigned(Data) then
begin
logger(Sender,Name);
logger(ALevel,Sender,Name);
for i := 0 to Data.Count-1 do
logger(Sender,' '+Data[i]);
logger(ALevel, Sender,' '+Data[i]);
end;
end;

25
lms_cgi.lpr
View File

@ -22,7 +22,7 @@ Type
const Code:DWORD; const QValue: QWORD; const Answer: string; const Values: TStrings; const iValues: TParamArray; const Data: TStream): boolean;
Public
Procedure HandleRequest(ARequest : Trequest; AResponse : TResponse); override;
procedure log(Sender: TObject; msg: string);
procedure log(ALevel: TLogLevel; Sender: TObject; msg: string);
end;
@ -50,7 +50,6 @@ function TMyCGIHandler.answerReady(Sender: TMainThread; const mode: byte;
const Values: TStrings; const iValues: TParamArray; const Data: TStream
): boolean;
begin
log(self,'AnswerReady');
fAnswer:=Answer;
fMode:=mode;
fCode:=code;
@ -76,8 +75,8 @@ var
k,v: string;
allfields: TStrings;
begin
log(self,'HandleRequest');
LogStrings(@log,self,'QueryFields',Arequest.QueryFields);
log(mtInfo,self,'Request '+ARequest.Command);
LogStrings(mtInfo, @log,self,'QueryFields',Arequest.QueryFields);
allfields := TStringList.Create;
try
allfields.AddStrings(ARequest.QueryFields);
@ -89,7 +88,7 @@ begin
finally
allfields.free;
end;
log(self,'Data READY');
log(mtDebug,self,'Data READY');
if not assigned(fData) then
begin
AResponse.ContentType := 'application/json';
@ -117,19 +116,27 @@ begin
fData.Seek(0,soFromBeginning);
AResponse.ContentStream := fData;
end;
log(self,'Sending');
log(mtDebug,self,'Sending');
AResponse.SendContent;
log(self,'Sent');
log(mtDebug,self,'Sent');
end;
procedure TMyCGIHandler.log(Sender: TObject; msg: string);
procedure TMyCGIHandler.log(ALevel: TLogLevel; Sender: TObject; msg: string);
var
f: TextFile;
s: string;
begin
if (Owner as TMyCGIApp).LogFolder='' then exit;
case ALevel of
mtError: s := '!!ERROR: ';
mtWarning: s := '!WARNING: ';
mtInfo: s := #09;
mtDebug: s := #09#09;
mtExtra: s := #09#09#09;
end;
assignfile(f, (Owner as TMyCGIApp).LogFolder);
if fileexists((Owner as TMyCGIApp).LogFolder) then append(f) else rewrite(f);
writeln(f,msg);
writeln(f,s+msg);
closefile(f);
end;

BIN
lms_cgi_server
View File

Binary file not shown.

BIN
lmsreport
View File

Binary file not shown.

13
maintcpserver.pas
View File

@ -7,7 +7,7 @@ interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls,
tcpClient,tcpServer, tcpthreadhelper,
ConnectionsDmUnit, syncobjs, extTypes;
ConnectionsDmUnit, syncobjs, extTypes, eventlog;
type
@ -36,7 +36,7 @@ type
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
fLogger: TEventLog;
Server: TConnectionsDM;
Client: TClientMainThread;
cmdDone: boolean;
@ -65,7 +65,13 @@ uses
procedure TCGIServerGUI.FormCreate(Sender: TObject);
begin
Server := TConnectionsDM.Create(self);
fLogger := TEventLog.Create(self);
fLogger.LogType:=TLogType.ltFile;
fLogger.FileName:=ChangeFileExt(paramstr(0),'.log');
flogger.Identification:='LMS-Report-Test';
fLogger.Active:=false;
fLogger.Active:=true;
Server := TConnectionsDM.CreateWithLog(fLogger);
ConnectionsDM := Server;
cmdDone := true;
started := false;
@ -104,6 +110,7 @@ end;
procedure TCGIServerGUI.FormDestroy(Sender: TObject);
begin
Server.Free;
fLogger.Free;
end;
procedure TCGIServerGUI.LogQuery(const qtype: integer; const command: string;

46
reportdmunit.pas
View File

@ -173,13 +173,13 @@ end;
procedure TReportDM.frxReportLoadTemplate(Report: TfrxReport;
const TemplateName: String);
begin
NidbData.log(self,'LoadTemplate '+TemplateName);
NidbData.log(mtDebug,self,'LoadTemplate '+TemplateName);
end;
function TReportDM.frxReportLoadDetailTemplate(Report: TfrxReport;
const TemplateName: String; const AHyperlink: TfrxHyperlink): Boolean;
begin
NidbData.log(self,'LoadDetailTemplate '+TemplateName);
NidbData.log(mtDebug,self,'LoadDetailTemplate '+TemplateName);
end;
procedure TReportDM.CreateDBDataSet(Query: TReportQuery; EditReport: Boolean);
@ -190,7 +190,7 @@ var
begin
if Query.ID>0 then
begin
NidbData.log(self,'CreateDBDataSet '+Query.Name);
NidbData.log(mtDebug,self,'CreateDBDataSet '+Query.Name);
ds := TfrxDBDataset.Create(Self);
Query.Data := ds;
ds.Tag := PtrInt(Query);
@ -363,7 +363,7 @@ var
q: TReportquery;
i: integer;
begin
NidbData.log(self,'LoadQueries');
NidbData.log(mtDebug,self,'LoadQueries');
SQL := format(
'select q.xp_rpt_q_id,qp.xp_rpt_q_id as ParentID,q.Link_field, '+
' q.Name,'+
@ -394,12 +394,12 @@ begin
for i := ReportQueries.QueryCount-1 downto 0 do
if ReportQueries.Queries[i].ParentID>0 then
begin
NidbData.log(self,'LoadQueries.'+ReportQueries.Queries[i].Name);
NidbData.log(mtDebug,self,'LoadQueries.'+ReportQueries.Queries[i].Name);
q := ReportQueries.Find(ReportQueries.Queries[i].ParentID);
if assigned(q) then
q.AddQuery(ReportQueries.Queries[i]);
end;
NidbData.log(self,'LoadQueries-OK');
NidbData.log(mtDebug,self,'LoadQueries-OK');
end;
procedure TReportDM.LoadDefaultVariables(AVariables: TxpMemParamManager);
@ -408,7 +408,7 @@ var
l: TStrings;
i: integer;
begin
NidbData.log(self,'LoadDefaultVariables');
NidbData.log(mtDebug,self,'LoadDefaultVariables');
SQL := 'select name,value from options where name in (''GOU_Name'',''Dep_Name'')';
with NidbData.GetData(sql) do
@ -432,7 +432,7 @@ var
s: TStream;
v: Variant;
begin
NidbData.log(self,'LoadLogos');
NidbData.log(mtDebug,self,'LoadLogos');
SQL := 'select name,value from options where name in (''Dep_Logo'',''GOU_Logo'')';
with NidbData.GetData(sql) do
try
@ -464,13 +464,13 @@ procedure TReportDM.LoadVariables(AVariables, AParam: TxpMemParamManager);
var
sql: string;
begin
NidbData.log(self,'LoadVariables');
NidbData.log(mtDebug,self,'LoadVariables');
sql := 'select name,value_string, value_int from tmp_report_variables where var_type=0';
with NidbData.GetData(sql) do
try
while not eof do
begin
NidbData.log(self,fieldbyname('name').AsString);
NidbData.log(mtDebug,self,fieldbyname('name').AsString);
if not fieldbyname('value_string').IsNull then
AVariables[fieldbyname('name').AsString] := fieldbyname('value_string').AsString
else if not fieldbyname('value_int').IsNull then
@ -480,13 +480,13 @@ begin
finally
free;
end;
NidbData.log(self,'LoadParams');
NidbData.log(mtDebug,self,'LoadParams');
sql := 'select name,value_string, value_int from tmp_report_variables where var_type=1';
with NidbData.GetData(sql) do
try
while not eof do
begin
NidbData.log(self,fieldbyname('name').AsString);
NidbData.log(mtDebug,self,fieldbyname('name').AsString);
if not fieldbyname('value_string').IsNull then
AParam[fieldbyname('name').AsString] := fieldbyname('value_string').AsString
else if not fieldbyname('value_int').IsNull then
@ -499,7 +499,7 @@ begin
//
//
NidbData.log(self,'LoadVariables-OK');
NidbData.log(mtDebug,self,'LoadVariables-OK');
end;
procedure TReportDM.OnMasterRecord(Sender: TObject);
@ -544,7 +544,7 @@ var
BlobStream : TStream;
begin
NidbData.log(self,'ExportReport.TemplateArh');
NidbData.log(mtDebug,self,'ExportReport.TemplateArh');
ReportStream := TMemoryStream.Create;
try
with NidbData.GetData(format('select TemplateArh from xp_report where xp_rpt_id=%d',[RecordID])) do
@ -582,7 +582,7 @@ var
i: integer;
v: variant;
begin
NidbData.log(self,'CopyReportVariables');
NidbData.log(mtDebug,self,'CopyReportVariables');
for I := Low(AVariables.Params) to High(AVariables.Params) do
begin
if VarIsStr(AVariables.Params[i][1]) then
@ -613,13 +613,13 @@ var
AVariables, AParam: TxpMemParamManager;
begin
frxReport.EngineOptions.EnableThreadSafe:=true;
NidbData.log(self,'ExportReport');
NidbData.log(mtDebug,self,'ExportReport');
ReportQueries := TReportQuery.Create;
AVariables := TxpMemParamManager.Create;
AParam := TxpMemParamManager.Create;
try
if assigned(OnStage) then
OnStage(self,'список запросов');
OnStage(mtExtra, self,'список запросов');
LoadQueries;
LoadDefaultVariables(AVariables);
LoadLogos(AVariables);
@ -627,18 +627,17 @@ begin
frxReport.EngineOptions.DestroyForms := False;
// Создаём источники данных
if assigned(OnStage) then
OnStage(self,'подготовка данных');
OnStage(mtExtra,self,'подготовка данных');
CreateDBDataSet(ReportQueries);
if assigned(OnStage) then
OnStage(self,'загрузка шаблона');
OnStage(mtExtra,self,'загрузка шаблона');
LoadReportTemplate;
CopyReportVariables(AVariables,AParam);
TxpFRFunctions.SetReport(NidbData,AVariables);
NidbData.log(self,'preparing');
if assigned(OnStage) then
OnStage(self,'формирование отчета');
OnStage(mtExtra,self,'формирование отчета');
begin
try
@ -659,9 +658,8 @@ begin
end;
try
if assigned(OnStage) then
OnStage(self,'выгрузка');
OnStage(mtExtra,self,'выгрузка');
NidbData.log(self,'exporting');
flt.ShowDialog := false;
flt.Stream := Data;
flt.FileName:='';
@ -685,7 +683,7 @@ begin
AVariables.Free;
AParam.Free;
end;
NidbData.log(self,'Report complete');
NidbData.log(mtDebug,self,'Report complete');
end;

10
tcpclient.pas
View File

@ -67,7 +67,7 @@ end;
destructor TClientMainThread.Destroy;
begin
log(self,'destroy');
log(mtExtra, self,'destroy');
Connect.Disconnect();
fFields.Free;
inherited Destroy;
@ -76,7 +76,7 @@ end;
procedure TClientMainThread.execute;
begin
doStart;
log(self,'start main thread');
log(mtExtra, self,'start main thread');
Connect.Connect(Host,Port);
while not terminated do
begin
@ -84,7 +84,7 @@ begin
sleep(10);
end;
Connect.Disconnect();
log(self,'terminated');
log(mtExtra, self,'terminated');
end;
procedure TClientMainThread.ProcessConnect(thread: TConnectionThread);
@ -108,7 +108,7 @@ begin
except on e:Exception do
begin
log(self,'!!ERROR ProcessAnswer '+e.message);
log(mtError, self,'!!ERROR ProcessAnswer '+e.message);
raise;
end;
end;
@ -123,7 +123,7 @@ procedure TClientThread.ProcessMessage(const mode: byte; const Code: DWORD;
const Param: QWord; const ACommand: string; const Values: TStrings;
const intData: TParamArray; const Data: TStream);
begin
log(format('ProcessMessage(%d) Param=%x, Answer=%s ',[code,Param,ACommand]));
log(mtDebug,format('ProcessMessage(%d) Param=%x, Answer=%s ',[code,Param,ACommand]));
terminate;
Owner.Terminate;
(Owner as TClientMainThread).ProcessAnswer(mode,code,Param,ACommand,Values,intData,Data);

12
tcpserver.pas
View File

@ -40,12 +40,12 @@ function TServerMainThread.processReceive(const CommandID: DWORD;
RetValue: QWord; out Answer: string; out rValues: TStrings; out
iValues: TParamArray; out ByteData: TStream): boolean;
begin
log(self,'ProcessReceive '+ACommand);
log(mtDebug,self,'ProcessReceive '+ACommand);
if assigned(fOnReceive) then
result := fOnReceive(self,CommandID,Param,ACommand,Fields,IParams,Data,Code,RetValue,Answer,rValues,iValues,ByteData)
else
begin
log(self,'Processor not assigned');
log(mtWarning,self,'Processor not assigned');
result := false;
Code := ErrorProcessor;
RetValue := 0;
@ -61,7 +61,7 @@ var
n: integer;
begin
doStart;
log(self,'start main thread');
log(mtExtra,self,'start main thread');
Connect.Listen(Port);
n := 0;
while not terminated do
@ -70,7 +70,7 @@ begin
Connect.CallAction;
except on e: Exception do
log(e, '!!ERROR '+e.message);
log(mtError,e, '!!ERROR '+e.message);
end;
sleep(10);
inc(n);
@ -110,7 +110,7 @@ var
iVals: TParamArray;
ok: boolean;
begin
log(format('ProcessMessage(%d) Param=%x, Command %s ',[code,Param,ACommand]));
log(mtDebug, format('ProcessMessage(%d) Param=%x, Command %s ',[code,Param,ACommand]));
try
ok := (Owner as TServerMainThread).ProcessReceive(Code,Param,ACommand,Values,IntData,Data,res,rVal,s,Vals,iVals,B);
try
@ -125,7 +125,7 @@ begin
except on e:Exception do
begin
log('!!ERROR ProcessMessage '+e.message);
log(mtError,'!!ERROR ProcessMessage '+e.message);
raise;
end;
end;

89
tcpthreadhelper.pas
View File

@ -47,7 +47,7 @@ type
property Owner: TMainThread read fOwner;
property Socket:TLSocket read fSocket;
property Cache: TRoundBuffer read fCache;
procedure log(msg: string);
procedure log(ALevel: TLogLevel; msg: string);
procedure ProcessMessage(const mode: byte;const Code:DWORD; const Param:QWord; const ACommand: string;const Values: TStrings; const intData: TParamArray; const Data: TStream); virtual; abstract;
class function Role: string; virtual; abstract;
procedure SendBuffer(const Buffer: TBuffer; Len: dword);
@ -89,7 +89,7 @@ type
function getThread(index: TLSocket): TConnectionThread;
procedure TerminateClients;
protected
procedure Log(Sender:TObject; msg: string);
procedure Log(ALevel: TLogLevel; Sender:TObject; msg: string);
procedure doStart; virtual;
public
property Port: integer read fPort;
@ -127,11 +127,11 @@ begin
if TConnectionThread(fclients[i]).Socket=index then
begin
result := TConnectionThread(fclients[i]);
log(self,format('getThread(%d) %s',[index.Handle,guidToString(result.ID)]));
log(mtDebug,self,format('getThread(%d) %s',[index.Handle,guidToString(result.ID)]));
exit;
end;
result := fThreadClass.Create(self,index);
log(self,format('new Thread(%d) %s',[index.Handle,guidToString(result.ID)]));
log(mtDebug,self,format('new Thread(%d) %s',[index.Handle,guidToString(result.ID)]));
fclients.Add(Result);
end;
@ -141,19 +141,19 @@ var
i: integer;
clt: TConnectionThread;
begin
log(Self,'Terminate Clients');
log(mtDebug,Self,'Terminate Clients');
for i := fclients.Count-1 downto 0 do
begin
sleep(0);
clt := TConnectionThread(fclients[i]);
try
log(self,GuidToString(clt.ID));
log(mtDebug,self,GuidToString(clt.ID));
clt.Terminate;
clt.WaitFor;
clt.free;
except on e: Exception do
begin
log(self, '!!ERROR Destroy ' + e.Message);
log(mtError,self, '!!ERROR Destroy ' + e.Message);
end;
end;
end;
@ -161,10 +161,10 @@ begin
end;
procedure TMainThread.Log(Sender: TObject; msg: string);
procedure TMainThread.Log(ALevel: TLogLevel; Sender: TObject; msg: string);
begin
if assigned(fLogger) then
fLogger(Sender,Msg);
fLogger(ALevel, Sender,Msg);
end;
procedure TMainThread.doStart;
@ -182,7 +182,7 @@ procedure TMainThread.dataReady(aSocket: TLSocket);
var
clt: TConnectionThread;
begin
log(self,'dataReady');
log(mtDebug,self,'dataReady');
if Terminated then exit;
clt := Client[aSocket];
@ -207,10 +207,10 @@ procedure TMainThread.Accept(aSocket: TLSocket);
var
clt: TConnectionThread;
begin
log(self,'connect');
log(mtDebug,self,'connect');
if Terminated then exit;
clt := Client[aSocket];
log(self,format('connected %s on %d ',[GUIDToString(clt.ID), aSocket.Handle]));
log(mtDebug,self,format('connected %s on %d ',[GUIDToString(clt.ID), aSocket.Handle]));
ProcessAccept(clt);
clt.start;
@ -221,17 +221,17 @@ var
clt: TConnectionThread;
begin
if terminated then exit;
log(self,'disconnect');
log(mtDebug,self,'disconnect');
try
clt := Client[aSocket];
if clt.terminated then exit;
log(self,format('disconnected %s on %d ',[GUIDToString(clt.ID), aSocket.Handle]));
log(mtDebug,self,format('disconnected %s on %d ',[GUIDToString(clt.ID), aSocket.Handle]));
clt.Terminate;
fclients.remove(clt);
except on e: Exception do
begin
log(self,'!!ERROR doDisconnect '+e.Message);
log(mtError,self,'!!ERROR doDisconnect '+e.Message);
raise;
end;
end;
@ -241,10 +241,10 @@ procedure TMainThread.doConnect(aSocket: TLSocket);
var
clt: TConnectionThread;
begin
log(self,'doConnect');
log(mtDebug,self,'doConnect');
if Terminated then exit;
clt := Client[aSocket];
log(self,format('connected %s on %d ',[GUIDToString(clt.ID), aSocket.Handle]));
log(mtDebug,self,format('connected %s on %d ',[GUIDToString(clt.ID), aSocket.Handle]));
ProcessConnect(clt);
clt.Start;
end;
@ -262,9 +262,9 @@ end;
procedure TMainThread.NetError(const msg: string; aSocket: TLSocket);
begin
if assigned(aSocket) then
log(self,'!!NETERROR on '+inttostr(aSocket.Handle)+#09+msg)
log(mtWarning, self,'!!NETERROR on '+inttostr(aSocket.Handle)+#09+msg)
else
log(self,'!!NETERROR '+msg);
log(mtWarning, self,'!!NETERROR '+msg);
end;
constructor TMainThread.Create(AThreadClass: TConnectionThreadClass;
@ -281,7 +281,7 @@ begin
Connect.OnDisconnect:=@doDisconnect;
Connect.OnReceive:=@dataReady;
Connect.Timeout:=100;
log(self,'create main thread');
log(mtDebug,self,'create main thread');
end;
destructor TMainThread.Destroy;
@ -575,10 +575,10 @@ begin
end;
procedure TConnectionThread.log(msg: string);
procedure TConnectionThread.log(ALevel: TLogLevel; msg: string);
begin
if assigned(fOwner) then
fOwner.log(self,Role+#09+ GuidToString(ID)+#09+msg);
fOwner.log(ALevel, self,Role+#09+ GuidToString(ID)+#09+msg);
end;
@ -590,7 +590,7 @@ var
part_id,tmp: QWORD;
b2: array[0..7] of byte;
begin
log('Send buffer '+inttostr(len));
log(mtExtra,'Send buffer '+inttostr(len));
try
rem := len+Sizeof(integer)+Sizeof(QWord);
p := GetMem(rem);
@ -614,7 +614,7 @@ begin
end;
except on e:Exception do
begin
log('!!ERROR SendBuffer '+e.message);
log(mtError,'!!ERROR SendBuffer '+e.message);
raise;
end;
end;
@ -646,11 +646,11 @@ begin
inc(p,l);
if Terminated then exit;
until terminated or (rem<=0) ;
log('Receive buffer '+inttostr(len));
log(mtExtra,'Receive buffer '+inttostr(len));
result := true;
except on e:Exception do
begin
log('!!ERROR ReceiveBuffer '+e.message);
log(mtError,'!!ERROR ReceiveBuffer '+e.message);
raise;
end;
end;
@ -664,7 +664,7 @@ var
pos: integer;
begin
try
log(format('SendHeader(%d) Code=%d, Param=%x, Command=%s',[packettype,Code,QP,SP]));
log(mtExtra,format('SendHeader(%d) Code=%d, Param=%x, Command=%s',[packettype,Code,QP,SP]));
InitBuffer(sizeof(BYTE)*(Length(SP)+2)+16+2*sizeof(QWord)+sizeof(DWORD)*2,Buffer,pos);
AddToBuffer(packetType,Buffer,pos);
AddToBuffer(state,Buffer,pos);
@ -677,7 +677,7 @@ begin
except on e:Exception do
begin
log('!!ERROR SendHeader '+e.message);
log(mtError,'!!ERROR SendHeader '+e.message);
raise;
end;
end;
@ -703,12 +703,12 @@ begin
ReadFromBuffer(Code,Buffer,pos);
ReadFromBuffer(QP,Buffer,pos);
ReadFromBuffer(SP,Buffer,pos);
log(format('ReceiveHeader(%d) Code=%d, Param=%x, Command=%s',[packettype,Code,QP,SP]));
log(mtExtra,format('ReceiveHeader(%d) Code=%d, Param=%x, Command=%s',[packettype,Code,QP,SP]));
result := true;
except on e:Exception do
begin
log('!!ERROR ReceiveHeader '+e.message);
log(mtError,'!!ERROR ReceiveHeader '+e.message);
raise;
end;
end;
@ -837,7 +837,7 @@ var
len,i: integer;
begin
try
LogStrings(fOwner.flogger,self,'KEYS',Data);
LogStrings(mtExtra,fOwner.flogger,self,'KEYS',Data);
len := 1+4+8*Data.Count;
for i:=0 to Data.Count-1 do
inc(len,length(Data[i]));
@ -891,7 +891,7 @@ begin
result := false;
if Terminated then exit;
try
log('ReceiveMessage');
log(mtExtra,'ReceiveMessage');
if not ReceiveHeader(b,mode,Sender,rNum,CommandID,QParam,Value) then exit;
if Terminated then exit;
case b of
@ -901,7 +901,7 @@ begin
ReadFromBuffer(b,Buffer,pos);
if b<>1 then raise EFormatException.Create('');
ReadFromBuffer(Keys,Buffer,pos);
LogStrings(fOwner.flogger,self,'KEYS',Keys);
LogStrings(mtExtra, fOwner.flogger,self,'KEYS',Keys);
end;
2: begin
if not ReceiveBuffer(Buffer,len) then exit;
@ -965,7 +965,7 @@ begin
except on e:Exception do
begin
log('!!ERROR ReceiveMessage '+e.message);
log(mtError,'!!ERROR ReceiveMessage '+e.message);
raise;
end;
end;
@ -982,7 +982,7 @@ begin
fOwner := AOwner;
CreateGuid(ID);
recNo := 0;
log('Create');
log(mtExtra,'Create');
end;
destructor TConnectionThread.Destroy;
@ -1003,11 +1003,10 @@ var
Data: TStream;
mode: byte;
begin
log('start thread');
log(mtExtra,'start thread');
while not terminated do
begin
if cache.ReadReady.WaitFor(1000)<>wrSignaled then begin sleep(10);continue;end;
log('received');
if terminated then break;
if not Socket.Connected then break;
Keys := nil;
@ -1028,25 +1027,11 @@ end;
procedure TConnectionThread.TerminatedSet;
begin
log('terminate required');
log(mtExtra,'terminate required');
Cache.Close;
fOwner.removeClient(self);
end;
{ TClientThread }
const
HexChars='0123456789abcdef';
end.