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

log+

Browse Source
This commit is contained in:
Алексей Заблоцкий 2023-11-15 14:22:32 +03:00
parent 885d006de3
commit c7a88f0d6c
9 changed files with 248 additions and 195 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

129
baseconnection.pas
View File

@ -5,54 +5,11 @@ unit baseconnection;
interface interface
uses uses
Classes, SysUtils, extTypes, Contnrs, cgiDM,reportDMUnit; Classes, SysUtils, extTypes,commandcol, Contnrs, cgiDM;
type type
{ TBaseConnection } { TBaseConnection }
TBaseConnection=class; TBaseConnection=class;
{ TCommand }
TCommand=class
protected
fData,
fResult: TCommandData;
fCommandID: string;
fStatus: integer;
fcurrentStage: string;
fconnect: TBaseConnection;
TimeOut: single;
fisDone,fisFinished: boolean;
fIsError: boolean;
fSubClass: string;
function getInt(keyName: string;defaultValue: integer=0): integer;
function getString(keyName: string): string;
public
AccessTime: TDateTime;
property Arguments: TCommandData read fData;
property Results: TCommandData read fResult;
property CommandID: string read fCommandID;
property Status: integer read fStatus;
property isDone: boolean read fIsDone;
property Error: boolean read fIsError;
property isFinished: boolean read fIsFinished;
property CurrentStage: string read fCurrentStage;
property Connect: TBaseConnection read fConnect;
constructor Create(aConnect: TBaseConnection; ASubClass: string);
destructor Destroy; override;
procedure doRun;
procedure Done;
function Run: boolean; virtual; abstract;
class function CommandName: string; virtual; abstract;
class function CommandSubClass: string; virtual; abstract;
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(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;
TBaseConnection=class(TThread) TBaseConnection=class(TThread)
private private
@ -61,7 +18,7 @@ type
fConnectionID: string; fConnectionID: string;
fTimeout: integer; fTimeout: integer;
fProcessor: TNIDBDM; fProcessor: TNIDBDM;
fReportProcessor: TReportDM;
Commands: TStrings; Commands: TStrings;
DoneCommands: TList; DoneCommands: TList;
fCreated, fCreated,
@ -91,7 +48,6 @@ type
property Owner: TComponent read fOwner; property Owner: TComponent read fOwner;
property ConnectionID: string read fConnectionID; property ConnectionID: string read fConnectionID;
property Processor: TNIDBDM read fProcessor; property Processor: TNIDBDM read fProcessor;
property ReportProcessor: TReportDM read fReportProcessor;
procedure Init; procedure Init;
constructor Create(AOwner: TComponent;ATimeOut: integer; aLogger: TLogger); constructor Create(AOwner: TComponent;ATimeOut: integer; aLogger: TLogger);
destructor Destroy; override; destructor Destroy; override;
@ -109,7 +65,7 @@ type
implementation implementation
uses uses
commandcol,ConnectionsDmUnit; ConnectionsDmUnit;
{ TBaseConnection } { TBaseConnection }
function TBaseConnection.calchash(data: TStream): string; function TBaseConnection.calchash(data: TStream): string;
begin begin
@ -134,8 +90,6 @@ begin
flogger := ALogger; flogger := ALogger;
fProcessor:=TNIDBDM.Create(nil); fProcessor:=TNIDBDM.Create(nil);
fProcessor.logger:=aLogger; fProcessor.logger:=aLogger;
fReportProcessor:=TReportDM.Create(AOwner);
fReportProcessor.NidbData := fProcessor;
Commands:=TStringList.Create; Commands:=TStringList.Create;
DoneCommands:=TList.Create; DoneCommands:=TList.Create;
fCreated := now(); fCreated := now();
@ -171,7 +125,7 @@ begin
cc := TCommandCollection.Find(ACommandClass,ACommandName); cc := TCommandCollection.Find(ACommandClass,ACommandName);
if assigned(cc) then if assigned(cc) then
begin begin
cmd := cc.Create(self,ACommandName); cmd := cc.Create(self.newID, self.Processor,ACommandName,fLogger,User,UserID);
cmd.AccessTime:=NOW(); cmd.AccessTime:=NOW();
result := cmd.ParseCommand(ACode,iParam,ACommandName,Arguments,intArgs,CmdData, Errors); result := cmd.ParseCommand(ACode,iParam,ACommandName,Arguments,intArgs,CmdData, Errors);
if result then if result then
@ -185,7 +139,7 @@ begin
ID := 'неверные параметры запроса'; ID := 'неверные параметры запроса';
retCode := ErrorArguments; retCode := ErrorArguments;
inc(nErrors); inc(nErrors);
cmd.fIsError:=true; cmd.Error:=true;
cmd.Done; cmd.Done;
DoneCommands.Add(cmd); DoneCommands.Add(cmd);
end; end;
@ -304,7 +258,7 @@ var
c: TCommand; c: TCommand;
tmp: TStrings; tmp: TStrings;
begin begin
with TCommandCollection.Find('report',Reportname).Create(self,ReportName) do with TCommandCollection.Find('report',Reportname).Create('', self.Processor,ReportName,fLogger,User,UserID) do
try try
ParseCommand(0,0,ReportName,ParamValues,[],nil,tmp); ParseCommand(0,0,ReportName,ParamValues,[],nil,tmp);
if assigned(tmp) then FreeAndNil(tmp); if assigned(tmp) then FreeAndNil(tmp);
@ -327,76 +281,5 @@ end;
{ TCommand }
function TCommand.getInt(keyName: string; defaultValue: integer): integer;
begin
result := StrToIntDef(fData.Keys.Values[keyName],defaultValue);
end;
function TCommand.getString(KeyName: string): string;
begin
result := fData.Keys.Values[KeyName];
end;
constructor TCommand.Create(aConnect: TBaseConnection; ASubClass: string);
begin
fconnect := AConnect;
fSubClass := ASubClass;
fStatus:=StatusWaiting;
fcurrentStage := 'в очереди';
TimeOut:=1/24/4;
fCommandID:=TBaseConnection.newID;
end;
destructor TCommand.Destroy;
begin
if assigned(fData) then fData.Free;
if assigned(fResult) then fResult.free;
inherited Destroy;
end;
procedure TCommand.doRun;
begin
fStatus:=StatusProcessing;
fcurrentStage := 'исполняется';
try
if Run then
begin
fStatus:=StatusComplete;
fcurrentStage := 'завершена';
end
else
begin
fStatus := StatusError;
fcurrentStage := 'завершена c ошибкой';
end;
except on e: Exception do
begin
fStatus:=StatusError;
fcurrentStage := 'error';
Results.Name:=e.Message;
end;
end;
end;
procedure TCommand.Done;
begin
fisDone:=true;
end;
function TCommand.ParseCommand(ACode: DWORD; iParam: QWORD; ACommand: string;
Args: TStrings; intArgs: TParamArray; CmdData: TStream; out Errors: TStrings
): boolean;
begin
self.fData := TCommandData.Create(ACode,iParam,ACommand,Args,intArgs,cmdData);
result := ParseArguments(fData.Keys,Errors);
end;
procedure TCommand.Log(ALevel: TLogLevel; msg: string);
begin
connect.log(ALevel,self, self.CommandID+#09+msg)
end;
end. end.

85
cgireport.pas
View File

@ -5,12 +5,13 @@ unit cgiReport;
interface interface
uses uses
Classes, SysUtils, baseconnection, extTypes, xpMemParamManagerUnit; Classes, SysUtils, commandCol, extTypes, xpMemParamManagerUnit, reportDMUnit,cgiDM;
type type
{ TReportCommand } { TReportCommand }
TReportCommand=class(TCommand) TReportCommand=class(TCommand)
private private
fReportProcessor: TReportDM;
procedure CreateVariablesTable; procedure CreateVariablesTable;
procedure UpdateCodeWithArguments(var code: string); procedure UpdateCodeWithArguments(var code: string);
procedure SetStage(ALevel:TLogLevel; Sender:TObject; stageName: string); procedure SetStage(ALevel:TLogLevel; Sender:TObject; stageName: string);
@ -29,18 +30,21 @@ type
function Run: boolean; override; function Run: boolean; override;
function ParseArguments(Args: TStrings; out Errors: TStrings): boolean; override; function ParseArguments(Args: TStrings; out Errors: TStrings): boolean; override;
function ProcessOptionValues(ParamName: string; out Answer: string; out RetValue: QWORD; out OptionValues: TStrings): boolean; override; function ProcessOptionValues(ParamName: string; out Answer: string; out RetValue: QWORD; out OptionValues: TStrings): boolean; override;
procedure EditTemplate; procedure EditTemplate(OnHash: TCalcHashProc);
procedure FillDefaults; procedure FillDefaults;
property ReportProcessor: TReportDM read fReportProcessor;
constructor Create(ID: string;aProcesor: TNIDBDM; ASubClass: string; aLogger:TLogger; AUser: string; IDUser: integer); override;
destructor Destroy; override;
end; end;
implementation implementation
uses uses
cgiDM,reportDMUnit, types, strutils, LazUTF8,allreportsunit,commandcol; types, strutils, LazUTF8,allreportsunit;
{ TReportCommand } { TReportCommand }
procedure TReportCommand.CreateVariablesTable; procedure TReportCommand.CreateVariablesTable;
begin begin
connect.Processor.ExecuteSQL( Processor.ExecuteSQL(
'drop table if exists tmp_report_variables; '+ 'drop table if exists tmp_report_variables; '+
'create temporary table tmp_report_variables ( '+ 'create temporary table tmp_report_variables ( '+
'name character varying,'+ 'name character varying,'+
@ -54,7 +58,7 @@ end;
procedure TReportCommand.UpdateCodeWithArguments(var code: string); procedure TReportCommand.UpdateCodeWithArguments(var code: string);
begin begin
TNIDBDM.UpdateWithArguments(code,Arguments.Keys); TNIDBDM.UpdateWithArguments(code,Arguments.Keys);
Code := StringReplace(Code,'{#user}',inttostr(self.Connect.UserID),[rfReplaceAll]); Code := StringReplace(Code,'{#user}',inttostr(UserID),[rfReplaceAll]);
end; end;
procedure TReportCommand.SetStage(ALevel: TLogLevel; Sender: TObject; procedure TReportCommand.SetStage(ALevel: TLogLevel; Sender: TObject;
@ -80,12 +84,12 @@ var
d: TStringDynArray; d: TStringDynArray;
i: integer; i: integer;
begin begin
ReportCode := connect.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); UpdateCodeWithArguments(ReportCode);
if reportcode<>'' then if reportcode<>'' then
connect.Processor.ExecuteSQL(format('select %s;',[ReportCode])); 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 := connect.Processor.QueryValue(ASQL); v := Processor.QueryValue(ASQL);
if v>'' then if v>'' then
begin begin
d := SplitString(v,';'); d := SplitString(v,';');
@ -94,17 +98,17 @@ begin
v := d[i]; v := d[i];
UpdateCodeWithArguments(v); UpdateCodeWithArguments(v);
if v<>'' then if v<>'' then
connect.Processor.ExecuteSQL(v); Processor.ExecuteSQL(v);
end; end;
end; end;
end; end;
procedure TReportCommand.PrepareVars; procedure TReportCommand.PrepareVars;
begin begin
VarCode := connect.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); UpdateCodeWithArguments(VarCode);
if VarCode<>'' then if VarCode<>'' then
connect.Processor.ExecuteSQL(format('select %s;',[VarCode])); Processor.ExecuteSQL(format('select %s;',[VarCode]));
end; end;
procedure TReportCommand.FillVars; procedure TReportCommand.FillVars;
@ -123,9 +127,9 @@ var
vi: integer; vi: integer;
begin begin
log(mtDebug,'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)]); script := format('insert into tmp_report_variables(name,value_string,var_type) values(''UserName'',%s,0); ',[TNIDBDM.StringAsSQL(UserName)]);
ASQL := format(Q_varlist,[ReportID,0]); ASQL := format(Q_varlist,[ReportID,0]);
with connect.Processor.GetData(ASQL) do with Processor.GetData(ASQL) do
try try
while not eof do while not eof do
begin begin
@ -133,7 +137,7 @@ begin
q := FieldByName('query').AsString; q := FieldByName('query').AsString;
UpdateCodeWithArguments(q); UpdateCodeWithArguments(q);
try try
vs := connect.Processor.QueryValue(q); vs := Processor.QueryValue(q);
except except
vs := ''; vs := '';
@ -146,7 +150,7 @@ begin
free; free;
end; end;
ASQL := format(Q_varlist,[ReportID,1]); ASQL := format(Q_varlist,[ReportID,1]);
with connect.Processor.GetData(ASQL) do with Processor.GetData(ASQL) do
try try
while not eof do while not eof do
begin begin
@ -154,7 +158,7 @@ begin
q := FieldByName('query').AsString; q := FieldByName('query').AsString;
UpdateCodeWithArguments(q); UpdateCodeWithArguments(q);
try try
vi := connect.Processor.QueryIntValue(q); vi := Processor.QueryIntValue(q);
except except
vi := 0; vi := 0;
@ -167,13 +171,26 @@ begin
free; free;
end; end;
if script<>'' then if script<>'' then
connect.Processor.ExecuteSQL(script); Processor.ExecuteSQL(script);
end; end;
procedure TReportCommand.OnFillVariables(AVariables: TxpMemParamManager); procedure TReportCommand.OnFillVariables(AVariables: TxpMemParamManager);
begin begin
end; end;
constructor TReportCommand.Create(ID: string; aProcesor: TNIDBDM;
ASubClass: string; aLogger: TLogger; AUser: string; IDUser: integer);
begin
inherited Create(ID,aProcesor, aSubClass, aLogger,AUser,IDUser);
fReportProcessor:=TReportDM.Create(nil);
fReportProcessor.NidbData := fProcessor;
end;
destructor TReportCommand.Destroy;
begin
fReportProcessor.Free;
inherited Destroy;
end;
function TReportCommand.Run: boolean; function TReportCommand.Run: boolean;
var var
@ -185,22 +202,22 @@ begin
fcurrentStage := 'исполняется (инициализация)'; fcurrentStage := 'исполняется (инициализация)';
fileData := TMemoryStream.Create; fileData := TMemoryStream.Create;
try try
ReportID := connect.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 if ReportID<=0 then
begin begin
fResult := TCommandData.Create(ErrorArguments,0,'Отчет не найден',nil,[],nil); fResult := TCommandData.Create(ErrorArguments,0,'Отчет не найден',nil,[],nil);
exit; exit;
end; 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)])); 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; CreateVariablesTable;
log(mtInfo,'Построение отчета '+ReportTitle); log(mtInfo,'Построение отчета '+ReportTitle);
connect.ReportProcessor.RecordID:=ReportID; ReportProcessor.RecordID:=ReportID;
fcurrentStage := 'исполняется (подготовка)'; fcurrentStage := 'исполняется (подготовка)';
try try
Prepare; Prepare;
except on e: Exception do except on e: Exception do
begin begin
connect.Processor.LogError(self,e,'prepare'); Processor.LogError(self,e,'prepare');
fResult := TCommandData.Create(ErrorInternal,0,'Ошибка составления',nil,[],nil); fResult := TCommandData.Create(ErrorInternal,0,'Ошибка составления',nil,[],nil);
exit; exit;
end; end;
@ -211,17 +228,17 @@ begin
PrepareVars; PrepareVars;
except on e: Exception do except on e: Exception do
begin begin
connect.Processor.LogError(self,e,'vars'); Processor.LogError(self,e,'vars');
fResult := TCommandData.Create(ErrorInternal,0,'Ошибка составления',nil,[],nil); fResult := TCommandData.Create(ErrorInternal,0,'Ошибка составления',nil,[],nil);
exit; exit;
end; end;
end; end;
fcurrentStage := 'исполняется ()'; fcurrentStage := 'исполняется ()';
try try
connect.ReportProcessor.ExportReport(ftPDF,fileData,@SetStage,@OnFillVariables); ReportProcessor.ExportReport(ftPDF,fileData,@SetStage,@OnFillVariables);
except on e: Exception do except on e: Exception do
begin begin
connect.Processor.LogError(self,e,'ExportReport'); Processor.LogError(self,e,'ExportReport');
fResult := TCommandData.Create(ErrorInternal,0,'Ошибка составления',nil,[],nil); fResult := TCommandData.Create(ErrorInternal,0,'Ошибка составления',nil,[],nil);
exit; exit;
end; end;
@ -256,7 +273,7 @@ begin
'where c.cgi_name=%s and p.name not in (%s) '+ 'where c.cgi_name=%s and p.name not in (%s) '+
'order by fill_order,p.name ', 'order by fill_order,p.name ',
[TNIDBDM.StringAsSQL(ReportName),(ids)]); [TNIDBDM.StringAsSQL(ReportName),(ids)]);
with Connect.Processor.GetData(asql) do with Processor.GetData(asql) do
try try
if not eof then if not eof then
begin begin
@ -289,7 +306,7 @@ begin
' join xp_report_cgi c on c.xp_rpt_id=p.xp_rpt_id '+ ' join xp_report_cgi c on c.xp_rpt_id=p.xp_rpt_id '+
'where c.cgi_name=%s and p.name=%s and p.type in (0,1,2,17) ', 'where c.cgi_name=%s and p.name=%s and p.type in (0,1,2,17) ',
[TNIDBDM.StringAsSQL(fSubClass), TNIDBDM.StringAsSQL(ParamName)]); [TNIDBDM.StringAsSQL(fSubClass), TNIDBDM.StringAsSQL(ParamName)]);
code := connect.Processor.QueryValue(ASQL); code := Processor.QueryValue(ASQL);
if code='' then exit; if code='' then exit;
if code[1]='(' then if code[1]='(' then
begin begin
@ -322,7 +339,7 @@ begin
ASQL := code; ASQL := code;
OptionValues := TStringList.Create; OptionValues := TStringList.Create;
if ASQL<>'' then if ASQL<>'' then
with connect.Processor.GetData(ASQL) do with Processor.GetData(ASQL) do
try try
while not eof do while not eof do
begin begin
@ -338,17 +355,17 @@ begin
result := true; result := true;
end; end;
procedure TReportCommand.EditTemplate; procedure TReportCommand.EditTemplate(OnHash: TCalcHashProc);
begin begin
CreateVariablesTable; CreateVariablesTable;
log(mtInfo,'Построение отчета '+ReportTitle); log(mtInfo,'Построение отчета '+ReportTitle);
connect.ReportProcessor.RecordID:=ReportID; ReportProcessor.RecordID:=ReportID;
fcurrentStage := 'исполняется (подготовка)'; fcurrentStage := 'исполняется (подготовка)';
try try
Prepare; Prepare;
except on e: Exception do except on e: Exception do
begin begin
connect.Processor.LogError(self,e,'prepare'); Processor.LogError(self,e,'prepare');
fResult := TCommandData.Create(ErrorInternal,0,'Ошибка составления',nil,[],nil); fResult := TCommandData.Create(ErrorInternal,0,'Ошибка составления',nil,[],nil);
exit; exit;
end; end;
@ -359,17 +376,17 @@ begin
PrepareVars; PrepareVars;
except on e: Exception do except on e: Exception do
begin begin
connect.Processor.LogError(self,e,'vars'); Processor.LogError(self,e,'vars');
fResult := TCommandData.Create(ErrorInternal,0,'Ошибка составления',nil,[],nil); fResult := TCommandData.Create(ErrorInternal,0,'Ошибка составления',nil,[],nil);
exit; exit;
end; end;
end; end;
fcurrentStage := 'исполняется ()'; fcurrentStage := 'исполняется ()';
try try
connect.ReportProcessor.EditReport(@OnFillVariables,@connect.calchash); ReportProcessor.EditReport(@OnFillVariables,OnHash);
except on e: Exception do except on e: Exception do
begin begin
connect.Processor.LogError(self,e,'ExportReport'); Processor.LogError(self,e,'ExportReport');
fResult := TCommandData.Create(ErrorInternal,0,'Ошибка составления',nil,[],nil); fResult := TCommandData.Create(ErrorInternal,0,'Ошибка составления',nil,[],nil);
exit; exit;
end; end;
@ -395,7 +412,7 @@ begin
l := TStringList.Create; l := TStringList.Create;
try try
l.add('name='+ReportName); l.add('name='+ReportName);
with Connect.Processor.GetData(asql) do with Processor.GetData(asql) do
try try
while not eof do while not eof do
begin begin

