program lms_cgi; {$mode objfpc}{$H+} uses Interfaces, Classes, SysUtils, inifiles, httpDefs, fpweb, custweb, custcgi, cxlogger, abbrevia, lnetbase, tcpClient, tcpthreadhelper, extTypes; Type { TMyCGIHandler } TMyCGIHandler = Class(TCgiHandler) Private fAnswer: string; fMode: byte; fCode: DWORD; fParam: QWORD; fValues: TStrings; fData: TStream; function answerReady(Sender: TMainThread; const mode: byte; const Code:DWORD; const QValue: QWORD; const Answer: string; const Values: TStrings; const iValues: TParamArray; const Data: TStream): boolean; Public Procedure HandleRequest(ARequest : Trequest; AResponse : TResponse); override; procedure log(Sender: TObject; msg: string); end; { TMyCGIApp } TMyCGIApp = Class(TCustomCGIApplication) private flogFolder: string; fHost: string; fPort: integer; procedure LoadConfig; Protected function InitializeWebHandler: TWebHandler; override; public property Host: string read fHost; property Port: integer read fPort; property LogFolder: string read fLogFolder; end; const aTypes: array[0..3] of string=('"UNKNOWN"','"REQUEST"','"ANSWER"','"ERROR"'); function TMyCGIHandler.answerReady(Sender: TMainThread; const mode: byte; const Code: DWORD; const QValue: QWORD; const Answer: string; const Values: TStrings; const iValues: TParamArray; const Data: TStream ): boolean; begin log(self,'AnswerReady'); fAnswer:=Answer; fMode:=mode; fCode:=code; fParam:=QValue; if assigned(Values) then begin fValues:=TStringList.Create; fValues.assign(Values); end; if assigned(Data) then begin fData := TMemoryStream.Create; Data.seek(0,soFromBeginning); fData.CopyFrom(Data,Data.Size); end; Sender.Terminate; end; procedure TMyCGIHandler.HandleRequest(ARequest: Trequest; AResponse: TResponse); var clt: TClientMainThread; i: integer; k,v: string; allfields: TStrings; begin log(self,'HandleRequest'); LogStrings(@log,self,'QueryFields',Arequest.QueryFields); allfields := TStringList.Create; try allfields.AddStrings(ARequest.QueryFields); allfields.AddStrings(ARequest.ContentFields); clt := TClientMainThread.Create(ARequest.QueryFields.Values['action'],allfields,@Log,(Owner as TMyCGIApp).Host,(Owner as TMyCGIApp).Port,@answerReady); clt.start; clt.waitFor; finally allfields.free; end; log(self,'Data READY'); if not assigned(fData) then begin AResponse.ContentType := 'application/json'; AResponse.Contents.add('{'); AResponse.Contents.add('"type":'+aTypes[fMode]+','); AResponse.Contents.add('"code":'+inttostr(fCode)+','); AResponse.Contents.add('"value":'+inttostr(fParam)+','); AResponse.Contents.add('"name":"'+(fAnswer)+'",'); if assigned(fValues) then begin AResponse.Contents.add('"values":['); for i := 0 to fValues.Count-1 do begin AResponse.Contents.Add(fValues[i]+','); end; AResponse.Contents.add(']'); fValues.Free; end; AResponse.Contents.add('}'); end else begin AResponse.FreeContentStream := true; AResponse.ContentType:='application/pdf'; fData.Seek(0,soFromBeginning); AResponse.ContentStream := fData; end; log(self,'Sending'); AResponse.SendContent; log(self,'Sent'); end; procedure TMyCGIHandler.log(Sender: TObject; msg: string); var f: TextFile; begin if (Owner as TMyCGIApp).LogFolder='' then exit; assignfile(f, (Owner as TMyCGIApp).LogFolder); if fileexists((Owner as TMyCGIApp).LogFolder) then append(f) else rewrite(f); writeln(f,msg); closefile(f); end; procedure TMyCGIApp.LoadConfig; var ini: TIniFile; begin ini := TIniFile.Create(ChangeFileExt(ParamStr(0),'.ini')); try fHost := ini.ReadString('PARAMS','host','localhost'); fPort := ini.ReadInteger('PARAMS','port',6543); flogFolder:=ini.ReadString('PARAMS','log',''); finally ini.free; end; end; function TMyCGIApp.InitializeWebHandler: TWebHandler; begin LoadConfig; Result:=TMyCgiHandler.Create(self); end; begin with TMyCGIApp.create(nil) do try Initialize; Run; finally Free; end; end.