diff --git a/U:/Apache/Apache24/cgi-bin/lms_cgi b/U:/Apache/Apache24/cgi-bin/lms_cgi index 30fb8f6..c7c95ba 100755 Binary files a/U:/Apache/Apache24/cgi-bin/lms_cgi and b/U:/Apache/Apache24/cgi-bin/lms_cgi differ diff --git a/baseconnection.pas b/baseconnection.pas index 2d33b08..f8c32f6 100644 --- a/baseconnection.pas +++ b/baseconnection.pas @@ -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. diff --git a/cgi_daemon.pas b/cgi_daemon.pas index 01d7f8b..8683481 100644 --- a/cgi_daemon.pas +++ b/cgi_daemon.pas @@ -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; diff --git a/cgidm.pas b/cgidm.pas index c7510e8..746786b 100644 --- a/cgidm.pas +++ b/cgidm.pas @@ -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; diff --git a/cgireport.pas b/cgireport.pas index ac99e17..a2d2f5c 100644 --- a/cgireport.pas +++ b/cgireport.pas @@ -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 diff --git a/connectionsdmunit.pas b/connectionsdmunit.pas index 5fbb1ca..ca65bd5 100644 --- a/connectionsdmunit.pas +++ b/connectionsdmunit.pas @@ -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; diff --git a/exttypes.pas b/exttypes.pas index bcefcaf..585d70d 100644 --- a/exttypes.pas +++ b/exttypes.pas @@ -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; diff --git a/lms_cgi.lpr b/lms_cgi.lpr index 08b8089..1999aaf 100644 --- a/lms_cgi.lpr +++ b/lms_cgi.lpr @@ -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; diff --git a/lms_cgi_server b/lms_cgi_server index 5ce72b2..379f917 100755 Binary files a/lms_cgi_server and b/lms_cgi_server differ diff --git a/lmsreport b/lmsreport index d3623eb..b7111ed 100755 Binary files a/lmsreport and b/lmsreport differ diff --git a/maintcpserver.pas b/maintcpserver.pas index f3f26db..fa775cb 100644 --- a/maintcpserver.pas +++ b/maintcpserver.pas @@ -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; diff --git a/reportdmunit.pas b/reportdmunit.pas index b8771cd..25d0661 100644 --- a/reportdmunit.pas +++ b/reportdmunit.pas @@ -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; diff --git a/tcpclient.pas b/tcpclient.pas index 2ce7231..7c4d7c3 100644 --- a/tcpclient.pas +++ b/tcpclient.pas @@ -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); diff --git a/tcpserver.pas b/tcpserver.pas index ac3da16..031bd25 100644 --- a/tcpserver.pas +++ b/tcpserver.pas @@ -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; diff --git a/tcpthreadhelper.pas b/tcpthreadhelper.pas index 7ef99ed..10b716e 100644 --- a/tcpthreadhelper.pas +++ b/tcpthreadhelper.pas @@ -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.