137
commandcol.pas
View File

@ -5,8 +5,57 @@ unit commandcol;
interface interface
uses uses
Classes, SysUtils,Contnrs,baseconnection; Classes, SysUtils,Contnrs, extTypes, cgiDM;
type type
{ TCommand }
TCommand=class
protected
fData,
fResult: TCommandData;
fCommandID: string;
fStatus: integer;
fcurrentStage: string;
fProcessor: TNIDBDM;
fisDone,fisFinished: boolean;
fIsError: boolean;
fSubClass: string;
fUser: integer;
fUserName: string;
fLogger: TLogger;
function getInt(keyName: string;defaultValue: integer=0): integer;
function getString(keyName: string): string;
public
AccessTime: TDateTime;
TimeOut: single;
property Arguments: TCommandData read fData;
property Results: TCommandData read fResult;
property CommandID: string read fCommandID;
property Status: integer read fStatus;
property isDone: boolean read fIsDone;
property Error: boolean read fIsError write fIsError;
property isFinished: boolean read fIsFinished;
property CurrentStage: string read fCurrentStage;
property Processor: TNIDBDM read fProcessor;
property UserID: integer read fUser;
property UserName: string read fUserName;
constructor Create(ID: string; aProcessor: TNIDBDM; ASubClass: string; aLogger:TLogger; AUser: string; IDUser: integer); virtual;
destructor Destroy; override;
procedure doRun;
procedure Done;
function Run: boolean; virtual; abstract;
class function CommandName: string; virtual; abstract;
class function CommandSubClass: string; virtual; abstract;
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(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;
{ TCommandCollection } { TCommandCollection }
TCommandCollection=Class; TCommandCollection=Class;
TCommandCollection=Class(TClassList) TCommandCollection=Class(TClassList)
@ -24,8 +73,8 @@ implementation
class procedure TCommandCollection.Register(ACommand: TCommandClass); class procedure TCommandCollection.Register(ACommand: TCommandClass);
begin begin
if not assigned(fCollection) then {if not assigned(fCollection) then
Init; Init;}
fCollection.Add(ACommand); fCollection.Add(ACommand);
end; end;
@ -58,6 +107,88 @@ class procedure TCommandCollection.Done;
begin begin
fCollection.Free; fCollection.Free;
end; end;
{ TCommand }
function TCommand.getInt(keyName: string; defaultValue: integer): integer;
begin
result := StrToIntDef(fData.Keys.Values[keyName],defaultValue);
end;
function TCommand.getString(keyName: string): string;
begin
result := fData.Keys.Values[KeyName];
end;
constructor TCommand.Create(ID: string; aProcessor: TNIDBDM; ASubClass: string;
aLogger: TLogger; AUser: string; IDUser: integer);
begin
fProcessor := AProcessor;
fSubClass := ASubClass;
fStatus:=StatusWaiting;
fcurrentStage := 'в очереди';
fUserName := AUser;
fUser := IDUser;
fLogger := ALogger;
TimeOut:=1/24/4;
fCommandID:=ID;
fResult := nil;
fData := nil;
end;
destructor TCommand.Destroy;
begin
if assigned(fData) then fData.Free;
if assigned(fResult) then fResult.free;
inherited Destroy;
end;
procedure TCommand.doRun;
begin
fStatus:=StatusProcessing;
fcurrentStage := 'исполняется';
try
if Run then
begin
fStatus:=StatusComplete;
fcurrentStage := 'завершена';
end
else
begin
fStatus := StatusError;
fcurrentStage := 'завершена c ошибкой';
end;
except on e: Exception do
begin
fStatus:=StatusError;
fcurrentStage := 'error';
if assigned(Results) then
Results.Free;
fResult := TCommandData.Create(ErrorInternal,0,e.ClassName,[e.Message],[],nil);
Results.Name:=e.Message;
end;
end;
end;
procedure TCommand.Done;
begin
fisDone:=true;
end;
function TCommand.ParseCommand(ACode: DWORD; iParam: QWORD; ACommand: string;
Args: TStrings; intArgs: TParamArray; CmdData: TStream; out Errors: TStrings
): boolean;
begin
self.fData := TCommandData.Create(ACode,iParam,ACommand,Args,intArgs,cmdData);
result := ParseArguments(fData.Keys,Errors);
end;
procedure TCommand.Log(ALevel: TLogLevel; msg: string);
begin
if assigned(flogger) then
fLogger(ALevel,self, self.CommandID+#09+msg)
end;
initialization initialization
TCommandCollection.Init; TCommandCollection.Init;
finalization finalization

21
connectionsdmunit.pas
View File

@ -213,6 +213,7 @@ var
userName,conID,cmdID: string; userName,conID,cmdID: string;
cmd: TCommand; cmd: TCommand;
begin begin
try
log(mtInfo, Self,'Process Request '+ACommand); log(mtInfo, Self,'Process Request '+ACommand);
ClearTerminated; ClearTerminated;
result := false; result := false;
@ -339,6 +340,8 @@ begin
if ACommand='status' then if ACommand='status' then
begin begin
Answer := cmd.currentStage; Answer := cmd.currentStage;
if assigned(cmd.Results) then
cmd.Results.AssignTo(Code,RetValue,Answer,rValues,iValues,ByteData);
code := cmd.Status; code := cmd.Status;
if (code=StatusComplete) and assigned(cmd.Results.Data) then if (code=StatusComplete) and assigned(cmd.Results.Data) then
RetValue:=cmd.Results.Data.Size RetValue:=cmd.Results.Data.Size
@ -366,6 +369,15 @@ begin
end; end;
result := con.AddCommand(CommandID,Param,ACommand,Fields.Values['name'],Fields,iValues,Data,Answer,Code, rValues); result := con.AddCommand(CommandID,Param,ACommand,Fields.Values['name'],Fields,iValues,Data,Answer,Code, rValues);
except on e: Exception do
begin
result := false;
Answer := e.message;
Code := ErrorInternal;
log(mtError,self,format('ProcessRequest () -> %s(%s)',[e.ClassName,e.Message]));
end;
end;
end; end;
constructor TConnectionsDM.CreateWithLog(ALogger: TEventLog); constructor TConnectionsDM.CreateWithLog(ALogger: TEventLog);
@ -423,21 +435,16 @@ var
begin begin
asql := format('select cgi_name from xp_report_cgi where xp_rpt_id=%d',[ReportID]); asql := format('select cgi_name from xp_report_cgi where xp_rpt_id=%d',[ReportID]);
RName := MainCon.QueryValue(asql); RName := MainCon.QueryValue(asql);
con := NewConnection;
try
cc := TCommandCollection.Find('report',RName); cc := TCommandCollection.Find('report',RName);
cmd := cc.Create(con,RName) as TReportCommand; cmd := cc.Create('', MainCon,RName,@Log,'',0) as TReportCommand;
try try
cmd.ReportID := ReportID; cmd.ReportID := ReportID;
cmd.ReportName:=RName; cmd.ReportName:=RName;
cmd.FillDefaults; cmd.FillDefaults;
cmd.EditTemplate; cmd.EditTemplate(@CalcHash);
finally finally
cmd.free; cmd.free;
end; end;
finally
con.terminate;
end;
end; end;
function TConnectionsDM.ProcessLogin(UserName, UserPassword: string; out UserID: integer): boolean; function TConnectionsDM.ProcessLogin(UserName, UserPassword: string; out UserID: integer): boolean;

12
lms_cgi.lpi
View File

@ -29,21 +29,9 @@
<PackageName Value="lnetbase"/> <PackageName Value="lnetbase"/>
</Item> </Item>
<Item> <Item>
<PackageName Value="Abbrevia"/>
</Item>
<Item>
<PackageName Value="frxe_lazarus"/>
</Item>
<Item>
<PackageName Value="dcpcrypt"/> <PackageName Value="dcpcrypt"/>
</Item> </Item>
<Item> <Item>
<PackageName Value="fr_lazarus"/>
</Item>
<Item>
<PackageName Value="nnzdata"/>
</Item>
<Item>
<PackageName Value="WebLaz"/> <PackageName Value="WebLaz"/>
</Item> </Item>
<Item> <Item>

31
lms_cgi.lpr
View File

@ -4,7 +4,7 @@ program lms_cgi;
uses uses
Interfaces, Classes, SysUtils, inifiles, httpDefs, fpweb, custweb, custcgi, Interfaces, Classes, SysUtils, inifiles, httpDefs, fpweb, custweb, custcgi,
cxlogger, abbrevia, lnetbase, tcpClient, tcpthreadhelper, extTypes; lnetbase, tcpClient, tcpthreadhelper, extTypes;
Type Type
@ -75,8 +75,35 @@ var
k,v: string; k,v: string;
allfields: TStrings; allfields: TStrings;
begin begin
log(mtInfo,self,'Request '+ARequest.Command); log(mtInfo,self,'Command '+ARequest.Command);
log(mtInfo,self,'RemoteAddr '+ARequest.RemoteAddr);
log(mtInfo,self,'RemoteAddress '+ARequest.RemoteAddress);
log(mtInfo,self,'CommandLine '+ARequest.CommandLine);
log(mtInfo,self,'ContentRange '+ARequest.ContentRange);
log(mtInfo,self,'HeaderLine '+ARequest.HeaderLine);
log(mtInfo,self,'QueryString '+ARequest.QueryString);
log(mtInfo,self,'Authorization '+ARequest.Authorization);
log(mtInfo,self,'Connection '+ARequest.Connection);
log(mtInfo,self,'WWWAuthenticate '+ARequest.WWWAuthenticate);
log(mtInfo,self,'Content '+ARequest.Content);
log(mtInfo,self,'ContentType '+ARequest.ContentType);
log(mtInfo,self,'From '+ARequest.From);
log(mtInfo,self,'UserAgent '+ARequest.UserAgent);
log(mtInfo,self,'URI '+ARequest.URI);
log(mtInfo,self,'URL '+ARequest.URL);
log(mtInfo,self,'ContentEncoding '+ARequest.ContentEncoding);
log(mtInfo,self,'ContentLanguage '+ARequest.ContentLanguage);
log(mtInfo,self,'Query '+ARequest.Query);
log(mtInfo,self,'Location '+ARequest.Location);
log(mtInfo,self,'Method '+ARequest.Method);
log(mtInfo,self,'PathInfo '+ARequest.PathInfo);
log(mtInfo,self,'Referer '+ARequest.Referer);
LogStrings(mtInfo, @log,self,'QueryFields',Arequest.QueryFields); LogStrings(mtInfo, @log,self,'QueryFields',Arequest.QueryFields);
LogStrings(mtInfo, @log,self,'ContentFields',Arequest.ContentFields);
LogStrings(mtInfo, @log,self,'CookieFields',Arequest.CookieFields);
LogStrings(mtInfo, @log,self,'CustomHeaders',Arequest.CustomHeaders);
allfields := TStringList.Create; allfields := TStringList.Create;
try try
allfields.AddStrings(ARequest.QueryFields); allfields.AddStrings(ARequest.QueryFields);

BIN
lms_cgi.obj
View File

Binary file not shown.

8
reports/applicantlist.pas
View File

@ -94,14 +94,14 @@ begin
' LEFT JOIN xp_subjects subj ON subj.Subject = a.Subject; ', ' LEFT JOIN xp_subjects subj ON subj.Subject = a.Subject; ',
[idyear,cbStream]); [idyear,cbStream]);
Connect.Processor.ExecuteSQL(SQL); Processor.ExecuteSQL(SQL);
SQL := SQL :=
'DROP TABLE IF EXISTS tmp_app_sex; '+ 'DROP TABLE IF EXISTS tmp_app_sex; '+
'CREATE TEMPORARY TABLE tmp_app_sex AS '+ 'CREATE TEMPORARY TABLE tmp_app_sex AS '+
'SELECT child_class, count(*) as sex_count FROM '+ 'SELECT child_class, count(*) as sex_count FROM '+
'(SELECT child_class,sex FROM tmp_applicant WHERE sex IS NOT NULL GROUP BY child_class,sex) t '+ '(SELECT child_class,sex FROM tmp_applicant WHERE sex IS NOT NULL GROUP BY child_class,sex) t '+
'GROUP BY Child_class; '; 'GROUP BY Child_class; ';
Connect.Processor.ExecuteSQL(SQL); Processor.ExecuteSQL(SQL);
SQL := format( SQL := format(
'DROP TABLE IF EXISTS tmp_members; '+ 'DROP TABLE IF EXISTS tmp_members; '+
'CREATE TEMPORARY TABLE tmp_members AS '+ 'CREATE TEMPORARY TABLE tmp_members AS '+
@ -109,7 +109,7 @@ begin
' JOIN enroll_comitet_members m ON m.enroll_comitet = c.id '+ ' JOIN enroll_comitet_members m ON m.enroll_comitet = c.id '+
'WHERE c.school_year=%0:d AND coalesce(c.stream,0)=%1:d ORDER BY 1' , 'WHERE c.school_year=%0:d AND coalesce(c.stream,0)=%1:d ORDER BY 1' ,
[idYear,cbStream]); [idYear,cbStream]);
Connect.Processor.ExecuteSQL(SQL); Processor.ExecuteSQL(SQL);
end; end;
@ -128,7 +128,7 @@ begin
'SELECT xp_f_get_mid_fio(c.chairman,0) as chairman , xp_f_get_mid_fio(c.deputy,0) as deputy, xp_f_get_mid_fio(c.deputy2,0) as deputy2, xp_f_get_mid_fio(c.secretary,0) as secretary '+ 'SELECT xp_f_get_mid_fio(c.chairman,0) as chairman , xp_f_get_mid_fio(c.deputy,0) as deputy, xp_f_get_mid_fio(c.deputy2,0) as deputy2, xp_f_get_mid_fio(c.secretary,0) as secretary '+
'FROM enroll_comitet c WHERE c.school_year = %0:d AND coalesce(c.stream,0)=%1:d; ', 'FROM enroll_comitet c WHERE c.school_year = %0:d AND coalesce(c.stream,0)=%1:d; ',
[idYear,cbStream]); [idYear,cbStream]);
with connect.Processor.getData(SQL) do with Processor.getData(SQL) do
try try
if Not eof then if Not eof then
begin begin

