LMS2.1
This commit is contained in:
parent
0d383309ce
commit
3ad8894107
@ -18,7 +18,7 @@ type
|
||||
fConnectionID: string;
|
||||
fTimeout: integer;
|
||||
fProcessor: TNIDBDM;
|
||||
|
||||
fJournal: TStrings;
|
||||
Commands: TStrings;
|
||||
DoneCommands: TList;
|
||||
fCreated,
|
||||
@ -51,7 +51,7 @@ type
|
||||
property ConnectionID: string read fConnectionID;
|
||||
property Processor: TNIDBDM read fProcessor;
|
||||
procedure Init;
|
||||
constructor Create(AOwner: TComponent;ATimeOut: integer; aLogger: TLogger);
|
||||
constructor Create(AOwner: TComponent;ATimeOut: integer; aLogger: TLogger; ID: string='');
|
||||
destructor Destroy; override;
|
||||
// CommandID,Param,ACommand,Fields,iParam.Data
|
||||
function AddCommand(ACode: DWORD; iParam: QWORD; ACommandClass,ACommandName: string; Arguments: TStrings; intArgs: TParamArray; CmdData: TStream; out ID: string; out retCode:DWORD; out Errors: TStrings): boolean;
|
||||
@ -63,6 +63,7 @@ type
|
||||
function ProcessOptionValues(ReportName,ParamName: string; ParamValues: TStrings; out Answer: string; out RetValue: QWORD; out OptionValues: TStrings): boolean;
|
||||
class function newID: string;
|
||||
function calchash(data: TStream): string;
|
||||
property Journal: TStrings read fJournal;
|
||||
end;
|
||||
|
||||
implementation
|
||||
@ -84,10 +85,13 @@ end;
|
||||
|
||||
|
||||
constructor TBaseConnection.Create(AOwner: TComponent; ATimeOut: integer;
|
||||
aLogger: TLogger);
|
||||
aLogger: TLogger; ID: string);
|
||||
begin
|
||||
inherited Create(true);
|
||||
fConnectionID:=newID;
|
||||
if ID='' then
|
||||
fConnectionID:=newID
|
||||
else
|
||||
fConnectionID:=ID;
|
||||
fTimeout:=ATimeOut;
|
||||
fOwner := AOwner;
|
||||
flogger := ALogger;
|
||||
@ -103,7 +107,7 @@ begin
|
||||
nCommandReceived:=0;
|
||||
nCommandReady:=0;
|
||||
nErrors:=0;
|
||||
|
||||
fJournal := TStringList.Create;
|
||||
|
||||
end;
|
||||
|
||||
@ -113,6 +117,7 @@ begin
|
||||
Processor.Free;
|
||||
Commands.Free;
|
||||
DoneCommands.Free;
|
||||
fJournal.free;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
@ -132,7 +137,7 @@ begin
|
||||
cc := TCommandCollection.Find(ACommandClass,ACommandName);
|
||||
if assigned(cc) then
|
||||
begin
|
||||
cmd := cc.Create(self.newID, self.Processor,ACommandName,fLogger,User,UserID);
|
||||
cmd := cc.Create(self.newID, self.Processor,ACommandName,@log,User,UserID);
|
||||
cmd.AccessTime:=NOW();
|
||||
try
|
||||
result := cmd.ParseCommand(ACode,iParam,ACommandName,Arguments,intArgs,CmdData, Errors);
|
||||
@ -145,14 +150,18 @@ begin
|
||||
end;
|
||||
if result then
|
||||
begin
|
||||
|
||||
Commands.AddObject(ACommandName,cmd);
|
||||
ID := cmd.CommandID;
|
||||
retCode := Commands.Count;
|
||||
log(mtInfo,cmd, format('%s(%s) %s поставлена в очередь %d',[cmd.CommandName, cmd.CommandSubClass, cmd.CommandID,Commands.Count]));
|
||||
end
|
||||
else
|
||||
begin
|
||||
ID := 'неверные параметры запроса';
|
||||
retCode := ErrorArguments;
|
||||
log(mtError,cmd, format('%s(%s) %s неверные параметры запроса %s',[cmd.CommandName, cmd.CommandSubClass, cmd.CommandID, Errors.CommaText]));
|
||||
|
||||
inc(nErrors);
|
||||
cmd.Error:=true;
|
||||
cmd.Done;
|
||||
@ -217,7 +226,7 @@ begin
|
||||
fCheckConnect:=false;
|
||||
d := Created;
|
||||
if LastAccess>d then d := LastAccess;
|
||||
if (now()-d)*24*60>fTimeout then
|
||||
if (ConnectionID<>'0') and ((now()-d)*24*60>fTimeout) then
|
||||
begin
|
||||
log(mtInfo,self,'TIMEOUT');
|
||||
terminate;
|
||||
@ -251,6 +260,11 @@ end;
|
||||
|
||||
procedure TBaseConnection.Log(ALevel: TLogLevel; sender: TObject; msg: string);
|
||||
begin
|
||||
case ALevel of
|
||||
mtError: fJournal.AddObject('ERROR:'#09+msg, TObject(PtrInt(trunc(now()*24*60*60*10))));
|
||||
mtWarning: fJournal.AddObject('WARNING:'#09+msg, TObject(PtrInt(trunc(now()*24*60*60*10))));
|
||||
mtInfo: fJournal.AddObject('INFO:'#09+msg, TObject(PtrInt(trunc(now()*24*60*60*10))));
|
||||
end;
|
||||
if assigned(fLogger) then
|
||||
flogger(ALevel,sender,msg);
|
||||
end;
|
||||
|
||||
@ -17,7 +17,7 @@ type
|
||||
procedure Execute;override;
|
||||
function sleepMin(n: integer): boolean;
|
||||
constructor Create(AOwner: TLMSReportCGI);
|
||||
|
||||
function CheckTerminated(Sender: TObject): boolean;
|
||||
end;
|
||||
|
||||
{ TLMSReportCGI }
|
||||
@ -60,6 +60,12 @@ begin
|
||||
{$ENDIF}
|
||||
self.logger.Identification:='LMS-Report-Service';
|
||||
self.Logger.Active:=true;
|
||||
if Definition<>nil then
|
||||
try
|
||||
self.logger.Info(format('Daemon(%d) %s/%s {%s} (%s)',[Definition.ID, Definition.Name,Definition.DisplayName,Definition.Description,Definition.RunArguments]));
|
||||
except on e: Exception do
|
||||
self.logger.Error('DataModuleCreate '+e.Message);
|
||||
end;
|
||||
workThread := TDaemonThread.create(self);
|
||||
end;
|
||||
|
||||
@ -88,7 +94,9 @@ procedure TDaemonThread.Execute;
|
||||
begin
|
||||
fData := TConnectionsDM.CreateWithLog(fLogger);
|
||||
try
|
||||
fData.Start;
|
||||
flogger.Debug('TDaemonThread.Execute.1');
|
||||
fData.Start(@CheckTerminated);
|
||||
flogger.Debug('TDaemonThread.Execute.Started');
|
||||
while not terminated do
|
||||
begin
|
||||
if sleepMin(5) then
|
||||
@ -119,6 +127,11 @@ begin
|
||||
fLogger:=AOwner.Logger;
|
||||
end;
|
||||
|
||||
function TDaemonThread.CheckTerminated(Sender: TObject): boolean;
|
||||
begin
|
||||
result := terminated;
|
||||
end;
|
||||
|
||||
|
||||
initialization
|
||||
RegisterDaemon;
|
||||
|
||||
@ -13,8 +13,10 @@ object DaemonMapper1: TDaemonMapper1
|
||||
WinBindings.ServiceType = stWin32
|
||||
WinBindings.ErrorSeverity = esIgnore
|
||||
WinBindings.AcceptedCodes = []
|
||||
OnCreateInstance = DaemonMapper1DaemonDefs0CreateInstance
|
||||
LogStatusReport = False
|
||||
end>
|
||||
OnCreate = DaemonMapper1Create
|
||||
Left = 1065
|
||||
Top = 332
|
||||
end
|
||||
|
||||
@ -8,7 +8,12 @@ uses
|
||||
Classes, SysUtils, DaemonApp;
|
||||
|
||||
type
|
||||
|
||||
{ TDaemonMapper1 }
|
||||
|
||||
TDaemonMapper1 = class(TDaemonMapper)
|
||||
procedure DaemonMapper1Create(Sender: TObject);
|
||||
procedure DaemonMapper1DaemonDefs0CreateInstance(Sender: TObject);
|
||||
private
|
||||
|
||||
public
|
||||
@ -19,7 +24,8 @@ var
|
||||
DaemonMapper1: TDaemonMapper1;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
lazutf8;
|
||||
procedure RegisterMapper;
|
||||
begin
|
||||
RegisterDaemonMapper(TDaemonMapper1)
|
||||
@ -27,6 +33,25 @@ end;
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
{ TDaemonMapper1 }
|
||||
|
||||
procedure TDaemonMapper1.DaemonMapper1Create(Sender: TObject);
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
for i := 0 to DaemonDefs.Count-1 do
|
||||
begin
|
||||
DaemonDefs.Daemons[i].DisplayName:=UTF8ToConsole(DaemonDefs.Daemons[i].DisplayName);
|
||||
DaemonDefs.Daemons[i].Description:=UTF8ToConsole(DaemonDefs.Daemons[i].Description);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDaemonMapper1.DaemonMapper1DaemonDefs0CreateInstance(Sender: TObject
|
||||
);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
|
||||
initialization
|
||||
RegisterMapper;
|
||||
|
||||
19
cgidm.pas
19
cgidm.pas
@ -43,6 +43,7 @@ type
|
||||
function CheckConnection: boolean;
|
||||
function QueryValue(ASQL: string; Default: string=''): string;
|
||||
function QueryIntValue(ASQL: string): integer;
|
||||
function QueryDateValue(ASQL: string): TDateTime;
|
||||
function GetData(ASQL: string): TDataSet;
|
||||
function CheckUser(const login,password: string; out UserID: integer): boolean;
|
||||
procedure OpenConnection;
|
||||
@ -330,6 +331,22 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TNIDBDM.QueryDateValue(ASQL: string): TDateTime;
|
||||
begin
|
||||
log(mtDebug,self,'QueryIntValue'#13#10+ASQL);
|
||||
CheckConnection;
|
||||
with TnnzQuery.Create(self) do
|
||||
try
|
||||
Connection := fcon;
|
||||
SQL.Text:=ASQL;
|
||||
Open;
|
||||
if not eof then result := Fields[0].AsDateTime else result := 0;
|
||||
finally
|
||||
free;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
function TNIDBDM.GetData(ASQL: string): TDataSet;
|
||||
begin
|
||||
@ -355,7 +372,7 @@ end;
|
||||
|
||||
procedure TNIDBDM.OpenConnection;
|
||||
begin
|
||||
log(mtDebug,self,'OpenConnection');
|
||||
log(mtDebug,self,format('OpenConnection %s:%d',[connection.RemoteHost,connection.RemotePort]));
|
||||
fcon.Connected:=true;
|
||||
fcon.Identify;
|
||||
end;
|
||||
|
||||
@ -85,11 +85,11 @@ var
|
||||
d: TStringDynArray;
|
||||
i: integer;
|
||||
begin
|
||||
ReportCode := Processor.QueryValue(format('select report_routine from xp_report_cgi where cgi_name=%s',[TNidbDM.StringAsSQL(ReportName)]));
|
||||
ReportCode := Processor.QueryValue(format('select report_routine from xp_report_cgi where cgi_name=%s',[TNIDBDM.StringAsSQL(ReportName)]));
|
||||
UpdateCodeWithArguments(ReportCode);
|
||||
if reportcode<>'' then
|
||||
Processor.ExecuteSQL(format('select %s;',[ReportCode]));
|
||||
ASQL := format( 'select array_to_string(extra_routines,'';'') as v from xp_report_cgi where cgi_name=%s',[TNidbDM.StringAsSQL(ReportName)]);
|
||||
ASQL := format( 'select array_to_string(extra_routines,'';'') as v from xp_report_cgi where cgi_name=%s',[TNIDBDM.StringAsSQL(ReportName)]);
|
||||
v := Processor.QueryValue(ASQL);
|
||||
if v>'' then
|
||||
begin
|
||||
@ -106,7 +106,7 @@ end;
|
||||
|
||||
procedure TReportCommand.PrepareVars;
|
||||
begin
|
||||
VarCode := Processor.QueryValue(format('select report_routine_vars from xp_report_cgi where cgi_name=%s',[TNidbDM.StringAsSQL(ReportName)]));
|
||||
VarCode := Processor.QueryValue(format('select report_routine_vars from xp_report_cgi where cgi_name=%s',[TNIDBDM.StringAsSQL(ReportName)]));
|
||||
UpdateCodeWithArguments(VarCode);
|
||||
if VarCode<>'' then
|
||||
Processor.ExecuteSQL(format('select %s;',[VarCode]));
|
||||
@ -144,7 +144,7 @@ begin
|
||||
vs := '';
|
||||
end;
|
||||
script := script + format(#13#10'insert into tmp_report_variables(name,value_string,var_type) values (%s,%s,0); ',
|
||||
[TNIDBDM.StringAsSQL(fieldByName('name').asString),TNidbDM.StringAsSQL(vs)]);
|
||||
[TNIDBDM.StringAsSQL(fieldByName('name').asString),TNIDBDM.StringAsSQL(vs)]);
|
||||
Next;
|
||||
end;
|
||||
finally
|
||||
@ -212,13 +212,13 @@ begin
|
||||
fcurrentStage := 'исполняется (инициализация)';
|
||||
fileData := TMemoryStream.Create;
|
||||
try
|
||||
ReportID := Processor.QueryIntValue(format('select xp_rpt_id from xp_report_cgi where cgi_name=%s',[TNidbDM.StringAsSQL(ReportName)]));
|
||||
ReportID := Processor.QueryIntValue(format('select xp_rpt_id from xp_report_cgi where cgi_name=%s',[TNIDBDM.StringAsSQL(ReportName)]));
|
||||
if ReportID<=0 then
|
||||
begin
|
||||
fResult := TCommandData.Create(ErrorArguments,0,'Отчет не найден',nil,[],nil);
|
||||
exit;
|
||||
end;
|
||||
ReportTitle := 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)]));
|
||||
ReportTitle := 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(mtInfo,'Построение отчета '+ReportTitle);
|
||||
ReportProcessor.RecordID:=ReportID;
|
||||
@ -253,7 +253,7 @@ begin
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
fResult := TCommandData.Create(0,fileData.size,ReportTitle+'.pdf',['type=application/pdf'],[],fileData);
|
||||
fResult := TCommandData.Create(0,fileData.size,ReportTitle+'.pdf',['{"type":"application/pdf"}'],[],fileData);
|
||||
fileData.Seek(0,soFromBeginning);
|
||||
{$IFDEF DEBUG} (fileData as TMemoryStream).SaveToFile(format('%sout/%s_%s.pdf',[ Extractfilepath(paramstr(0)),self.CommandID,ReportTitle])); {$ENDIF}
|
||||
fileData.Seek(0,soFromBeginning);
|
||||
@ -269,6 +269,19 @@ var
|
||||
asql: string;
|
||||
ids: string;
|
||||
i: integer;
|
||||
value: string;
|
||||
val_int: integer;
|
||||
val_float: double;
|
||||
val_date: TDateTime;
|
||||
fmt: TFormatSettings;
|
||||
val_ids: TStringDynArray;
|
||||
procedure AddToErrors(error: string);
|
||||
begin
|
||||
if not assigned(Errors) then
|
||||
Errors := TStringList.Create;
|
||||
Errors.Add(error);
|
||||
end;
|
||||
|
||||
begin
|
||||
result := false;
|
||||
Errors := nil;
|
||||
@ -302,7 +315,45 @@ begin
|
||||
finally
|
||||
free;
|
||||
end;
|
||||
|
||||
asql := format(
|
||||
'select p.name, p.type from xp_report_cgi c '+
|
||||
'join xp_report_params p on p.xp_rpt_id=c.xp_rpt_id and coalesce(p.required,true) '+
|
||||
'where c.cgi_name=%s and p.name in (%s) '+
|
||||
' and p.type in (1,2) '+
|
||||
'order by fill_order,p.name ',
|
||||
[TNIDBDM.StringAsSQL(ReportName),(ids)]);
|
||||
fmt.DateSeparator:='-';
|
||||
fmt.TimeSeparator:=':';
|
||||
fmt.ShortDateFormat:='yyyy-mm-dd';
|
||||
fmt.ShortTimeFormat:='hh:nn:ss';
|
||||
with Processor.GetData(asql) do
|
||||
try
|
||||
while not eof do
|
||||
begin
|
||||
value := Arguments.Keys.Values[fieldbyname('name').AsString];
|
||||
case FieldByName('type').asInteger of
|
||||
1: if not TryStrToInt(value,val_int) then AddToErrors(format('{name:"%s",type:"ID"}',[TNIDBDM.StringAsJSON(FieldByName('name').AsString)]));
|
||||
2: if not TryStrToInt(value,val_int) then AddToErrors(format('{name:"%s",type:"integer"}',[TNIDBDM.StringAsJSON(FieldByName('name').AsString)]));
|
||||
3: if not TryStrToFloat(value,val_float) then AddToErrors(format('{name:"%s",type:"float"}',[TNIDBDM.StringAsJSON(FieldByName('name').AsString)]));
|
||||
4: if not TryStrToDate(value,val_date,'yyyy-mm-dd','-') then AddToErrors(format('{name:"%s",type:"date"}',[TNIDBDM.StringAsJSON(FieldByName('name').AsString)]));
|
||||
5: if not TryStrToDateTime(value,val_date,fmt) then AddToErrors(format('{name:"%s",type:"time"}',[TNIDBDM.StringAsJSON(FieldByName('name').AsString)]));
|
||||
6: if not( (Value='0') or (Value='1') ) then AddToErrors(format('{name:"%s",type:"boolean"}',[TNIDBDM.StringAsJSON(FieldByName('name').AsString)]));
|
||||
17: begin
|
||||
val_ids := SplitString(value,',');
|
||||
for i := low(val_ids) to high(val_ids) do
|
||||
if not TryStrToInt(val_ids[i],val_int) then
|
||||
begin
|
||||
AddToErrors(format('{name:"%s",type:"IDS"}',[TNIDBDM.StringAsJSON(FieldByName('name').AsString)]));
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
next;
|
||||
end;
|
||||
finally
|
||||
free;
|
||||
end;
|
||||
result := not assigned(Errors);
|
||||
end;
|
||||
|
||||
function TReportCommand.ProcessOptionValues(ParamName: string; out
|
||||
|
||||
@ -125,6 +125,8 @@ end;
|
||||
constructor TCommand.Create(ID: string; aProcessor: TNIDBDM; ASubClass: string;
|
||||
aLogger: TLogger; AUser: string; IDUser: integer);
|
||||
begin
|
||||
if assigned(aLogger) then
|
||||
aLogger(mtExtra,self,'CREATE '+self.ClassName);
|
||||
fProcessor := AProcessor;
|
||||
fSubClass := ASubClass;
|
||||
fStatus:=StatusWaiting;
|
||||
@ -149,6 +151,7 @@ end;
|
||||
|
||||
procedure TCommand.doRun;
|
||||
begin
|
||||
log(mtInfo,format('%s(%s) %s - начато выполнение',[commandName,CommandSubClass, commandID]));
|
||||
fStatus:=StatusProcessing;
|
||||
fcurrentStage := 'исполняется';
|
||||
try
|
||||
@ -156,11 +159,13 @@ begin
|
||||
begin
|
||||
fStatus:=StatusComplete;
|
||||
fcurrentStage := 'завершена';
|
||||
log(mtInfo,format('%s(%s) %s - выполнена',[commandName,CommandSubClass, commandID]));
|
||||
end
|
||||
else
|
||||
begin
|
||||
fStatus := StatusError;
|
||||
fcurrentStage := 'завершена c ошибкой';
|
||||
log(mtInfo,format('%s(%s) %s - ошибка',[commandName,CommandSubClass, commandID]));
|
||||
end;
|
||||
|
||||
except on e: Exception do
|
||||
|
||||
@ -4,7 +4,7 @@ object ConnectionsDM: TConnectionsDM
|
||||
OldCreateOrder = False
|
||||
Height = 150
|
||||
HorizontalOffset = 738
|
||||
VerticalOffset = 342
|
||||
VerticalOffset = 344
|
||||
Width = 533
|
||||
object Process1: TProcess
|
||||
Active = False
|
||||
|
||||
@ -34,8 +34,9 @@ type
|
||||
fLogger: TEventLog;
|
||||
fTimeOut: integer;
|
||||
fRunning: boolean;
|
||||
fTermiinateCheck: TChecker;
|
||||
function getConnection(ID: string): TBaseConnection;
|
||||
function NewConnection: TBaseConnection;
|
||||
function NewConnection(ID: string=''): TBaseConnection;
|
||||
procedure Remove(con: TBaseConnection); overload;
|
||||
procedure Remove(ID: string); overload;
|
||||
procedure ClearConnections;
|
||||
@ -55,7 +56,7 @@ type
|
||||
procedure Log(ALevel: TLogLevel; Sender: TObject; msg: string);
|
||||
procedure LogError(Sender: TObject; e: Exception; Command: string);
|
||||
procedure InitBaseCon;
|
||||
procedure Start;
|
||||
procedure Start(isTerminated: TChecker);
|
||||
procedure Stop;
|
||||
procedure Idle(Sender: TObject);
|
||||
property Running: boolean read fRunning;
|
||||
@ -65,6 +66,7 @@ type
|
||||
constructor CreateWithLog(ALogger: TEventLog);
|
||||
procedure FillTemplates(RepList: TStrings);
|
||||
procedure EditTemplate(ReportID: integer);
|
||||
procedure TestReport(ReportID: integer);
|
||||
function CalcHash(Data: TStream): string;
|
||||
end;
|
||||
|
||||
@ -82,12 +84,20 @@ uses
|
||||
{ TConnectionsDM }
|
||||
|
||||
procedure TConnectionsDM.DataModuleCreate(Sender: TObject);
|
||||
var
|
||||
con: TBaseConnection;
|
||||
begin
|
||||
fRunning := false;
|
||||
conList := TList.Create;
|
||||
MainCon := TNIDBDM.CreateWithLogger(@log);
|
||||
LoadConfig;
|
||||
input := TServerMainThread.Create(@log,fServicePort,@ProcessRequest);
|
||||
input := nil;
|
||||
{$IFDEF DEBUG}
|
||||
con := NewConnection('0');
|
||||
con.User:='anonymous';
|
||||
con.UserID := 0;
|
||||
con.Start;
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
procedure TConnectionsDM.DataModuleDestroy(Sender: TObject);
|
||||
@ -99,8 +109,10 @@ begin
|
||||
begin
|
||||
Input.Terminate;
|
||||
Input.WaitFor;
|
||||
Input.Free;
|
||||
end;
|
||||
Input.Free;
|
||||
|
||||
|
||||
MainCon.Free;
|
||||
conList.Free;
|
||||
|
||||
@ -120,13 +132,13 @@ begin
|
||||
result := nil;
|
||||
end;
|
||||
|
||||
function TConnectionsDM.NewConnection: TBaseConnection;
|
||||
function TConnectionsDM.NewConnection(ID: string): TBaseConnection;
|
||||
var
|
||||
g: TGUID;
|
||||
s: string;
|
||||
i: integer;
|
||||
begin
|
||||
result := TBaseConnection.Create(self,fTimeOut,@Log);
|
||||
result := TBaseConnection.Create(self,fTimeOut,@Log,ID);
|
||||
conlist.add(result);
|
||||
result.Host:=DataHost;
|
||||
result.port:=DataPort;
|
||||
@ -209,14 +221,24 @@ function TConnectionsDM.ProcessRequest(Sender: TMainThread;
|
||||
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;
|
||||
procedure waitforresult(Pause: integer; acmd: TCommand);
|
||||
begin
|
||||
if acmd.Status in [StatusComplete,StatusError] then exit;
|
||||
while (pause>0) and not(acmd.Status in [StatusWaiting,StatusProcessing]) do
|
||||
begin
|
||||
Sleep(1000);
|
||||
dec(pause);
|
||||
end;
|
||||
end;
|
||||
var
|
||||
UserID: integer;
|
||||
con: TBaseConnection;
|
||||
userName,conID,cmdID: string;
|
||||
cmd: TCommand;
|
||||
i: integer;
|
||||
begin
|
||||
try
|
||||
log(mtDebug, Self,'Обработка запроса '+ACommand);
|
||||
log(mtInfo, Self,'Обработка запроса '+ACommand);
|
||||
ClearTerminated;
|
||||
result := false;
|
||||
RetValue := 0;
|
||||
@ -240,10 +262,11 @@ begin
|
||||
rvalues.Add('"help"');
|
||||
rvalues.Add('"version"');
|
||||
rValues.add('"reports"');
|
||||
rValues.add('{action:"arguments",params:["name"]}');
|
||||
rValues.add('{action:"arguments",params:["report"]}');
|
||||
rValues.add('{action:"login",params:["user","password"]}');
|
||||
rValues.add('{action:"logout",params:["connect"]}');
|
||||
rValues.add('{action:"test",params:["connect"]}');
|
||||
rValues.add('{action:"log",params:["connect"]}');
|
||||
rValues.add('{action:"option_values",params:["connect","report","name"]}');
|
||||
rValues.add('{action:"report",params:["connect","name"]}');
|
||||
rValues.add('{action:"status",params:["connect","operation"]}');
|
||||
@ -257,7 +280,7 @@ begin
|
||||
end;
|
||||
if ACommand='arguments' then
|
||||
begin
|
||||
result := ProcessArguments(Fields.Values['name'],RetValue,Answer,rValues);
|
||||
result := ProcessArguments(Fields.Values['report'],RetValue,Answer,rValues);
|
||||
if not result then
|
||||
begin
|
||||
Code := ErrorArguments;
|
||||
@ -310,6 +333,19 @@ begin
|
||||
Remove(con.ConnectionID);
|
||||
exit;
|
||||
end;
|
||||
if ACommand='log' then
|
||||
begin
|
||||
result := true;
|
||||
Answer := 'OK';
|
||||
rValues := TStringList.Create;
|
||||
for i := 0 to con.Journal.count-1 do
|
||||
begin
|
||||
rValues.add('"'+TNIDBDM.StringAsJSON(con.Journal[i])+'"');
|
||||
end;
|
||||
con.Journal.Clear;
|
||||
exit;
|
||||
end;
|
||||
con.Log(mtInfo,self,'Получен запрос '+ACommand);
|
||||
if ACommand='connectStatus' then
|
||||
begin
|
||||
result := true;
|
||||
@ -348,7 +384,8 @@ begin
|
||||
else
|
||||
begin
|
||||
rValues := TSTringList.Create;
|
||||
rValues.Assign(cmd.Journal);
|
||||
for i := 0 to cmd.Journal.count-1 do
|
||||
rValues.add('"'+TNIDBDM.StringAsJSON(cmd.Journal[i])+'"');
|
||||
end;
|
||||
code := cmd.Status;
|
||||
if (code=StatusComplete) and assigned(cmd.Results.Data) then
|
||||
@ -360,12 +397,19 @@ begin
|
||||
end;
|
||||
if ACommand='result' then
|
||||
begin
|
||||
waitforresult(StrToIntDef(Fields.Values['wait'],0),cmd);
|
||||
if cmd.Status=StatusComplete then
|
||||
begin
|
||||
cmd.Results.AssignTo(Code,RetValue,Answer,rValues,iValues,ByteData);
|
||||
cmd.Done;
|
||||
result := true;
|
||||
end
|
||||
else if cmd.Status=StatusError then
|
||||
begin
|
||||
cmd.Results.AssignTo(Code,RetValue,Answer,rValues,iValues,ByteData);
|
||||
cmd.Done;
|
||||
result := false;
|
||||
end
|
||||
else
|
||||
begin
|
||||
Code := ErrorComplete;
|
||||
@ -463,6 +507,30 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TConnectionsDM.TestReport(ReportID: integer);
|
||||
var
|
||||
asql: string;
|
||||
RName: string;
|
||||
con: TBaseConnection;
|
||||
cc: TCommandClass;
|
||||
cmd: TReportCommand;
|
||||
begin
|
||||
asql := format('select cgi_name from xp_report_cgi where xp_rpt_id=%d',[ReportID]);
|
||||
RName := MainCon.QueryValue(asql);
|
||||
cc := TCommandCollection.Find('report',RName);
|
||||
cmd := cc.Create('', MainCon,RName,@Log,'',0) as TReportCommand;
|
||||
try
|
||||
cmd.ReportID := ReportID;
|
||||
cmd.ReportName:=RName;
|
||||
cmd.FillDefaults;
|
||||
cmd.Run();
|
||||
|
||||
finally
|
||||
cmd.free;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function TConnectionsDM.ProcessLogin(UserName, UserPassword: string; out UserID: integer): boolean;
|
||||
var
|
||||
ASQL: string;
|
||||
@ -636,6 +704,8 @@ begin
|
||||
log(mtInfo,self,format('База данных %s:%d/%s Порт для соединения %d',[fDataHost,fDataPort,fDataBase,fServicePort]));
|
||||
end;
|
||||
|
||||
|
||||
|
||||
procedure TConnectionsDM.Log(ALevel: TLogLevel; Sender: TObject; msg: string);
|
||||
var
|
||||
s: string;
|
||||
@ -655,7 +725,10 @@ begin
|
||||
mtError: fLogger.Error(s);
|
||||
mtWarning: fLogger.Warning(s);
|
||||
mtInfo: flogger.Info(s);
|
||||
{$IFDEF DEBUG}
|
||||
mtDebug: fLogger.Debug(s);
|
||||
mtExtra: fLogger.Log(#09+s);
|
||||
{$ENDIF}
|
||||
end;
|
||||
except
|
||||
end;
|
||||
@ -675,9 +748,11 @@ begin
|
||||
MainCon.OpenConnection;
|
||||
end;
|
||||
|
||||
procedure TConnectionsDM.Start;
|
||||
procedure TConnectionsDM.Start(isTerminated: TChecker);
|
||||
begin
|
||||
fTermiinateCheck := isTerminated;
|
||||
InitBaseCon;//Input.OnIdle:=@Idle;
|
||||
input := TServerMainThread.Create(@log,fServicePort,fTermiinateCheck,@ProcessRequest);
|
||||
Input.Start;
|
||||
fRunning:=true;
|
||||
end;
|
||||
|
||||
@ -30,6 +30,7 @@ type
|
||||
TParamArray=Array of QWORD;
|
||||
TLogLevel=(mtError,mtWarning,mtInfo,mtDebug,mtExtra);
|
||||
TLogger=procedure(ALevel: TLogLevel; Sender: TObject; Msg: String ) of object;
|
||||
TChecker=function(Sender: TObject): boolean of object;
|
||||
EFormatException=class(Exception);
|
||||
{ TConnectionThread }
|
||||
|
||||
|
||||
@ -65,7 +65,6 @@ begin
|
||||
if AMethodName = '_' then Result := _(Params[0])
|
||||
else
|
||||
if AnsiSameText(AMethodName,'Log') then begin
|
||||
{$IFDEF DEBUG} cxlogger.TLogSystem.Loggers['fastreport'].writelog(Params[0],Params[1]); {$ENDIF}
|
||||
result := true;
|
||||
end
|
||||
else
|
||||
|
||||
17
lms_cgi.lpr
17
lms_cgi.lpr
@ -9,8 +9,8 @@ uses
|
||||
{$IFDEF HASAMIGA}
|
||||
athreads,
|
||||
{$ENDIF}
|
||||
Interfaces, Classes, SysUtils, inifiles, httpDefs, fpweb, custweb, custcgi,
|
||||
lnetbase, tcpClient, tcpthreadhelper, extTypes, eventlog;
|
||||
Interfaces, Classes, SysUtils, inifiles, httpDefs, fpweb, custweb, custcgi,
|
||||
lnetbase, tcpClient, tcpthreadhelper, extTypes, eventlog;
|
||||
|
||||
Type
|
||||
|
||||
@ -178,6 +178,18 @@ log(mtDebug,self,'Data READY');
|
||||
{$ENDIF}
|
||||
if not assigned(fData) then
|
||||
begin
|
||||
if fmODE=3 then
|
||||
case fCode of
|
||||
ErrorProcessor: AResponse.Code:=503;
|
||||
ErrorLogin: AResponse.Code:=401;
|
||||
ErrorConnect: AResponse.Code:=401;
|
||||
ErrorCommand: AResponse.Code:=501;
|
||||
ErrorComplete: AResponse.Code:=202;
|
||||
ErrorArguments: AResponse.Code:=400;
|
||||
ErrorInternal: AResponse.Code:=500;
|
||||
end
|
||||
else
|
||||
AResponse.Code:=200;
|
||||
AResponse.ContentType := 'application/json';
|
||||
AResponse.Contents.add('{');
|
||||
AResponse.Contents.add('"type":'+aTypes[fMode]+',');
|
||||
@ -259,6 +271,7 @@ begin
|
||||
flogger := TEventLog.Create(self);
|
||||
flogger.Identification:='lms_cgi_client';
|
||||
flogger.LogType:={$IFDEF LINUX}ltSystem{$ELSE}ltFile{$ENDIF};
|
||||
flogger.AppendContent:=true;
|
||||
inherited Create(AOwner);
|
||||
|
||||
end;
|
||||
|
||||
BIN
lms_cgi.obj
BIN
lms_cgi.obj
Binary file not shown.
@ -4,4 +4,4 @@ port=7079
|
||||
database=lms
|
||||
[PARAMS]
|
||||
port=6543
|
||||
log=/var/log/nintegra/cgireport.log
|
||||
log=./cgireport.log
|
||||
@ -15,7 +15,7 @@
|
||||
<ResourceType Value="res"/>
|
||||
</General>
|
||||
<BuildModes>
|
||||
<Item Name="Default" Default="True"/>
|
||||
<Item Name="Debug" Default="True"/>
|
||||
<Item Name="Release">
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
@ -166,6 +166,12 @@
|
||||
<OtherUnitFiles Value="reports"/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Other>
|
||||
<CustomOptions Value="-dDEBUG"/>
|
||||
<OtherDefines Count="1">
|
||||
<Define0 Value="DEBUG"/>
|
||||
</OtherDefines>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions>
|
||||
|
||||
@ -55,6 +55,12 @@
|
||||
</Win32>
|
||||
</Options>
|
||||
</Linking>
|
||||
<Other>
|
||||
<CustomOptions Value="-dDEBUG"/>
|
||||
<OtherDefines Count="1">
|
||||
<Define0 Value="DEBUG"/>
|
||||
</OtherDefines>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
</Item>
|
||||
<Item Name="Release">
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
object CGIServerGUI: TCGIServerGUI
|
||||
Left = 401
|
||||
Left = 602
|
||||
Height = 566
|
||||
Top = 219
|
||||
Width = 870
|
||||
@ -8,7 +8,7 @@ object CGIServerGUI: TCGIServerGUI
|
||||
ClientWidth = 870
|
||||
OnCreate = FormCreate
|
||||
OnDestroy = FormDestroy
|
||||
LCLVersion = '2.2.2.0'
|
||||
LCLVersion = '3.6.0.0'
|
||||
object Panel1: TPanel
|
||||
Left = 0
|
||||
Height = 50
|
||||
@ -25,8 +25,8 @@ object CGIServerGUI: TCGIServerGUI
|
||||
Top = 14
|
||||
Width = 75
|
||||
Caption = 'Запрос'
|
||||
OnClick = SendButtonClick
|
||||
TabOrder = 0
|
||||
OnClick = SendButtonClick
|
||||
end
|
||||
object StartButton: TButton
|
||||
Left = 8
|
||||
@ -34,8 +34,8 @@ object CGIServerGUI: TCGIServerGUI
|
||||
Top = 14
|
||||
Width = 75
|
||||
Caption = 'Запуск'
|
||||
OnClick = StartButtonClick
|
||||
TabOrder = 1
|
||||
OnClick = StartButtonClick
|
||||
end
|
||||
end
|
||||
object GroupBox1: TGroupBox
|
||||
@ -45,14 +45,14 @@ object CGIServerGUI: TCGIServerGUI
|
||||
Width = 368
|
||||
Align = alLeft
|
||||
Caption = 'Запрос'
|
||||
ClientHeight = 227
|
||||
ClientWidth = 366
|
||||
ClientHeight = 226
|
||||
ClientWidth = 364
|
||||
TabOrder = 1
|
||||
object Keys: TMemo
|
||||
Left = 0
|
||||
Height = 197
|
||||
Top = 30
|
||||
Width = 366
|
||||
Height = 203
|
||||
Top = 23
|
||||
Width = 364
|
||||
Align = alClient
|
||||
Lines.Strings = (
|
||||
'user=nnz'
|
||||
@ -62,11 +62,11 @@ object CGIServerGUI: TCGIServerGUI
|
||||
end
|
||||
object edtRequest: TComboBox
|
||||
Left = 0
|
||||
Height = 30
|
||||
Height = 23
|
||||
Top = 0
|
||||
Width = 366
|
||||
Width = 364
|
||||
Align = alTop
|
||||
ItemHeight = 0
|
||||
ItemHeight = 15
|
||||
ItemIndex = 3
|
||||
Items.Strings = (
|
||||
'version'
|
||||
@ -91,42 +91,41 @@ object CGIServerGUI: TCGIServerGUI
|
||||
Width = 497
|
||||
Align = alClient
|
||||
Caption = 'Ответ'
|
||||
ClientHeight = 227
|
||||
ClientWidth = 495
|
||||
ClientHeight = 226
|
||||
ClientWidth = 493
|
||||
TabOrder = 2
|
||||
object edtAnswer: TEdit
|
||||
Left = 0
|
||||
Height = 30
|
||||
Height = 23
|
||||
Top = 25
|
||||
Width = 495
|
||||
Width = 493
|
||||
Align = alTop
|
||||
OnDblClick = edtAnswerDblClick
|
||||
TabOrder = 0
|
||||
OnDblClick = edtAnswerDblClick
|
||||
end
|
||||
object retValues: TMemo
|
||||
Left = 0
|
||||
Height = 92
|
||||
Top = 85
|
||||
Width = 495
|
||||
Height = 105
|
||||
Top = 71
|
||||
Width = 493
|
||||
Align = alClient
|
||||
TabOrder = 1
|
||||
end
|
||||
object intValues: TListBox
|
||||
Left = 0
|
||||
Height = 50
|
||||
Top = 177
|
||||
Width = 495
|
||||
Top = 176
|
||||
Width = 493
|
||||
Align = alBottom
|
||||
Columns = 4
|
||||
ItemHeight = 0
|
||||
TabOrder = 2
|
||||
TopIndex = -1
|
||||
end
|
||||
object edtQValue: TEdit
|
||||
Left = 0
|
||||
Height = 30
|
||||
Top = 55
|
||||
Width = 495
|
||||
Height = 23
|
||||
Top = 48
|
||||
Width = 493
|
||||
Align = alTop
|
||||
TabOrder = 3
|
||||
end
|
||||
@ -134,7 +133,7 @@ object CGIServerGUI: TCGIServerGUI
|
||||
Left = 0
|
||||
Height = 25
|
||||
Top = 0
|
||||
Width = 495
|
||||
Width = 493
|
||||
Align = alTop
|
||||
TabOrder = 4
|
||||
end
|
||||
@ -152,17 +151,17 @@ object CGIServerGUI: TCGIServerGUI
|
||||
Width = 870
|
||||
Align = alBottom
|
||||
Caption = 'Шаблоны'
|
||||
ClientHeight = 251
|
||||
ClientWidth = 868
|
||||
ClientHeight = 250
|
||||
ClientWidth = 866
|
||||
TabOrder = 4
|
||||
object ReportsPanel: TPanel
|
||||
Left = 0
|
||||
Height = 50
|
||||
Top = 201
|
||||
Width = 868
|
||||
Top = 200
|
||||
Width = 866
|
||||
Align = alBottom
|
||||
ClientHeight = 50
|
||||
ClientWidth = 868
|
||||
ClientWidth = 866
|
||||
TabOrder = 0
|
||||
object EditTemplate: TButton
|
||||
Left = 760
|
||||
@ -170,19 +169,27 @@ object CGIServerGUI: TCGIServerGUI
|
||||
Top = 11
|
||||
Width = 100
|
||||
Caption = 'Шаблон'
|
||||
OnClick = EditTemplateClick
|
||||
TabOrder = 0
|
||||
OnClick = EditTemplateClick
|
||||
end
|
||||
object TestButton: TButton
|
||||
Left = 672
|
||||
Height = 25
|
||||
Top = 11
|
||||
Width = 75
|
||||
Caption = 'Проверка'
|
||||
TabOrder = 1
|
||||
OnClick = TestButtonClick
|
||||
end
|
||||
end
|
||||
object ReportsList: TListBox
|
||||
Left = 0
|
||||
Height = 201
|
||||
Height = 200
|
||||
Top = 0
|
||||
Width = 868
|
||||
Width = 866
|
||||
Align = alClient
|
||||
ItemHeight = 0
|
||||
TabOrder = 1
|
||||
TopIndex = -1
|
||||
end
|
||||
end
|
||||
end
|
||||
|
||||
@ -17,6 +17,7 @@ type
|
||||
{ TCGIServerGUI }
|
||||
|
||||
TCGIServerGUI = class(TForm)
|
||||
TestButton: TButton;
|
||||
EditTemplate: TButton;
|
||||
edtAnswer: TEdit;
|
||||
edtQValue: TEdit;
|
||||
@ -40,12 +41,14 @@ type
|
||||
procedure StartButtonClick(Sender: TObject);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure FormDestroy(Sender: TObject);
|
||||
procedure TestButtonClick(Sender: TObject);
|
||||
private
|
||||
fLogger: TEventLog;
|
||||
Server: TConnectionsDM;
|
||||
Client: TClientMainThread;
|
||||
cmdDone: boolean;
|
||||
started: boolean;
|
||||
function IsTerminated(Sender: TObject): boolean;
|
||||
procedure LogQuery(const qtype: integer; const command: string; const aKeys: TStrings; const code: DWORD; const Param: QWORD; const data: TParamArray);
|
||||
function onAnswer(Sender: TMainThread; const mode: byte;
|
||||
const Code:DWORD; const QValue: QWORD; const Answer: string; const Values: TStrings; const iValues: TParamArray; const Data: TStream): boolean;
|
||||
@ -122,7 +125,7 @@ end;
|
||||
procedure TCGIServerGUI.StartButtonClick(Sender: TObject);
|
||||
begin
|
||||
|
||||
Server.Start;
|
||||
Server.Start(@isTerminated);
|
||||
Server.FillTemplates(ReportsList.Items);
|
||||
started := true;
|
||||
Panel1.Caption := 'запущен';
|
||||
@ -135,6 +138,20 @@ begin
|
||||
fLogger.Free;
|
||||
end;
|
||||
|
||||
procedure TCGIServerGUI.TestButtonClick(Sender: TObject);
|
||||
var
|
||||
rID: integer;
|
||||
begin
|
||||
rID := PtrInt(ReportsList.Items.Objects[ReportsList.ItemIndex]);
|
||||
Server.TestReport(rID);
|
||||
end;
|
||||
|
||||
function TCGIServerGUI.IsTerminated(Sender: TObject): boolean;
|
||||
begin
|
||||
result := false;
|
||||
end;
|
||||
|
||||
|
||||
procedure TCGIServerGUI.LogQuery(const qtype: integer; const command: string;
|
||||
const aKeys: TStrings; const code: DWORD; const Param: QWORD;
|
||||
const data: TParamArray);
|
||||
|
||||
@ -9,7 +9,7 @@ uses
|
||||
|
||||
implementation
|
||||
uses
|
||||
cgiReport,applicantlist,applicantresult;
|
||||
cgiReport,applicantlist,applicantresult, journal;
|
||||
initialization
|
||||
TCommandCollection.Register(TReportCommand);
|
||||
end.
|
||||
|
||||
@ -81,7 +81,7 @@ end;
|
||||
procedure TClientMainThread.execute;
|
||||
begin
|
||||
doStart;
|
||||
log(mtExtra, self,'start main thread');
|
||||
log(mtExtra, self,format('start main thread %s:%d',[Host,Port]));
|
||||
Connect.Connect(Host,Port);
|
||||
try
|
||||
while not terminated and not Complete do
|
||||
@ -100,6 +100,7 @@ end;
|
||||
|
||||
procedure TClientMainThread.ProcessConnect(thread: TConnectionThread);
|
||||
begin
|
||||
log(mtDebug,self,'ProcessConnect '+GuidToString(thread.ID));
|
||||
thread.SendMessage(cmdRequest,1,0,self.Command,self.fFields);
|
||||
end;
|
||||
|
||||
|
||||
@ -23,12 +23,13 @@ type
|
||||
private
|
||||
fOnReceive: TCommandReceived;
|
||||
fOnIdle: TNotifyEvent;
|
||||
fTerminateCheck: TChecker;
|
||||
function processReceive(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;
|
||||
public
|
||||
property OnIdle: TNotifyEvent read fOnIdle write fOnIdle;
|
||||
procedure execute; override;
|
||||
constructor Create( ALogger: TLogger; APort: integer; OnReceive:TCommandReceived);
|
||||
constructor Create( ALogger: TLogger; APort: integer;TermCheck: TChecker; OnReceive:TCommandReceived);
|
||||
end;
|
||||
|
||||
implementation
|
||||
@ -62,10 +63,10 @@ var
|
||||
n: integer;
|
||||
begin
|
||||
doStart;
|
||||
log(mtExtra,self,'start main thread');
|
||||
log(mtExtra,self,format('start main thread %d',[Port]));
|
||||
Connect.Listen(Port);
|
||||
n := 0;
|
||||
while not terminated and not Complete do
|
||||
while not terminated and not Complete and not fTerminateCheck(self) do
|
||||
begin
|
||||
try
|
||||
Connect.CallAction;
|
||||
@ -73,9 +74,9 @@ begin
|
||||
except on e: Exception do
|
||||
log(mtError,e, '!!ERROR '+e.message);
|
||||
end;
|
||||
sleep(10);
|
||||
sleep(100);
|
||||
inc(n);
|
||||
if n>100 then
|
||||
if n>1000 then
|
||||
begin
|
||||
if Assigned(fOnIdle) then fOnIdle(self);
|
||||
n :=0;
|
||||
@ -86,9 +87,10 @@ begin
|
||||
end;
|
||||
|
||||
constructor TServerMainThread.Create(ALogger: TLogger; APort: integer;
|
||||
OnReceive: TCommandReceived);
|
||||
TermCheck: TChecker; OnReceive: TCommandReceived);
|
||||
begin
|
||||
inherited Create(TServerThread,ALogger,APort);
|
||||
fTerminateCheck:=TermCheck;
|
||||
fOnReceive := OnReceive;
|
||||
Connect.OnAccept:=@Accept;
|
||||
//FreeOnTerminate:=true;
|
||||
|
||||
@ -129,6 +129,7 @@ var
|
||||
clt: TConnectionThread;
|
||||
i: integer;
|
||||
begin
|
||||
result := nil;
|
||||
for i := 0 to fclients.Count-1 do
|
||||
if TConnectionThread(fclients[i]).Socket=index then
|
||||
begin
|
||||
@ -137,7 +138,7 @@ begin
|
||||
exit;
|
||||
end;
|
||||
result := fThreadClass.Create(self,index);
|
||||
log(mtExtra,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;
|
||||
@ -147,13 +148,13 @@ var
|
||||
i: integer;
|
||||
clt: TConnectionThread;
|
||||
begin
|
||||
log(mtExtra,Self,'Terminate Clients');
|
||||
log(mtDebug,Self,'Terminate Clients '+inttostr(fclients.Count));
|
||||
for i := fclients.Count-1 downto 0 do
|
||||
begin
|
||||
sleep(0);
|
||||
clt := TConnectionThread(fclients[i]);
|
||||
try
|
||||
log(mtExtra,self,GuidToString(clt.ID));
|
||||
log(mtDebug,self,GuidToString(clt.ID));
|
||||
clt.Terminate;
|
||||
clt.WaitFor;
|
||||
clt.free;
|
||||
@ -182,7 +183,11 @@ end;
|
||||
|
||||
procedure TMainThread.RemoveClient(clt: TConnectionThread);
|
||||
begin
|
||||
clt.Terminate;
|
||||
clt.WaitFor;
|
||||
log(mtDebug,self,'RemoveClient '+GuidToString(clt.ID));
|
||||
fclients.Remove(clt);
|
||||
clt.free;
|
||||
end;
|
||||
|
||||
|
||||
@ -190,7 +195,7 @@ procedure TMainThread.dataReady(aSocket: TLSocket);
|
||||
var
|
||||
clt: TConnectionThread;
|
||||
begin
|
||||
log(mtExtra,self,'dataReady');
|
||||
log(mtExtra,self,format('dataReady(%s:%d<-%s:%d) ',[aSocket.LocalAddress,aSocket.LocalPort,aSocket.PeerAddress,aSocket.PeerPort]));
|
||||
if Terminated then exit;
|
||||
|
||||
clt := Client[aSocket];
|
||||
@ -203,19 +208,19 @@ end;
|
||||
|
||||
procedure TMainThread.ProcessConnect(thread: TConnectionThread);
|
||||
begin
|
||||
|
||||
log(mtExtra,self,'ProcessConnect'+GUIDToString(thread.ID));
|
||||
end;
|
||||
|
||||
procedure TMainThread.ProcessAccept(thread: TConnectionThread);
|
||||
begin
|
||||
|
||||
log(mtExtra,self,'ProcessAccept'+GUIDToString(thread.ID));
|
||||
end;
|
||||
|
||||
procedure TMainThread.Accept(aSocket: TLSocket);
|
||||
var
|
||||
clt: TConnectionThread;
|
||||
begin
|
||||
log(mtExtra,self,'connect');
|
||||
log(mtExtra,self,format('accept(%s:%d<-%s:%d) ',[aSocket.LocalAddress,aSocket.LocalPort,aSocket.PeerAddress,aSocket.PeerPort]));
|
||||
if Terminated then exit;
|
||||
clt := Client[aSocket];
|
||||
log(mtExtra,self,format('connected %s on %d ',[GUIDToString(clt.ID), aSocket.Handle]));
|
||||
@ -229,14 +234,17 @@ var
|
||||
clt: TConnectionThread;
|
||||
begin
|
||||
if terminated then exit;
|
||||
log(mtExtra,self,'disconnect');
|
||||
log(mtDebug,self,format('disconnect(%s:%d<-%s:%d) ',[aSocket.LocalAddress,aSocket.LocalPort,aSocket.PeerAddress,aSocket.PeerPort]));
|
||||
try
|
||||
clt := Client[aSocket];
|
||||
if clt.terminated then exit;
|
||||
log(mtExtra,self,format('disconnected %s on %d ',[GUIDToString(clt.ID), aSocket.Handle]));
|
||||
clt.Terminate;
|
||||
fclients.remove(clt);
|
||||
|
||||
if assigned(clt) then
|
||||
begin
|
||||
log(mtDebug,self,format('disconnected %s on %d ',[GUIDToString(clt.ID), aSocket.Handle]));
|
||||
clt.Terminate;
|
||||
fclients.remove(clt);
|
||||
clt.WaitFor;
|
||||
clt.free;
|
||||
end;
|
||||
except on e: Exception do
|
||||
begin
|
||||
log(mtError,self,'!!ERROR doDisconnect '+e.Message);
|
||||
@ -249,7 +257,7 @@ procedure TMainThread.doConnect(aSocket: TLSocket);
|
||||
var
|
||||
clt: TConnectionThread;
|
||||
begin
|
||||
log(mtExtra,self,'doConnect');
|
||||
log(mtExtra,self,format('doConnect(%s:%d<-%s:%d) ',[aSocket.LocalAddress,aSocket.LocalPort,aSocket.PeerAddress,aSocket.PeerPort]));
|
||||
if Terminated then exit;
|
||||
clt := Client[aSocket];
|
||||
log(mtExtra,self,format('connected %s on %d ',[GUIDToString(clt.ID), aSocket.Handle]));
|
||||
@ -1040,7 +1048,7 @@ begin
|
||||
fOwner := AOwner;
|
||||
CreateGuid(ID);
|
||||
recNo := 0;
|
||||
log(mtExtra,'Create');
|
||||
log(mtExtra,'Create client thread ');
|
||||
end;
|
||||
|
||||
destructor TConnectionThread.Destroy;
|
||||
@ -1064,7 +1072,12 @@ begin
|
||||
log(mtExtra,'start thread');
|
||||
while not terminated do
|
||||
begin
|
||||
if cache.ReadReady.WaitFor(1000)<>wrSignaled then begin sleep(10);continue;end;
|
||||
if cache.ReadReady.WaitFor(10000)<>wrSignaled then
|
||||
begin
|
||||
log(mtDebug,'TConnectionThread.Wait');
|
||||
sleep(100);
|
||||
continue;
|
||||
end;
|
||||
if terminated then break;
|
||||
if not Socket.Connected then break;
|
||||
Keys := nil;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user