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
uses
Classes, SysUtils, extTypes, Contnrs, cgiDM,reportDMUnit;
Classes, SysUtils, extTypes,commandcol, Contnrs, cgiDM;
type
{ TBaseConnection }
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)
private
@ -61,7 +18,7 @@ type
fConnectionID: string;
fTimeout: integer;
fProcessor: TNIDBDM;
fReportProcessor: TReportDM;
Commands: TStrings;
DoneCommands: TList;
fCreated,
@ -91,7 +48,6 @@ type
property Owner: TComponent read fOwner;
property ConnectionID: string read fConnectionID;
property Processor: TNIDBDM read fProcessor;
property ReportProcessor: TReportDM read fReportProcessor;
procedure Init;
constructor Create(AOwner: TComponent;ATimeOut: integer; aLogger: TLogger);
destructor Destroy; override;
@ -109,7 +65,7 @@ type
implementation
uses
commandcol,ConnectionsDmUnit;
ConnectionsDmUnit;
{ TBaseConnection }
function TBaseConnection.calchash(data: TStream): string;
begin
@ -134,8 +90,6 @@ begin
flogger := ALogger;
fProcessor:=TNIDBDM.Create(nil);
fProcessor.logger:=aLogger;
fReportProcessor:=TReportDM.Create(AOwner);
fReportProcessor.NidbData := fProcessor;
Commands:=TStringList.Create;
DoneCommands:=TList.Create;
fCreated := now();
@ -171,7 +125,7 @@ begin
cc := TCommandCollection.Find(ACommandClass,ACommandName);
if assigned(cc) then
begin
cmd := cc.Create(self,ACommandName);
cmd := cc.Create(self.newID, self.Processor,ACommandName,fLogger,User,UserID);
cmd.AccessTime:=NOW();
result := cmd.ParseCommand(ACode,iParam,ACommandName,Arguments,intArgs,CmdData, Errors);
if result then
@ -185,7 +139,7 @@ begin
ID := 'неверные параметры запроса';
retCode := ErrorArguments;
inc(nErrors);
cmd.fIsError:=true;
cmd.Error:=true;
cmd.Done;
DoneCommands.Add(cmd);
end;
@ -304,7 +258,7 @@ var
c: TCommand;
tmp: TStrings;
begin
with TCommandCollection.Find('report',Reportname).Create(self,ReportName) do
with TCommandCollection.Find('report',Reportname).Create('', self.Processor,ReportName,fLogger,User,UserID) do
try
ParseCommand(0,0,ReportName,ParamValues,[],nil,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.

85
cgireport.pas
View File

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

137
commandcol.pas
View File

@ -5,8 +5,57 @@ unit commandcol;
interface
uses
Classes, SysUtils,Contnrs,baseconnection;
Classes, SysUtils,Contnrs, extTypes, cgiDM;
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=Class;
TCommandCollection=Class(TClassList)
@ -24,8 +73,8 @@ implementation
class procedure TCommandCollection.Register(ACommand: TCommandClass);
begin
if not assigned(fCollection) then
Init;
{if not assigned(fCollection) then
Init;}
fCollection.Add(ACommand);
end;
@ -58,6 +107,88 @@ class procedure TCommandCollection.Done;
begin
fCollection.Free;
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
TCommandCollection.Init;
finalization

21
connectionsdmunit.pas
View File

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

12
lms_cgi.lpi
View File

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

31
lms_cgi.lpr
View File

@ -4,7 +4,7 @@ program lms_cgi;
uses
Interfaces, Classes, SysUtils, inifiles, httpDefs, fpweb, custweb, custcgi,
cxlogger, abbrevia, lnetbase, tcpClient, tcpthreadhelper, extTypes;
lnetbase, tcpClient, tcpthreadhelper, extTypes;
Type
@ -75,8 +75,35 @@ var
k,v: string;
allfields: TStrings;
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,'ContentFields',Arequest.ContentFields);
LogStrings(mtInfo, @log,self,'CookieFields',Arequest.CookieFields);
LogStrings(mtInfo, @log,self,'CustomHeaders',Arequest.CustomHeaders);
allfields := TStringList.Create;
try
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; ',
[idyear,cbStream]);
Connect.Processor.ExecuteSQL(SQL);
Processor.ExecuteSQL(SQL);
SQL :=
'DROP TABLE IF EXISTS tmp_app_sex; '+
'CREATE TEMPORARY TABLE tmp_app_sex AS '+
'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 '+
'GROUP BY Child_class; ';
Connect.Processor.ExecuteSQL(SQL);
Processor.ExecuteSQL(SQL);
SQL := format(
'DROP TABLE IF EXISTS tmp_members; '+
'CREATE TEMPORARY TABLE tmp_members AS '+
@ -109,7 +109,7 @@ begin
' 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' ,
[idYear,cbStream]);
Connect.Processor.ExecuteSQL(SQL);
Processor.ExecuteSQL(SQL);
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 '+
'FROM enroll_comitet c WHERE c.school_year = %0:d AND coalesce(c.stream,0)=%1:d; ',
[idYear,cbStream]);
with connect.Processor.getData(SQL) do
with Processor.getData(SQL) do
try
if Not eof then
begin

20
reports/applicantresult.pas
View File

@ -75,10 +75,10 @@ begin
'WHERE t.sorting>0 '+
'GROUP BY t.ExamName; ',
[idYear,cbStream,Exams]);
connect.processor.ExecuteSQL(SQL);
processor.ExecuteSQL(SQL);
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
while not eof and (ColCount<8) do
begin
@ -285,7 +285,7 @@ begin
// fs.Add(sql);
// fs.SaveToFile('sqlappldebug.sql');
//xpInformation(sql);
connect.processor.ExecuteSQL(SQL);
processor.ExecuteSQL(SQL);
colSorter := MakeCols();
SQL := format(
@ -362,7 +362,7 @@ begin
' LEFT JOIN tmpExams e6 ON e6.ExamName = a1.Col6 '},
[idYear]);
//xpInformation(sql);
connect.processor.ExecuteSQL(SQL);
processor.ExecuteSQL(SQL);
SQL :=
'UPDATE xp_applicant a '+
@ -440,7 +440,7 @@ begin
'ORDER BY child_class,2; ',
[idYear,cbStream, Psycho[1],Exams[1], Psycho[2]]);
connect.Processor.ExecuteSQL(SQL);
Processor.ExecuteSQL(SQL);
end;
@ -465,7 +465,7 @@ begin
' 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; ' ,
[idYear,cbStream]);
connect.processor.ExecuteSQL(SQL);
processor.ExecuteSQL(SQL);
end;
procedure TRepApplicantResult.OnFillVariables(AVariables: TxpMemParamManager);
@ -488,13 +488,13 @@ begin
end;
for i := 1 to ApplicantExtraParamCnt do
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
AVariables['ball_extra_'+inttostr(i)] := 1
else
AVariables['ball_extra_'+inttostr(i)] := 0;
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'результаты'
else
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 '+
'FROM enroll_comitet c WHERE c.school_year = %0:d AND coalesce(c.stream,0)=%1:d; ',
[idYear,cbStream]);
with connect.Processor.getData(SQL) do
with Processor.getData(SQL) do
try
if Not eof then
begin
@ -524,7 +524,7 @@ begin
Free;
end;
//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;
Initialization