20
reports/applicantresult.pas
View File

@ -75,10 +75,10 @@ begin
'WHERE t.sorting>0 '+ 'WHERE t.sorting>0 '+
'GROUP BY t.ExamName; ', 'GROUP BY t.ExamName; ',
[idYear,cbStream,Exams]); [idYear,cbStream,Exams]);
connect.processor.ExecuteSQL(SQL); processor.ExecuteSQL(SQL);
ColCount := 0; ColCount := 0;
with connect.processor.getData('SELECT ExamName,sorting FROM tmpExams ORDER BY sorting,ExamName ') do with processor.getData('SELECT ExamName,sorting FROM tmpExams ORDER BY sorting,ExamName ') do
try try
while not eof and (ColCount<8) do while not eof and (ColCount<8) do
begin begin
@ -285,7 +285,7 @@ begin
// fs.Add(sql); // fs.Add(sql);
// fs.SaveToFile('sqlappldebug.sql'); // fs.SaveToFile('sqlappldebug.sql');
//xpInformation(sql); //xpInformation(sql);
connect.processor.ExecuteSQL(SQL); processor.ExecuteSQL(SQL);
colSorter := MakeCols(); colSorter := MakeCols();
SQL := format( SQL := format(
@ -362,7 +362,7 @@ begin
' LEFT JOIN tmpExams e6 ON e6.ExamName = a1.Col6 '}, ' LEFT JOIN tmpExams e6 ON e6.ExamName = a1.Col6 '},
[idYear]); [idYear]);
//xpInformation(sql); //xpInformation(sql);
connect.processor.ExecuteSQL(SQL); processor.ExecuteSQL(SQL);
SQL := SQL :=
'UPDATE xp_applicant a '+ 'UPDATE xp_applicant a '+
@ -440,7 +440,7 @@ begin
'ORDER BY child_class,2; ', 'ORDER BY child_class,2; ',
[idYear,cbStream, Psycho[1],Exams[1], Psycho[2]]); [idYear,cbStream, Psycho[1],Exams[1], Psycho[2]]);
connect.Processor.ExecuteSQL(SQL); Processor.ExecuteSQL(SQL);
end; end;
@ -465,7 +465,7 @@ begin
' JOIN enroll_comitet_members m ON m.enroll_comitet = c.id '+ ' JOIN enroll_comitet_members m ON m.enroll_comitet = c.id '+
'WHERE c.school_year=%0:d AND coalesce(c.stream,0)=%1:d ORDER BY 1; ' , 'WHERE c.school_year=%0:d AND coalesce(c.stream,0)=%1:d ORDER BY 1; ' ,
[idYear,cbStream]); [idYear,cbStream]);
connect.processor.ExecuteSQL(SQL); processor.ExecuteSQL(SQL);
end; end;
procedure TRepApplicantResult.OnFillVariables(AVariables: TxpMemParamManager); procedure TRepApplicantResult.OnFillVariables(AVariables: TxpMemParamManager);
@ -488,13 +488,13 @@ begin
end; end;
for i := 1 to ApplicantExtraParamCnt do for i := 1 to ApplicantExtraParamCnt do
begin begin
extra_params[i] := connect.processor.QueryIntValue(format('SELECT coalesce(%s,0) FROM enroll_params WHERE school_year=%d',[ApplicantExtraFields[i], idYear]))=1; extra_params[i] := processor.QueryIntValue(format('SELECT coalesce(%s,0) FROM enroll_params WHERE school_year=%d',[ApplicantExtraFields[i], idYear]))=1;
if extra_params[i] then if extra_params[i] then
AVariables['ball_extra_'+inttostr(i)] := 1 AVariables['ball_extra_'+inttostr(i)] := 1
else else
AVariables['ball_extra_'+inttostr(i)] := 0; AVariables['ball_extra_'+inttostr(i)] := 0;
end; end;
if (connect.processor.QueryIntValue('SELECT COUNT(*) as cnt FROM tmp_rpt_problems')>0) then if (processor.QueryIntValue('SELECT COUNT(*) as cnt FROM tmp_rpt_problems')>0) then
AVariables['rpt_ready'] := 'ПРЕДВАРИТЕЛЬНЫЕ'#13#10'результаты' AVariables['rpt_ready'] := 'ПРЕДВАРИТЕЛЬНЫЕ'#13#10'результаты'
else else
AVariables['rpt_ready'] := ('Результаты'); AVariables['rpt_ready'] := ('Результаты');
@ -502,7 +502,7 @@ begin
'SELECT xp_f_get_mid_fio(c.chairman,0) as chairman , xp_f_get_mid_fio(c.deputy,0) as deputy, xp_f_get_mid_fio(c.deputy2,0) as deputy2, xp_f_get_mid_fio(c.secretary,0) as secretary '+ 'SELECT xp_f_get_mid_fio(c.chairman,0) as chairman , xp_f_get_mid_fio(c.deputy,0) as deputy, xp_f_get_mid_fio(c.deputy2,0) as deputy2, xp_f_get_mid_fio(c.secretary,0) as secretary '+
'FROM enroll_comitet c WHERE c.school_year = %0:d AND coalesce(c.stream,0)=%1:d; ', 'FROM enroll_comitet c WHERE c.school_year = %0:d AND coalesce(c.stream,0)=%1:d; ',
[idYear,cbStream]); [idYear,cbStream]);
with connect.Processor.getData(SQL) do with Processor.getData(SQL) do
try try
if Not eof then if Not eof then
begin begin
@ -524,7 +524,7 @@ begin
Free; Free;
end; end;
//Variables['Year'] := YearOf(Date); //Variables['Year'] := YearOf(Date);
AVariables['Year'] := connect.processor.QueryValue('SELECT YEAR(begdate) FROM school_year WHERE xp_key = ' + inttostr(idyear)); AVariables['Year'] := processor.QueryValue('SELECT YEAR(begdate) FROM school_year WHERE xp_key = ' + inttostr(idyear));
end; end;
Initialization Initialization