diff --git a/baseconnection.pas b/baseconnection.pas index f8c32f6..ea2cea0 100644 --- a/baseconnection.pas +++ b/baseconnection.pas @@ -24,6 +24,8 @@ type fisDone,fisFinished: boolean; fIsError: boolean; fSubClass: string; + function getInt(keyName: string;defaultValue: integer=0): integer; + function getString(keyName: string): string; public AccessTime: TDateTime; @@ -51,17 +53,6 @@ type end; TCommandClass=class of TCommand; - { TCommandCollection } - TCommandCollection=Class; - TCommandCollection=Class(TClassList) - private - class var fCollection: TCommandCollection; - public - class procedure Register(ACommand: TCommandClass); - class function Find(Action,SubClass: string): TCommandClass; - class procedure Init; - class procedure Done; - end; TBaseConnection=class(TThread) private @@ -116,6 +107,8 @@ type end; implementation +uses + commandcol; { TBaseConnection } procedure TBaseConnection.Init; @@ -328,44 +321,19 @@ begin end; -{ TCommandCollection } - -class procedure TCommandCollection.Register(ACommand: TCommandClass); -begin - fCollection.Add(ACommand); -end; - -class function TCommandCollection.Find(Action, SubClass: string): TCommandClass; -var - i: integer; -begin - for i := 0 to fCollection.Count-1 do - if fCollection.Items[i].InheritsFrom(TCommand) and SameText(Action, TCommandClass(fCollection.Items[i]).CommandName) and SameText(SubClass, TCommandClass(fCollection.Items[i]).CommandSubClass) then - begin - result := TCommandClass(fCollection.Items[i]) ; - exit; - end; - for i := 0 to fCollection.Count-1 do - if fCollection.Items[i].InheritsFrom(TCommand) and SameText(Action, TCommandClass(fCollection.Items[i]).CommandName) and SameText('', TCommandClass(fCollection.Items[i]).CommandSubClass) then - begin - result := TCommandClass(fCollection.Items[i]) ; - exit; - end; - result := nil; -end; - -class procedure TCommandCollection.Init; -begin - fCollection := TCommandCollection.Create; -end; - -class procedure TCommandCollection.Done; -begin - fCollection.Free; -end; { TCommand } +function TCommand.getInt(keyName: string; defaultValue: integer): integer; +begin + result := StrToIntDef(fResult.Keys.Values[keyName],defaultValue); +end; + +function TCommand.getString(KeyName: string): string; +begin + result := fResult.Keys.Values[KeyName]; +end; + constructor TCommand.Create(aConnect: TBaseConnection; ASubClass: string); begin fconnect := AConnect; @@ -425,6 +393,5 @@ procedure TCommand.Log(ALevel: TLogLevel; msg: string); begin connect.log(ALevel,self, self.CommandID+#09+msg) end; - end. diff --git a/cgireport.pas b/cgireport.pas index 9bd0c0b..efa5341 100644 --- a/cgireport.pas +++ b/cgireport.pas @@ -29,11 +29,13 @@ 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 FillDefaults; end; implementation uses - cgiDM,reportDMUnit, types, strutils, LazUTF8; + cgiDM,reportDMUnit, types, strutils, LazUTF8,allreportsunit,commandcol; { TReportCommand } procedure TReportCommand.CreateVariablesTable; @@ -106,6 +108,13 @@ begin end; procedure TReportCommand.FillVars; +const + Q_varlist= + 'select coalesce(v1.name,v0.name) as name,coalesce(v1.query,v0.query) as query '+ + 'from xp_report_cgi c '+ + ' left join xp_report_variables v0 on v0.name=any(c.variables) and v0.xp_rpt_id=0 and v0.var_type=%1:d '+ + ' left join xp_report_variables v1 on v1.name=any(c.variables) and v1.xp_rpt_id=c.xp_rpt_id and v0.var_type=%1:d '+ + 'where c.xp_rpt_id=%0:d and coalesce(v1.query,v0.query,'''')<>'''' '; var ASQL: string; q: string; @@ -115,7 +124,7 @@ var 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)]); - ASQL := format('select name,query from xp_report_variables where xp_rpt_id=%d and var_type=0',[ReportID]); + ASQL := format(Q_varlist,[ReportID,0]); with connect.Processor.GetData(ASQL) do try while not eof do @@ -136,7 +145,7 @@ begin finally free; end; - ASQL := format('select name,query from xp_report_variables where xp_rpt_id=%d and var_type=1',[ReportID]); + ASQL := format(Q_varlist,[ReportID,1]); with connect.Processor.GetData(ASQL) do try while not eof do @@ -184,7 +193,7 @@ begin end; ReportTitle := connect.Processor.QueryValue(format('select r.name from xp_report_cgi g join xp_report r on r.xp_rpt_id=g.xp_rpt_id where cgi_name=%s',[TNidbDM.StringAsSQL(ReportName)])); CreateVariablesTable; - log(mtInfo,'Построение отчета '+ReportTitle); + log(mtInfo,'Построение отчета '+ReportTitle); connect.ReportProcessor.RecordID:=ReportID; fcurrentStage := 'исполняется (подготовка)'; try @@ -217,7 +226,7 @@ begin exit; end; end; - fResult := TCommandData.Create(0,fileData.size,ReportTitle+'.pdf',nil,[],fileData); + fResult := TCommandData.Create(0,fileData.size,ReportTitle+'.pdf',['type=application/pdf'],[],fileData); fileData.Seek(0,soFromBeginning); result := true; finally @@ -246,7 +255,7 @@ begin '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 not in (%s) '+ 'order by fill_order,p.name ', - [TNIDBDM.StringAsSQL(ReportName),TNIDBDM.StringAsSQL(ids)]); + [TNIDBDM.StringAsSQL(ReportName),(ids)]); with Connect.Processor.GetData(asql) do try if not eof then @@ -329,8 +338,80 @@ begin result := true; end; +procedure TReportCommand.EditTemplate; +begin + CreateVariablesTable; + log(mtInfo,'Построение отчета '+ReportTitle); + connect.ReportProcessor.RecordID:=ReportID; + fcurrentStage := 'исполняется (подготовка)'; + try + Prepare; + except on e: Exception do + begin + connect.Processor.LogError(self,e,'prepare'); + fResult := TCommandData.Create(ErrorInternal,0,'Ошибка составления',nil,[],nil); + exit; + end; + end; + fcurrentStage := 'исполняется (настройка)'; + try + FillVars; + PrepareVars; + except on e: Exception do + begin + connect.Processor.LogError(self,e,'vars'); + fResult := TCommandData.Create(ErrorInternal,0,'Ошибка составления',nil,[],nil); + exit; + end; + end; + fcurrentStage := 'исполняется ()'; + try + connect.ReportProcessor.EditReport(@OnFillVariables); + except on e: Exception do + begin + connect.Processor.LogError(self,e,'ExportReport'); + fResult := TCommandData.Create(ErrorInternal,0,'Ошибка составления',nil,[],nil); + exit; + end; + end; +end; + +procedure TReportCommand.FillDefaults; +var + asql: string; + l,e: TStrings; +begin + asql := format( + 'select name, '+ + 'case '+ + ' when type IN (1,2,3,6,17) then ''0'' '+ + ' when type=4 then ''2020-02-02'' '+ + ' when type=5 then ''2020-02-02 20:20:02'' '+ + ' when type=0 then '''' '+ + 'end as value '+ + 'from xp_report_params p '+ + 'where p.xp_rpt_id=%d ', + [ReportID]); + l := TStringList.Create; + try + l.add('name='+ReportName); + with Connect.Processor.GetData(asql) do + try + while not eof do + begin + l.Add(format('%s=%s',[fieldbyname('name').asString,fieldbyname('value').asString])); + Next; + end; + finally + free; + end; + ParseCommand(-1,0,ReportName,l,[],nil,e); + finally + l.free; + end; +end; + + -Initialization - TCommandCollection.Register(TReportCommand); end. diff --git a/commandcol.pas b/commandcol.pas new file mode 100644 index 0000000..6de91ec --- /dev/null +++ b/commandcol.pas @@ -0,0 +1,64 @@ +unit commandcol; + +{$mode ObjFPC}{$H+} + +interface + +uses + Classes, SysUtils,Contnrs,baseconnection; +type + { TCommandCollection } + TCommandCollection=Class; + TCommandCollection=Class(TClassList) + private + class var fCollection: TCommandCollection; + public + class procedure Register(ACommand: TCommandClass); + class function Find(Action,SubClass: string): TCommandClass; + class procedure Init; + class procedure Done; + end; + +implementation +{ TCommandCollection } + +class procedure TCommandCollection.Register(ACommand: TCommandClass); +begin + fCollection.Add(ACommand); +end; + +class function TCommandCollection.Find(Action, SubClass: string): TCommandClass; +var + i: integer; +begin + for i := 0 to fCollection.Count-1 do + if fCollection.Items[i].InheritsFrom(TCommand) and SameText(Action, TCommandClass(fCollection.Items[i]).CommandName) and SameText(SubClass, TCommandClass(fCollection.Items[i]).CommandSubClass) then + begin + result := TCommandClass(fCollection.Items[i]) ; + exit; + end; + for i := 0 to fCollection.Count-1 do + if fCollection.Items[i].InheritsFrom(TCommand) and SameText(Action, TCommandClass(fCollection.Items[i]).CommandName) and SameText('', TCommandClass(fCollection.Items[i]).CommandSubClass) then + begin + result := TCommandClass(fCollection.Items[i]) ; + exit; + end; + result := nil; +end; + +class procedure TCommandCollection.Init; +begin + fCollection := TCommandCollection.Create; +end; + +class procedure TCommandCollection.Done; +begin + fCollection.Free; +end; +initialization + TCommandCollection.Init; +finalization + TCommandCollection.Done; + +end. + diff --git a/connectionsdmunit.pas b/connectionsdmunit.pas index ca65bd5..9a3e315 100644 --- a/connectionsdmunit.pas +++ b/connectionsdmunit.pas @@ -45,12 +45,14 @@ type function ProcessReports(out rValues: TStrings): boolean; function ProcessOptionValues(ReportName,ParamName: string; ParamValues: TStrings; out Answer: string; out RetValue: QWORD; out OptionValues: TStrings): boolean; procedure LoadConfig; + public property DataHost: string read fDataHost; property DataPort: integer read fDataPort; property DataBase: string read fDataBase; property Logger: TEventLog read fLogger write fLogger; procedure Log(ALevel: TLogLevel; Sender: TObject; msg: string); + procedure InitBaseCon; procedure Start; procedure Stop; procedure Idle(Sender: TObject); @@ -59,6 +61,8 @@ type 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; constructor CreateWithLog(ALogger: TEventLog); + procedure FillTemplates(RepList: TStrings); + procedure EditTemplate(ReportID: integer); end; var @@ -66,7 +70,7 @@ var implementation uses - xpUtilUnit, strutils, xpAccessUnit, inifiles; + xpUtilUnit, strutils, xpAccessUnit, inifiles,commandcol, cgiReport; {$R *.lfm} @@ -338,6 +342,53 @@ begin inherited Create(nil); end; +procedure TConnectionsDM.FillTemplates(RepList: TStrings); +var + asql: string; +begin + asql := + 'select r.xp_rpt_id,r.name, c.cgi_name from xp_report r '+ + ' join xp_report_cgi c on c.xp_rpt_id=r.xp_rpt_id '+ + 'order by r.name '; + with MainCon.GetData(asql) do + try + while not eof do + begin + RepList.AddObject(format('%s (%s)',[fieldbyname('name').asString, FieldByName('cgi_name').asString]),TObject(ptrint(fieldbyname('xp_rpt_id').asInteger))); + next; + end; + finally + free; + end; +end; + +procedure TConnectionsDM.EditTemplate(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); + con := NewConnection; + try + cc := TCommandCollection.Find('report',RName); + cmd := cc.Create(con,RName) as TReportCommand; + try + cmd.ReportID := ReportID; + cmd.ReportName:=RName; + cmd.FillDefaults; + cmd.EditTemplate; + finally + cmd.free; + end; + finally + con.Free; + end; +end; + function TConnectionsDM.ProcessLogin(UserName, UserPassword: string; out UserID: integer): boolean; var ASQL: string; @@ -504,13 +555,17 @@ begin end; end; -procedure TConnectionsDM.Start; +procedure TConnectionsDM.InitBaseCon; begin MainCon.connection.RemoteHost:=DataHost; MainCon.connection.RemotePort:=DataPort; MainCon.connection.Database:=DataBase; MainCon.OpenConnection; - //Input.OnIdle:=@Idle; +end; + +procedure TConnectionsDM.Start; +begin + InitBaseCon;//Input.OnIdle:=@Idle; Input.Start; fRunning:=true; end; @@ -534,9 +589,5 @@ begin TBaseConnection(conList[i]).SetIdle; end; -initialization - TCommandCollection.Init; -finalization - TCommandCollection.Done; end. diff --git a/exttypes.pas b/exttypes.pas index 585d70d..981021f 100644 --- a/exttypes.pas +++ b/exttypes.pas @@ -43,8 +43,10 @@ type fReadReady,fWriteReady: TSimpleEvent; fClosed: boolean; cs: TCriticalSection; + fLogger: TLogger; + procedure log(msg: string); public - constructor Create(BufferSize: integer); + constructor Create(ALogger: TLogger; BufferSize: integer); destructor Destroy; override; function Push(const data; datasize: integer): integer; function Pop(var data; datasize: integer): integer; @@ -57,6 +59,9 @@ type property ReadReady: TSimpleEvent read fReadReady; property WriteReady: TSimpleEvent read fWriteReady; end; + + { TCommandData } + TCommandData=class Code:DWORD; Param:QWord; @@ -64,7 +69,8 @@ type Keys: TStrings; iValues: TParamArray; Data: TStream; - constructor Create(ACode:DWORD;AParam:QWord; AName: string; AKeys: TStrings; AValues: TParamArray; AData: TStream); + constructor Create(ACode:DWORD;AParam:QWord; AName: string; AKeys: TStrings; AValues: TParamArray; AData: TStream); overload; + constructor Create(ACode:DWORD;AParam:QWord; AName: string;const AKeys: Array of string; AValues: TParamArray; AData: TStream); overload; destructor Destroy; override; procedure AssignTo(out ACode:DWORD;out AParam:QWord; out AName: string; out AKeys: TStrings; out AValues: TParamArray; out AData: TStream); end; @@ -160,10 +166,15 @@ end; { TRoundBuffer } +procedure TRoundBuffer.log(msg: string); +begin + {$IFDEF DEBUG} if assigned(fLogger) then fLogger(mtExtra,self,msg); {$ENDIF} +end; -constructor TRoundBuffer.Create(BufferSize: integer); +constructor TRoundBuffer.Create(ALogger: TLogger; BufferSize: integer); begin inherited Create; + flogger := ALogger; cs := TCriticalSection.Create; SetLength(self.intdata,BufferSize); fSize:=BufferSize; @@ -203,6 +214,7 @@ begin fWriteReady.WaitFor(INFINITE); if fClosed then exit; delta := 0; + log(format('Push size=%d, R=%d, W=%d ',[fDataSize,ptrRead,ptrWrite])); while not fClosed and (rem>0) and (fDataSize+delta0) and (delta>0) do + delta := 0; + log(format('Pop size=%d, R=%d, W=%d ',[fDataSize,ptrRead,ptrWrite])); + while not fClosed and (rem>0) and (fDataSize-delta>0) do begin p^:=intData[i]; s := s + inttohex(intData[i],2)+' '; inc(p); i := (i+1) mod fSize; - dec(delta); + inc(delta); dec(rem); end; cs.Enter; ptrRead := i; - fDataSize:=delta; + dec(fDataSize,delta); if fDataSize=0 then + begin fReadReady.ResetEvent; + log('buffer empty'); + end; cs.Leave; - result := datasize-rem; + result := delta; + log(format('Pop %d bytes size=%d',[result,fDataSize])); fWriteReady.SetEvent; end; @@ -281,6 +303,7 @@ begin begin result := -1; fReadReady.SetEvent; + fWriteReady.SetEvent; end; end; @@ -384,6 +407,27 @@ begin Data := nil; end; +constructor TCommandData.Create(ACode: DWORD; AParam: QWord; AName: string; + const AKeys: array of string; AValues: TParamArray; AData: TStream); +var + l: TStrings; + i: integer; +begin + if length(AKeys)=0 then + Create(ACode,AParam,AName,nil,AValues,AData) + else + begin + l := TStringList.Create; + try + for i := low(AKeys) to high(AKeys) do + l.add(AKeys[i]); + Create(ACode,AParam,AName,l,AValues,AData) + finally + l.free; + end; + end; +end; + destructor TCommandData.Destroy; begin if assigned(Keys) then Keys.Free; diff --git a/lms_cgi.obj b/lms_cgi.obj new file mode 100644 index 0000000..839e54a Binary files /dev/null and b/lms_cgi.obj differ diff --git a/lmsreport.lpi b/lmsreport.lpi index 012abcb..96faebe 100644 --- a/lmsreport.lpi +++ b/lmsreport.lpi @@ -125,6 +125,18 @@ + + + + + + + + + + + + @@ -135,6 +147,7 @@ + diff --git a/lmsreport.lpr b/lmsreport.lpr index 78a3b0c..5bd04a5 100644 --- a/lmsreport.lpr +++ b/lmsreport.lpr @@ -10,9 +10,10 @@ uses athreads, {$ENDIF} Interfaces, // this includes the LCL widgetset - sysutils,Forms, abbrevia, lnetbase, MainTcpServer, tcpthreadhelper, reportDMUnit, - ConnectionsDmUnit, cgiDM, xpAccessUnit, extTypes, tcpserver, tcpClient, -cgiReport, cgiCommand, fr_utils, baseconnection + sysutils, Forms, abbrevia, lnetbase,commandcol,baseconnection, MainTcpServer, tcpthreadhelper, + reportDMUnit, ConnectionsDmUnit, cgiDM, xpAccessUnit, extTypes, tcpserver, + tcpClient, cgiReport, cgiCommand, fr_utils, applicantresult, + allreportsunit { you can add units after this }; {$R *.res} diff --git a/maintcpserver.lfm b/maintcpserver.lfm index 4e696b4..15dba4a 100644 --- a/maintcpserver.lfm +++ b/maintcpserver.lfm @@ -1,14 +1,14 @@ object CGIServerGUI: TCGIServerGUI Left = 333 - Height = 309 + Height = 566 Top = 224 Width = 870 Caption = 'Сервер отчетов LMS' - ClientHeight = 309 + ClientHeight = 566 ClientWidth = 870 OnCreate = FormCreate OnDestroy = FormDestroy - LCLVersion = '2.2.0.4' + LCLVersion = '2.2.4.0' object Panel1: TPanel Left = 0 Height = 50 @@ -40,19 +40,19 @@ object CGIServerGUI: TCGIServerGUI end object GroupBox1: TGroupBox Left = 0 - Height = 259 + Height = 246 Top = 50 Width = 368 Align = alLeft Caption = 'Запрос' - ClientHeight = 240 - ClientWidth = 366 + ClientHeight = 226 + ClientWidth = 364 TabOrder = 1 object Keys: TMemo Left = 0 - Height = 210 - 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' @@ -86,46 +86,46 @@ object CGIServerGUI: TCGIServerGUI end object GroupBox2: TGroupBox Left = 373 - Height = 259 + Height = 246 Top = 50 Width = 497 Align = alClient Caption = 'Ответ' - ClientHeight = 240 - 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 end object retValues: TMemo Left = 0 - Height = 75 - Top = 85 - Width = 495 + Height = 105 + Top = 71 + Width = 493 Align = alClient TabOrder = 1 end object intValues: TListBox Left = 0 - Height = 80 - Top = 160 - Width = 495 + Height = 50 + 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 @@ -133,15 +133,54 @@ object CGIServerGUI: TCGIServerGUI Left = 0 Height = 25 Top = 0 - Width = 495 + Width = 493 Align = alTop TabOrder = 4 end end object Splitter1: TSplitter Left = 368 - Height = 259 + Height = 246 Top = 50 Width = 5 end + object GroupBox3: TGroupBox + Left = 0 + Height = 270 + Top = 296 + Width = 870 + Align = alBottom + Caption = 'Шаблоны' + ClientHeight = 250 + ClientWidth = 866 + TabOrder = 4 + object ReportsPanel: TPanel + Left = 0 + Height = 50 + Top = 200 + Width = 866 + Align = alBottom + ClientHeight = 50 + ClientWidth = 866 + TabOrder = 0 + object EditTemplate: TButton + Left = 760 + Height = 25 + Top = 11 + Width = 100 + Caption = 'Шаблон' + OnClick = EditTemplateClick + TabOrder = 0 + end + end + object ReportsList: TListBox + Left = 0 + Height = 200 + Top = 0 + Width = 866 + Align = alClient + ItemHeight = 0 + TabOrder = 1 + end + end end diff --git a/maintcpserver.pas b/maintcpserver.pas index fa775cb..95be83e 100644 --- a/maintcpserver.pas +++ b/maintcpserver.pas @@ -17,12 +17,16 @@ type { TCGIServerGUI } TCGIServerGUI = class(TForm) + EditTemplate: TButton; edtAnswer: TEdit; edtQValue: TEdit; edtRequest: TComboBox; GroupBox1: TGroupBox; GroupBox2: TGroupBox; + GroupBox3: TGroupBox; intValues: TListBox; + ReportsList: TListBox; + ReportsPanel: TPanel; StatusPanel: TPanel; retValues: TMemo; Keys: TMemo; @@ -30,6 +34,7 @@ type Panel1: TPanel; Splitter1: TSplitter; StartButton: TButton; + procedure EditTemplateClick(Sender: TObject); procedure edtAnswerDblClick(Sender: TObject); procedure SendButtonClick(Sender: TObject); procedure StartButtonClick(Sender: TObject); @@ -66,11 +71,13 @@ uses procedure TCGIServerGUI.FormCreate(Sender: TObject); begin fLogger := TEventLog.Create(self); + fLogger.Active:=false; fLogger.LogType:=TLogType.ltFile; fLogger.FileName:=ChangeFileExt(paramstr(0),'.log'); flogger.Identification:='LMS-Report-Test'; - fLogger.Active:=false; fLogger.Active:=true; + flogger.Info('TCGIServerGUI.FormCreate'); + Server := TConnectionsDM.CreateWithLog(fLogger); ConnectionsDM := Server; cmdDone := true; @@ -98,10 +105,19 @@ begin Keys.Lines.Add('='+edtanswer.text); end; +procedure TCGIServerGUI.EditTemplateClick(Sender: TObject); +var + rID: integer; +begin + rID := PtrInt(ReportsList.Items.Objects[ReportsList.ItemIndex]); + Server.EditTemplate(rID); +end; + procedure TCGIServerGUI.StartButtonClick(Sender: TObject); begin Server.Start; + Server.FillTemplates(ReportsList.Items); started := true; Panel1.Caption := 'запущен'; SendButton.Enabled := true; @@ -169,7 +185,7 @@ begin if Assigned(Data) then begin Data.seek(0,soFromBeginning); - fs := TFileStream.Create(Answer,fmCreate); + fs := TFileStream.Create('out/'+Answer,fmCreate); try fs.CopyFrom(Data,Data.size); finally @@ -177,7 +193,7 @@ begin end; end; finally - Sender.Terminate; + Sender.SetComplete; cmdDone := true; end; diff --git a/reportdmunit.lfm b/reportdmunit.lfm index 0965e17..3335fab 100644 --- a/reportdmunit.lfm +++ b/reportdmunit.lfm @@ -91,4 +91,10 @@ object ReportDM: TReportDM Left = 180 Top = 86 end + object AbZipper1: TAbZipper + AutoSave = False + DOSMode = False + Left = 186 + Top = 155 + end end diff --git a/reportdmunit.pas b/reportdmunit.pas index 870d4e6..479c806 100644 --- a/reportdmunit.pas +++ b/reportdmunit.pas @@ -6,7 +6,7 @@ interface uses Classes, SysUtils, frxClass, frxExportPDF, frxExportODF, - xpMemParamManagerUnit, AbUnzper, frxDBSet, cgiDM,extTypes; + xpMemParamManagerUnit, AbUnzper, AbZipper, frxDBSet, cgiDM,extTypes; type TExportFileType = (ftPDF,ftRTF,ftXLS);//(ftPDF,ftMail,ftRTF,ftXLS,ftHTML); @@ -39,6 +39,7 @@ type TReportDM = class(TDataModule) AbUnZipper1: TAbUnZipper; + AbZipper1: TAbZipper; frxODSExport1: TfrxODSExport; frxODTExport1: TfrxODTExport; frxPDFExport1: TfrxPDFExport; @@ -80,12 +81,13 @@ type procedure LoadVariables(AVariables, AParam : TxpMemParamManager); procedure OnMasterRecord(Sender: TObject); procedure LoadReportTemplate(); + procedure SaveReportTemplate(); procedure CopyReportVariables(AVariables, AParam: TxpMemParamManager); public RecordID: integer; NidbData: TNIDBDM; procedure ExportReport( ExportType: TExportFileType; Data: TStream; OnStage: TLogger; OnVars: TVariableFillProc); - + procedure EditReport(OnVars: TVariableFillProc); end; var @@ -595,6 +597,28 @@ begin end; // try end; +procedure TReportDM.SaveReportTemplate; +var + ReportStream : TMemoryStream; + BlobStream : TStream; + ASQL: string; +begin + NidbData.log(mtDebug,self,'ExportReport.TemplateArh'); + ReportStream := TMemoryStream.Create; + BlobStream := TMemoryStream.Create; + try + frxReport.SaveToStream(ReportStream); + ReportStream.seek(0,soFromBeginning); + PackReport(ReportStream,BlobStream,AbZipper1); + ASQL := format('update xp_report set TemplateArh=%s where xp_rpt_id=%d',[TNIDBDM.StreamAsSQL(BlobStream),RecordID]); + NidbData.ExecuteSQL(ASQL); + finally + ReportStream.Free; + BlobStream.Free; + end; // try +end; + + procedure TReportDM.CopyReportVariables(AVariables, AParam: TxpMemParamManager); var i: integer; @@ -706,6 +730,53 @@ begin NidbData.log(mtDebug,self,'Report complete'); end; +procedure TReportDM.EditReport(OnVars: TVariableFillProc); +var + I : Integer; + flt : TfrxCustomExportFilter; + v : Variant; + AVariables, AParam: TxpMemParamManager; +begin + fOnVars:=OnVars; + frxReport.EngineOptions.EnableThreadSafe:=true; + NidbData.log(mtDebug,self,'EditReport'); + ReportQueries := TReportQuery.Create; + AVariables := TxpMemParamManager.Create; + AParam := TxpMemParamManager.Create; + try + LoadQueries; + LoadDefaultVariables(AVariables); + LoadLogos(AVariables); + LoadVariables(AVariables,AParam); + if assigned(fOnVars) then fOnVars(AVariables); + frxReport.EngineOptions.DestroyForms := False; + // Создаём источники данных + CreateDBDataSet(ReportQueries); + LoadReportTemplate; + CopyReportVariables(AVariables,AParam); + TxpFRFunctions.SetReport(NidbData,AVariables); + + try + frxReport.DesignReport; + if frxReport.Modified then + SaveReportTemplate(); + except on e: Exception do + begin + NidbData.logError(self,e,'frxReport.PrepareReport'); + raise; + end; + end; + + + finally + ReportQueries.Free; + AVariables.Free; + AParam.Free; + end; + NidbData.log(mtDebug,self,'Report complete'); +end; + + end. diff --git a/reports/allreportsunit.pas b/reports/allreportsunit.pas new file mode 100644 index 0000000..f10afed --- /dev/null +++ b/reports/allreportsunit.pas @@ -0,0 +1,16 @@ +unit allreportsunit; + +{$mode ObjFPC}{$H+} + +interface + +uses + Classes, SysUtils,commandcol; + +implementation +uses + cgiReport,applicantlist,applicantresult; +initialization +TCommandCollection.Register(TReportCommand); +end. + diff --git a/reports/applicantlist.pas b/reports/applicantlist.pas index 58ee617..8ee657f 100644 --- a/reports/applicantlist.pas +++ b/reports/applicantlist.pas @@ -23,7 +23,7 @@ type implementation uses - cgiDM,dateutils,baseconnection; + cgiDM,dateutils,commandcol; { TRepApplicantList } class function TRepApplicantList.CommandSubClass: string; diff --git a/reports/applicantresult.pas b/reports/applicantresult.pas new file mode 100644 index 0000000..6324c1a --- /dev/null +++ b/reports/applicantresult.pas @@ -0,0 +1,455 @@ +unit applicantresult; + +{$mode ObjFPC}{$H+} + +interface + +uses + Classes, SysUtils, cgiReport,xpMemParamManagerUnit; +const + ApplicantExtraParamCnt=4; + ApplicantExtraFields: array[1..ApplicantExtraParamCnt] of string = ('tabel_mode','olympic_mode','portfolio_mode','techno_mode'); +type + + { TRepApplicantList } + + { TRepApplicantResult } + + TRepApplicantResult=class(TReportCommand) + private + edtMode: integer; + cbStream: integer; + idYear: integer; + ColNames: array[1..12] of string; + ColCount: integer; + function MakeCols(): string; + function UpdateEnrollStatus(): integer; + public + class function CommandSubClass: string; override; + procedure Prepare; override; + procedure OnFillVariables(AVariables: TxpMemParamManager); override; + end; + +implementation +uses + cgiDM,dateutils,commandcol; + +{ TRepApplicantResult } + +function TRepApplicantResult.MakeCols: string; +var + SQL: string; + i,j: integer; + exams: string; + l: TStrings; +begin + exams := ''; + for i := 1 to 6 do + exams := exams + format( + 'UNION SELECT COALESCE(NULLIF(Exam%0:dColName,''''),EnterExam%0:dName) as ExamName, coalesce(d.sorting, %0:d) as sorting '+ + 'FROM applicant_group g '+ + ' LEFT JOIN (SELECT d.school_year, COALESCE(d.stream,0) as stream, l.name as exam_name, d.sorting,d.kurs '+ + ' FROM enroll_disciplines d '+ + ' JOIN lessons l ON l.lid=d.lid '+ + ' WHERE d.school_year=%1:d AND COALESCE(d.stream,0)=%2:d '+ + ' ) d ON d.school_year=g.school_year AND d.stream=COALESCE(g.stream) AND d.exam_name=g.EnterExam%0:dName '+ + 'WHERE g.school_year=%1:d AND (%2:d=COALESCE(g.stream,0)) '+ + 'AND NULLIF(EnterExam%0:dName,'''') IS NOT NULL '+ + 'AND EXISTS (SELECT 1 FROM xp_applicant a WHERE a.applicant_group=g.id AND a.Child_Class=coalesce(d.kurs,a.Child_Class) ) ', + [i,idYear,cbStream]); + SQL := format( + 'DROP TABLE IF EXISTS tmpExams; '+ + 'CREATE TEMPORARY TABLE tmpExams AS '+ + 'SELECT trim(t.ExamName) as ExamName, COALESCE(NULLIF(FIND_IN_SET(trim(t.ExamName),''Русский язык,Математика,Иностранный язык''),0),min(t.sorting)+6 ) as sorting FROM ( '+ + ' SELECT '''' as ExamName, 0 as sorting '+ + ' %2:s '+ + ' ) t '+ + 'WHERE t.sorting>0 '+ + 'GROUP BY t.ExamName; ', + [idYear,cbStream,Exams]); + connect.processor.ExecuteSQL(SQL); + + ColCount := 0; + with connect.processor.getData('SELECT ExamName,sorting FROM tmpExams ORDER BY sorting,ExamName ') do + try + while not eof and (ColCount<8) do + begin + if (pos('физ',AnsiLowerCase(FieldByName('ExamName').AsString))=0) or (pos('физика',AnsiLowerCase(FieldByName('ExamName').AsString))>0) then + begin + inc(ColCount); + ColNames[ColCount] := FieldByName('ExamName').AsString; + end; + Next; + end; + finally + Free; + end; + result := ''; + for I := 1 to ColCount do + begin + result := result + 'CASE '; + for j := 1 to 6 do + result := result + format( + ' WHEN a1.Col%0:d = %1:s THEN a1.Grade%0:d ', + [j,TNIDBDM.StringAsSQL(ColNames[i])]); + result := result + format(' ELSE NULL END AS Exam%d, ',[i]); + end; + for I := ColCount+1 to 12 do + begin + result := result+ Format('NULL AS Exam%d, ',[i]); + end; +end; + + +function TRepApplicantResult.UpdateEnrollStatus: integer; +var + SQL: string; + separate_enroll: boolean; + Z2: string; + ColSorter: string; + I,j: Integer; + SParts: array[1..10] of string; + DateFilter: string; + FS:TStrings; +begin + DateFilter := ''; + if cbStream > 0 then + DateFilter := ' AND cast(a1.Date as DATE) BETWEEN %10:s AND %11:s '; + + for i := 1 to 10 do + sParts[i] := ''; + for i := 1 to 8 do + begin + sParts[1] := sParts[1] + format( + '+IF(COALESCE(ep.psycho_mode%0:d,0)>=0,gradevalue((COALESCE(ep.psycho_mode%0:d,0)+1)*a1.EnterTest%0:dGrade,0),0)',[i]); + sParts[6] := sParts[6] + format(' and case coalesce(ep.psycho_mode%0:d,0) '+ + 'when -3 then true '+ + 'when -2 then coalesce(a1.EnterTest%0:dGrade,'''')=''да'' '+ + 'when -1 then coalesce(a1.EnterTest%0:dGrade,'''')=''нет'' '+ + 'else ROUND(10000*coalesce(a1.EnterTest%0:dGrade,0))>=ROUND(10000*coalesce(ep.psycho_pass%0:d,ep.psycho_min%0:d,-10)) '+ + 'end ', + [i]); + sParts[8] := sParts[8] + format( + ', IF( ep.psycho_mode%0:d=-1 AND coalesce(a1.EnterTest%0:dGrade,'''')<>''нет'',ep.psycho_name%0:d,null) ',[i]); + sParts[8] := sParts[8] + format( + ', IF( ep.psycho_mode%0:d=-2 AND coalesce(a1.EnterTest%0:dGrade,'''')<>''да'',concat(''не пройден тест: ('',ep.psycho_name%0:d,'')''),null) ',[i]); + sParts[8] := sParts[8] + format( + ', IF( ep.psycho_mode%0:d in (0,1,2,3,4,5,6,7) '+ + ' AND ROUND(10000*coalesce(a1.EnterTest%0:dGrade,0))= coalesce(g.Pass%0:dGrade,0),false) or NULLIF(a1.EnterExam%0:dName,'''') IS NULL) ',[i]); + sParts[5] := sParts[5] + format( + ' and coalesce(a1.EnterExam%0:dGrade NOT LIKE ''н%%'',true) ',[i]); + + sParts[7] := sParts[7] + format( + ', IF (NULLIF(a1.EnterExam%0:dName,'''') IS NOT NULL '+ + ' AND (coalesce(gradevalue(a1.EnterExam%0:dGrade,1)< coalesce(g.Pass%0:dGrade,0),false) '+ + ' OR coalesce(a1.EnterExam%0:dGrade LIKE ''незачет%%'',false)),a1.EnterExam%0:dName,null) ',[i]); + + end; + end; + + SParts[9] := 'true and (coalesce(gradevalue(a1.EnterExam1Grade,1)>=coalesce(g.Pass1Grade,0),false) '+ + 'or coalesce(gradevalue(a1.EnterExam2Grade,1)>=coalesce(g.Pass2Grade,0),false) '+ + 'or coalesce(gradevalue(a1.EnterExam3Grade,1)>=coalesce(g.Pass3Grade,0),false) '+ + 'or coalesce(gradevalue(a1.EnterExam4Grade,1)>=coalesce(g.Pass4Grade,0),false) '+ + 'or coalesce(gradevalue(a1.EnterExam5Grade,1)>=coalesce(g.Pass5Grade,0),false) '+ + 'or coalesce(gradevalue(a1.EnterExam6Grade,1)>=coalesce(g.Pass6Grade,0),false)) '; + + SQL := format( + 'DROP TABLE IF EXISTS tmp_rpt_applicant_us; '+ + 'CREATE TEMPORARY TABLE tmp_rpt_applicant_us AS '+ + 'SELECT '+ + ' a.xp_key, '+ + ' a.s_year_id, '+ + ' a.trajectory, '+ + ' subj.Subject, '+ + ' CONCAT_WS('' '',UPPER(a.Child_LastName),a.Child_FirstName,a.Child_MidName) AS FIO, '+ + ' a.Child_Birth, '+ + ' a.Child_Class, '+ + ' CASE WHEN a.testready<>0 and coalesce(a.scr_fail,0) = 0 THEN ''годен'' ELSE ''не годен'' END AS isready, '+ + ' COALESCE(a.coeff,1) as coeff, '+ + ' a.sex, '+ + ' COALESCE(NULLIF(a2.Privilege,''''),''нет'') as Privilege , '+ + ' a2.Priv_Count, a2.priv_super, a2.Priv_M > 0 and priv_with_exam and a2.TestPassed and a.testready as priv_m, '+ + ' a.scr_fail, '+ + ' a2.Grade_RUS, '+ + ' a2.Grade_MATH, '+ + ' a2.Grade_INO, '+ + ' a2.Grade_PHYS, '+ + ' CASE WHEN COALESCE(ep.psychomode,0)=0 THEN '+ + ' ROUND(a2.psycho_grade,2) '+ + ' ELSE CASE WHEN a.Psychologist<>0 THEN ''Зачет'' ELSE ''Незачет'' END '+ + ' END as Psycho, '+ + + ' a.applicant_status_id NOT IN (5,8) '+ + ' AND COALESCE(a.scr_fail,0)=0 '+ + ' AND ( a2.ExamPassed AND a2.TestPassed '+ + ' AND (COALESCE(ep.psychomode,0)=0 AND ROUND(10000*a2.Psycho_grade)>=ROUND(10000*coalesce(ep.psycho_pass,0)) OR a.Psychologist<>0 AND ep.psychomode<>0) '+ + ' OR a2.Priv_super<>0 OR (a2.priv_m > 0 and priv_with_exam AND a2.TestPassed and a.testready)) '+ + 'as ExamOK, '+ + ' calc_applicant_ball(a.xp_key) AS Ball, '+ + ' calc_applicant_ball_priv_m(a.xp_key) as Ball_m, '+ + ' CASE '+ + ' WHEN a.absent <> 0 THEN CASE a.Sex WHEN ''женский'' THEN ''не явилась'' ELSE ''не явился'' END '+ + ' WHEN a.scr_fail <> 0 THEN a.screening '+ + ' WHEN a.applicant_status_id = 5 THEN ''Отказано'' '+ + ' WHEN a.applicant_status_id = 8 THEN ''Отказ от обучения'' '+ + ' WHEN a2.priv_super>0 THEN '''' '+ + ' WHEN a2.priv_m > 0 THEN TRIM(CONCAT(IF(COALESCE(ep.psychomode,0)=0 AND ROUND(10000*a2.Psycho_grade)0,''Не рекомендуется к обучению по результатам психологического отбора'', ''''), ' + + ' CASE WHEN LOCATE(''физическая культура'', a2.FailedExams) > 0 THEN '' Не сданы: физическая культура'' ELSE '''' END)) '+ + ' WHEN nd.errors<>'''' THEN nd.errors '+ + ' WHEN NOT a2.TestPassed or NOT a2.ExamPassed '+ + ' or COALESCE(ep.psychomode,0)=0 AND ROUND(10000*a2.Psycho_grade)0 '+ + ' THEN CONCAT_WS('',\n '','+ + ' IF (COALESCE(ep.psychomode,0)=0 AND ROUND(10000*a2.Psycho_grade)0,''Не рекомендуется к обучению по результатам психологического отбора'',NULL), '+ + ' IF(NOT a2.TestPassed AND a2.Priv_super=0, a2.FailedTests,NULL), '+ + ' IF(NOT a2.ExamPassed AND a2.Priv_super=0, CONCAT(''Не сданы: \n'',a2.FailedExams),NULL)'+ + ' ) '+ + ' END AS Prim, '+ + ' a2.FailedExams, a2.FailedTests, a2.ExamPassed,a2.TestPassed, '+ + ' CASE WHEN a.absent<>0 THEN 1 ELSE 0 END as absent, '+ + ' a2.col1,a2.col2,a2.col3,a2.col4,a2.col5,a2.col6, '+ + ' a2.grade1,a2.grade2,a2.grade3,a2.grade4,a2.grade5,a2.grade6 '+ + 'FROM ( '+ + ' SELECT a1.xp_key, '+ + ' GROUP_CONCAT(distinct CASE '+ + ' WHEN np.code = ''Л'' THEN ''Указ Президента РФ от 09.05.2022 г. №268 п.3/ч.1.'' '+ + ' WHEN np.code = ''Л1'' THEN ''Указ Президента РФ от 09.05.2022 г. №268 п.3/ч.2.'' '+ + ' WHEN np.code = ''М'' THEN ''Федеральный закон от 29 декабря 2022 года «641-ФЗ, статья 86, часть 6.1'' '+ + ' WHEN np.code IS NOT NULL THEN priv.PrivilegeCode '+ + ' ELSE priv.PrivilegeName END order by priv.PrivilegeCode SEPARATOR '', '') AS Privilege, '+ + ' COUNT(priv.PrivilegeCode) AS Priv_Count, '+ + ' SUM(if(np.code in ( ''Л''),1, 0) ) AS Priv_super, '+ + ' SUM(if(np.code in (''М''),1,0)) as Priv_M, '+ + ' get_applicant_grade(a1.xp_key,''%%русский%%'','''') AS Grade_RUS, '+ + ' get_applicant_grade(a1.xp_key,''%%математика%%'','''') AS Grade_MATH, '+ + ' get_applicant_grade(a1.xp_key,''%%язык%%'',''%%русский%%'') AS Grade_INO, '+ + ' get_applicant_grade(a1.xp_key,''%%физ%%'',''физика'') AS Grade_PHYS, '+ + ' %3:s '+ + ' %4:s '+ + ' (0.0 %2:s )/COALESCE(ep.psycho_denom,5) as Psycho_grade, '+ + ' (TRUE %5:s %6:s) as ExamPassed, '+ + ' (TRUE %7:s ) as TestPassed, '+ + ' %12:s as priv_with_exam, '+ + + ' CONCAT_WS('', '' %8:s ) as FailedExams, '+ + ' CONCAT_WS('', '' %9:s ) as FailedTests '+ + ' FROM xp_applicant a1 '+ + ' LEFT JOIN xp_applicant_file_privilege priv ON priv.mid=a1.xp_key AND priv.PrivilegeCode <> ''-'' '+ + ' LEFT JOIN c_privilege np ON np.code=priv.PrivilegeCode '+ + ' JOIN applicant_group g ON g.id=a1.applicant_group '+ + ' LEFT JOIN enroll_params ep ON ep.school_year=a1.s_year_id '+ + ' WHERE a1.s_year_id=%0:d AND a1.Child_Class>0 AND a1.testready <> 0 AND applicant_status_id <> 4 '+ + ' AND (%1:d=COALESCE(a1.stream,0)) '+ + DateFilter + + ' GROUP BY a1.xp_key '+ + ') a2 '+ + ' JOIN xp_applicant a ON a.xp_key = a2.xp_key '+ + ' LEFT JOIN enroll_params ep ON ep.school_year=a.s_year_id '+ + ' LEFT JOIN tmp_rpt_problems nd ON nd.xp_key=a.xp_key '+ + ' LEFT JOIN xp_subjects subj ON subj.Subject = a.Subject; ', + [idyear,cbStream, + sParts[1], + sParts[2], + sParts[3], + sParts[4], + sParts[5], + sParts[6], + sParts[7], + sParts[8], + TNIDBDM.StringAsSQL(Arguments.Keys.Values['fromdate']), + TNIDBDM.StringAsSQL(Arguments.Keys.Values['todate']), + sParts[9]]); +// FS:= TstringList.create; +// fs.Add(sql); +// fs.SaveToFile('sqlappldebug.sql'); + //xpInformation(sql); + connect.processor.ExecuteSQL(SQL); + + colSorter := MakeCols(); + SQL := format( + 'DROP TABLE IF EXISTS tmp_rpt_applicant; '+ + 'CREATE TEMPORARY TABLE tmp_rpt_applicant AS '+ + ' SELECT a1.*, e.places, e.places_male, e.places_female, '+ + ColSorter+ + 'CASE '+ + ' WHEN COALESCE(a1.absent,0)=0 THEN ' + + ' CASE ' + + ' WHEN a1.undefined<>'''' THEN 5 '+ + ' WHEN NOT ExamOK AND priv_super=0 THEN 3 '+ + ' WHEN (a1.row<=a1.place_limit) THEN 0 '+ + + ' ELSE 3 ' + + ' END ' + + ' ELSE 4 ' + + 'END as GroupID ' + + ' FROM ( '+ + ' SELECT t.*, '+ + ' CASE '+ + ' WHEN @kurs=t.Child_Class AND @gender=t.gender AND @track=t.track THEN @row := @row+1 '+ + ' ELSE @row := 1 '+ + ' END as row, '+ + ' @kurs := t.Child_Class, @gender := t.gender, @track := t.track '+ + ' FROM '+ + ' (SELECT @row:=-1 as row, @kurs:=-1 as i_kurs, @gender:=-1 as i_gender, @track:=-1 as i_track ) init, '+ + ' (SELECT '+ +' CASE '+ +' WHEN et.places>0 THEN et.places '+ +' WHEN e.places_female>0 AND a.Sex=''женский'' THEN e.places_female '+ +' WHEN e.places_male>0 AND a.Sex=''мужской'' THEN e.places_male '+ +' ELSE e.places '+ +' END as place_limit, '+ + ' CASE '+ + ' WHEN a.sex=''женский'' AND e.places_female>0 THEN 2 '+ + ' WHEN a.Sex=''мужской'' AND e.places_male>0 THEN 1 '+ + ' ELSE 0 '+ + ' END as gender, '+ + ' CASE '+ + ' WHEN et.trajectory>0 THEN a.trajectory '+ + ' ELSE 0 '+ + ' END as track, '+ + ' a.*,nd.errors as undefined '+ + ' from tmp_rpt_applicant_us a '+ + ' join xp_enroll e ON e.school_year=%0:d and e.kurs=a.child_class AND e.trajectory=0 AND e.places>0 '+ + ' and (e.places_female>0 and a.Sex=''женский'' OR e.places_male>0 and a.Sex=''мужской'' OR e.places_female IS NULL AND e.places_male IS NULL) '+ + ' LEFT JOIN xp_enroll et ON et.school_year=%0:d AND et.kurs=a.Child_Class AND et.trajectory=a.trajectory '+ + ' LEFT JOIN tmp_rpt_problems nd ON nd.xp_key=a.xp_key '+ + ' WHERE 1=1 '+ + ' AND (et.trajectory>0 OR NOT EXISTS (SELECT 1 FROM xp_enroll WHERE school_year=a.s_year_id AND kurs=a.Child_Class AND trajectory>0)) '+ + ' ORDER BY a.Child_Class,COALESCE(a.scr_fail,0), absent,IF(nd.errors<>'''',1,0),gender,'+ + ' track,priv_super desc,a.priv_m desc, case when a.priv_m > 0 then a.Ball_m else 0 end desc,ExamOK DESC, ball desc ,case a.Priv_Count when 0 then 1 else 0 end, a.fio '+ + ' ) t '+ + { + ' SELECT IF(Child_Class<>@class OR use_sex AND sex <> @sex,@i:=1,@i:=@i+1) as Row, '+ + ' (@class:=Child_Class) as ClassCopy,(@sex:=sex) as SexCopy, a.* '+ + ' FROM (SELECT u.*,(e.places_male IS NOT NULL OR e.places_female IS NOT NULL) as use_sex,nd.errors as undefined '+ + ' FROM tmp_rpt_applicant_us u '+ + ' LEFT JOIN xp_enroll e ON e.kurs=u.Child_Class AND e.school_year=u.s_year_id '+ + ' LEFT JOIN tmp_rpt_problems nd ON nd.xp_key=u.xp_key '+ + ' ORDER BY Child_Class,absent,ExamOK DESC,IF(nd.errors<>'''',1,0), '+ + ' CASE WHEN e.places_male IS NOT NULL OR e.places_female IS NOT NULL THEN Sex ELSE 0 END, '+ + ' coalesce(Ball,0) DESC, CASE COALESCE(Priv_Count,0) WHEN 0 THEN 0 ELSE 1 END DESC, fio) a, '+ + ' (select @i:=0,@class:=null,@sex:=null) as z '+ } + ' ) a1 '+ + //' LEFT JOIN tmp_rpt_problems nd ON nd.xp_key=a1.xp_key '+ + ' LEFT JOIN xp_enroll e ON e.kurs=a1.Child_Class AND e.school_year=%0:d AND e.trajectory=0; '{+ + ' LEFT JOIN tmpExams e1 ON e1.ExamName = a1.Col1 '+ + ' LEFT JOIN tmpExams e2 ON e2.ExamName = a1.Col2 '+ + ' LEFT JOIN tmpExams e3 ON e3.ExamName = a1.Col3 '+ + ' LEFT JOIN tmpExams e4 ON e4.ExamName = a1.Col4 '+ + ' LEFT JOIN tmpExams e5 ON e5.ExamName = a1.Col5 '+ + ' LEFT JOIN tmpExams e6 ON e6.ExamName = a1.Col6 '}, + [idYear]); + //xpInformation(sql); + connect.processor.ExecuteSQL(SQL); + + SQL := + 'UPDATE xp_applicant a '+ + ' JOIN tmp_rpt_applicant r ON r.xp_key = a.xp_key '+ + 'SET a.passed = null, a.ball = null; '; + connect.processor.ExecuteSQL(SQL); + SQL := + 'UPDATE xp_applicant a '+ + ' JOIN tmp_rpt_applicant r ON r.xp_key = a.xp_key '+ + 'SET a.passed = r.GroupID IN (0,1,2), a.ball = r.ball; '; + connect.processor.ExecuteSQL(SQL); + + result := colcount; +end; + + +class function TRepApplicantResult.CommandSubClass: string; +begin + Result:='applicant_results'; +end; + +procedure TRepApplicantResult.Prepare; +var + SQL: string; +begin + inherited Prepare; + idYear := getInt('year'); + cbStream := getInt('stream'); + UpdateEnrollStatus(); + SQL := format( + 'DROP TABLE IF EXISTS tmp_members; '+ + 'CREATE TEMPORARY TABLE tmp_members AS '+ + ' SELECT xp_f_get_mid_fio(m.mid,0) as member FROM enroll_comitet c '+ + ' 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); +end; + +procedure TRepApplicantResult.OnFillVariables(AVariables: TxpMemParamManager); +var + i: integer; + ColSorter: string; + SQL: string; + extra_params: array [1..ApplicantExtraParamCnt] of boolean; + Z2: string; + separate_enroll: boolean; + +begin + ColSorter:=''; + for I := 1 to ColCount do + AVariables['Grade'+inttostr(i)] := (ColNames[i]); + for I := ColCount+1 to 12 do + begin + ColSorter := ColSorter+ Format('NULL AS Exam%d, ',[i]); + AVariables['Grade'+inttostr(i)] := (''); + 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; + 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 + AVariables['rpt_ready'] := 'ПРЕДВАРИТЕЛЬНЫЕ'#13#10'результаты' + else + AVariables['rpt_ready'] := ('Результаты'); + SQL := format( + '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 + try + if Not eof then + begin + AVariables['Председатель'] := (FieldByName('Chairman').AsString); + AVariables['Заместитель'] := (FieldByName('Deputy').AsString); + Z2 := FieldByName('Deputy2').AsString; + AVariables['Секретарь'] := (FieldByName('Secretary').AsString); + end + else + begin + AVariables['Председатель'] := (''); + AVariables['Заместитель'] := (''); + Z2 := ''; + AVariables['Секретарь'] := (''); + end; + AVariables['Заместитель2'] := (Z2); + if Z2<>'' then AVariables['zam2'] := 1 else AVariables['zam2'] := 0; + finally + Free; + end; + //Variables['Year'] := YearOf(Date); + AVariables['Year'] := connect.processor.QueryValue('SELECT YEAR(begdate) FROM school_year WHERE xp_key = ' + inttostr(idyear)); + +end; +Initialization + TCommandCollection.Register(TRepApplicantResult); + +end. + diff --git a/tcpclient.pas b/tcpclient.pas index 7c4d7c3..47cb239 100644 --- a/tcpclient.pas +++ b/tcpclient.pas @@ -48,7 +48,8 @@ implementation procedure TClientMainThread.SynchAnswer; begin - fOnComplete(self,fmode,fResult.code,fResult.Param,fResult.Name,fResult.Keys,fResult.iValues,fResult.Data); + if assigned(fOnComplete) then + fOnComplete(self,fmode,fResult.code,fResult.Param,fResult.Name,fResult.Keys,fResult.iValues,fResult.Data); end; constructor TClientMainThread.Create(ACommand: string; AFields: TStrings; @@ -73,16 +74,18 @@ begin inherited Destroy; end; + procedure TClientMainThread.execute; begin doStart; log(mtExtra, self,'start main thread'); Connect.Connect(Host,Port); - while not terminated do + while not terminated and not Complete do begin Connect.CallAction; sleep(10); end; + TerminateClients; Connect.Disconnect(); log(mtExtra, self,'terminated'); end; diff --git a/tcpserver.pas b/tcpserver.pas index 031bd25..05f8ce0 100644 --- a/tcpserver.pas +++ b/tcpserver.pas @@ -64,7 +64,7 @@ begin log(mtExtra,self,'start main thread'); Connect.Listen(Port); n := 0; - while not terminated do + while not terminated and not Complete do begin try Connect.CallAction; @@ -81,6 +81,7 @@ begin end; inc(n); end; + TerminateClients; end; constructor TServerMainThread.Create(ALogger: TLogger; APort: integer; diff --git a/tcpthreadhelper.pas b/tcpthreadhelper.pas index 10b716e..8cbe5b3 100644 --- a/tcpthreadhelper.pas +++ b/tcpthreadhelper.pas @@ -86,11 +86,15 @@ type flogger: TLogger; fThreadClass: TConnectionThreadClass; fStarted:boolean; + fComplete: boolean; + function getThread(index: TLSocket): TConnectionThread; - procedure TerminateClients; + protected procedure Log(ALevel: TLogLevel; Sender:TObject; msg: string); procedure doStart; virtual; + procedure TerminateClients; + property Complete: boolean read fComplete; public property Port: integer read fPort; property Connect: TLTCP read fCon; @@ -106,6 +110,8 @@ type procedure NetError(const msg: string; aSocket: TLSocket); constructor Create(AThreadClass: TConnectionThreadClass; ALogger: TLogger; APort: integer); destructor Destroy; override; + procedure SetComplete; + end; @@ -127,11 +133,11 @@ begin if TConnectionThread(fclients[i]).Socket=index then begin result := TConnectionThread(fclients[i]); - log(mtDebug,self,format('getThread(%d) %s',[index.Handle,guidToString(result.ID)])); + log(mtExtra,self,format('getThread(%d) %s',[index.Handle,guidToString(result.ID)])); exit; end; result := fThreadClass.Create(self,index); - log(mtDebug,self,format('new Thread(%d) %s',[index.Handle,guidToString(result.ID)])); + log(mtExtra,self,format('new Thread(%d) %s',[index.Handle,guidToString(result.ID)])); fclients.Add(Result); end; @@ -141,13 +147,13 @@ var i: integer; clt: TConnectionThread; begin - log(mtDebug,Self,'Terminate Clients'); + log(mtExtra,Self,'Terminate Clients'); for i := fclients.Count-1 downto 0 do begin sleep(0); clt := TConnectionThread(fclients[i]); try - log(mtDebug,self,GuidToString(clt.ID)); + log(mtExtra,self,GuidToString(clt.ID)); clt.Terminate; clt.WaitFor; clt.free; @@ -170,6 +176,7 @@ end; procedure TMainThread.doStart; begin fStarted := true; + fComplete:=false; end; procedure TMainThread.RemoveClient(clt: TConnectionThread); @@ -182,7 +189,7 @@ procedure TMainThread.dataReady(aSocket: TLSocket); var clt: TConnectionThread; begin - log(mtDebug,self,'dataReady'); + log(mtExtra,self,'dataReady'); if Terminated then exit; clt := Client[aSocket]; @@ -207,10 +214,10 @@ procedure TMainThread.Accept(aSocket: TLSocket); var clt: TConnectionThread; begin - log(mtDebug,self,'connect'); + log(mtExtra,self,'connect'); if Terminated then exit; clt := Client[aSocket]; - log(mtDebug,self,format('connected %s on %d ',[GUIDToString(clt.ID), aSocket.Handle])); + log(mtExtra,self,format('connected %s on %d ',[GUIDToString(clt.ID), aSocket.Handle])); ProcessAccept(clt); clt.start; @@ -221,11 +228,11 @@ var clt: TConnectionThread; begin if terminated then exit; - log(mtDebug,self,'disconnect'); + log(mtExtra,self,'disconnect'); try clt := Client[aSocket]; if clt.terminated then exit; - log(mtDebug,self,format('disconnected %s on %d ',[GUIDToString(clt.ID), aSocket.Handle])); + log(mtExtra,self,format('disconnected %s on %d ',[GUIDToString(clt.ID), aSocket.Handle])); clt.Terminate; fclients.remove(clt); @@ -241,10 +248,10 @@ procedure TMainThread.doConnect(aSocket: TLSocket); var clt: TConnectionThread; begin - log(mtDebug,self,'doConnect'); + log(mtExtra,self,'doConnect'); if Terminated then exit; clt := Client[aSocket]; - log(mtDebug,self,format('connected %s on %d ',[GUIDToString(clt.ID), aSocket.Handle])); + log(mtExtra,self,format('connected %s on %d ',[GUIDToString(clt.ID), aSocket.Handle])); ProcessConnect(clt); clt.Start; end; @@ -252,8 +259,7 @@ end; procedure TMainThread.TerminatedSet; begin inherited TerminatedSet(); - if fStarted then - TerminateClients; + end; @@ -281,7 +287,7 @@ begin Connect.OnDisconnect:=@doDisconnect; Connect.OnReceive:=@dataReady; Connect.Timeout:=100; - log(mtDebug,self,'create main thread'); + log(mtExtra,self,'create main thread'); end; destructor TMainThread.Destroy; @@ -291,6 +297,11 @@ begin Inherited Destroy; end; +procedure TMainThread.SetComplete; +begin + fComplete:=true; +end; + { TConnectionThread } @@ -592,7 +603,7 @@ var begin log(mtExtra,'Send buffer '+inttostr(len)); try - rem := len+Sizeof(integer)+Sizeof(QWord); + rem := len+Sizeof(dword)+Sizeof(QWord); p := GetMem(rem); try t := p; @@ -631,13 +642,25 @@ var part_id: QWORD; begin result := false; - if Terminated then exit; + if Terminated then + begin + log(mtExtra,'ReceiveBuffer terminated'); + exit; + end; try Cache.Read(part_id); - if Part_id<>PacketStart then exit; + if Part_id<>PacketStart then + begin + log(mtError,'ReceiveBuffer PacketStart '+inttohex(part_id,16)); + exit; + end; Cache.Read(len); - if len=0 then exit; setlength(Buffer,len); + if len=0 then + begin + log(mtError,'ReceiveBuffer Length=0'); + exit; + end; rem := len; p := PByte(Buffer); repeat @@ -740,6 +763,8 @@ procedure TConnectionThread.SendMessage(const mode: byte; const CommandID: DWORD; const QParam: QWord; const AValue: string; const AKeys: TStrings; const IntData: TParamArray; const AData: TStream); begin + + try if assigned(AKeys) and assigned(AData) and (length(IntData)>0) then begin SendHeader(7,mode,CommandID,QParam,AValue); @@ -782,6 +807,13 @@ begin end else SendHeader(0,mode,CommandID,QParam,AValue); + + except on E:exception do + begin + log(mtError,format('send error(%s) %s',[e.classname,e.message])); + raise; + end; + end; end; @@ -796,6 +828,7 @@ var footer: dWORD; begin try + log(mtExtra,'Send Stream '+inttostr(Data.Size)); setLength(Buffer,1+Data.Size+8); pos := 0; AddToBuffer(part,Buffer,pos); @@ -815,6 +848,7 @@ var pos: integer; footer: dWORD; begin + log(mtExtra,'Send Buffer '+inttostr(length(Data))); try setLength(Buffer,length(Data)+4+1); pos := 0; @@ -837,6 +871,7 @@ var len,i: integer; begin try + log(mtExtra,'Send Strings'); LogStrings(mtExtra,fOwner.flogger,self,'KEYS',Data); len := 1+4+8*Data.Count; for i:=0 to Data.Count-1 do @@ -869,6 +904,7 @@ var Buffer: TBuffer; begin len := length(Data); + log(mtExtra,'Send ParamArray '+inttostr(length(Data))); InitBuffer(Sizeof(byte)+(len+1)*SizeOf(DWORD),Buffer,pos); AddToBuffer(part,Buffer,pos); AddToBuffer(len,Buffer,pos); @@ -923,6 +959,9 @@ begin ReadFromBuffer(b,Buffer,pos); if b<>1 then raise EFormatException.Create(''); ReadFromBuffer(Keys,Buffer,pos); + LogStrings(mtExtra,fOwner.flogger,self,'Values',Keys); + if not ReceiveBuffer(Buffer,len) then exit; + pos := 0; ReadFromBuffer(b,Buffer,pos); if b<>2 then raise EFormatException.Create(''); ReadFromBuffer(Data,Buffer,pos); @@ -933,6 +972,8 @@ begin ReadFromBuffer(b,Buffer,pos); if b<>1 then raise EFormatException.Create(''); ReadFromBuffer(intData,Buffer,pos); + if not ReceiveBuffer(Buffer,len) then exit; + pos := 0; ReadFromBuffer(b,Buffer,pos); if b<>2 then raise EFormatException.Create(''); ReadFromBuffer(Data,Buffer,pos); @@ -943,6 +984,8 @@ begin ReadFromBuffer(b,Buffer,pos); if b<>1 then raise EFormatException.Create(''); ReadFromBuffer(Keys,Buffer,pos); + if not ReceiveBuffer(Buffer,len) then exit; + pos := 0; ReadFromBuffer(b,Buffer,pos); if b<>2 then raise EFormatException.Create(''); ReadFromBuffer(intData,Buffer,pos); @@ -953,9 +996,13 @@ begin ReadFromBuffer(b,Buffer,pos); if b<>1 then raise EFormatException.Create(''); ReadFromBuffer(Keys,Buffer,pos); + if not ReceiveBuffer(Buffer,len) then exit; + pos := 0; ReadFromBuffer(b,Buffer,pos); if b<>2 then raise EFormatException.Create(''); ReadFromBuffer(intData,Buffer,pos); + if not ReceiveBuffer(Buffer,len) then exit; + pos := 0; ReadFromBuffer(b,Buffer,pos); if b<>3 then raise EFormatException.Create(''); ReadFromBuffer(Data,Buffer,pos); @@ -977,7 +1024,7 @@ var begin inherited Create(true); //FreeOnTerminate:=true; - fCache := TRoundBuffer.Create(10000); + fCache := TRoundBuffer.Create(@AOwner.log, 1024*1024); fSocket := ASocket; fOwner := AOwner; CreateGuid(ID);