LMS-2_ReportAPI/maintcpserver.pas

unit MainTcpServer;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls,
  tcpClient,tcpServer, tcpthreadhelper,
  ConnectionsDmUnit, syncobjs, extTypes, eventlog;

type

  { TClientThread }


  { TCGIServerGUI }

  TCGIServerGUI = class(TForm)
    TestButton: TButton;
    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;
    SendButton: TButton;
    Panel1: TPanel;
    Splitter1: TSplitter;
    StartButton: TButton;
    procedure EditTemplateClick(Sender: TObject);
    procedure edtAnswerDblClick(Sender: TObject);
    procedure SendButtonClick(Sender: TObject);
    procedure StartButtonClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure TestButtonClick(Sender: TObject);
  private
   fLogger: TEventLog;
   Server: TConnectionsDM;
   Client: TClientMainThread;
   cmdDone: boolean;
   started: boolean;
   function IsTerminated(Sender: TObject): boolean;
    procedure LogQuery(const qtype: integer; const command: string; const aKeys: TStrings; const code: DWORD; const Param: QWORD; const data: TParamArray);
    function onAnswer(Sender: TMainThread; const mode: byte;
    const Code:DWORD; const QValue: QWORD; const Answer: string; const Values: TStrings; const iValues: TParamArray; const Data: TStream): boolean;
  public

  end;

  { TConnectionThread }


var
  CGIServerGUI: TCGIServerGUI;

implementation

{$R *.lfm}
uses
  types,strUtils;


{ TCGIServerGUI }

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:=true;
  flogger.Info('TCGIServerGUI.FormCreate');

  Server := TConnectionsDM.CreateWithLog(fLogger);
  ConnectionsDM := Server;
  cmdDone := true;
  started := false;
  SendButton.Enabled := Paramstr(1)='client';
  StartButton.Enabled := not SendButton.Enabled;
end;

procedure TCGIServerGUI.SendButtonClick(Sender: TObject);
begin
  if not started and StartButton.enabled then exit;
  client := TClientMainThread.Create(edtRequest.Text,Keys.Lines,@Server.log,'localhost',6543,@onAnswer);
  try
    LogQuery(0,edtRequest.Text,Keys.Lines,0,0,[]);
    cmdDone := false;
    edtAnswer.Text := '';
    edtQValue.Text := '';
    StatusPanel.Caption := 'Ожидание';
    retValues.Clear;
    client.Start;
    client.WaitFor;

  finally
    client.free;
  end;

end;

procedure TCGIServerGUI.edtAnswerDblClick(Sender: TObject);
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(@isTerminated);
  Server.FillTemplates(ReportsList.Items);
  started := true;
  Panel1.Caption := 'запущен';
  SendButton.Enabled := true;
end;

procedure TCGIServerGUI.FormDestroy(Sender: TObject);
begin
  Server.Free;
  fLogger.Free;
end;

procedure TCGIServerGUI.TestButtonClick(Sender: TObject);
var
  rID: integer;
begin
  rID := PtrInt(ReportsList.Items.Objects[ReportsList.ItemIndex]);
  Server.TestReport(rID);
end;

function TCGIServerGUI.IsTerminated(Sender: TObject): boolean;
begin
  result := false;
end;


procedure TCGIServerGUI.LogQuery(const qtype: integer; const command: string;
  const aKeys: TStrings; const code: DWORD; const Param: QWORD;
  const data: TParamArray);
var
  f: textfile;
  logfile: string;
  i: integer;
begin
  logfile := ExtractFilePath(paramstr(0))+'out/query.log';
  assignfile(f,logfile);
  if fileexists(logfile) then
    append(f)
  else
    rewrite(f);
  case qType of
    0: writeln(f,DateTimeToStr(now()),#09,'REQUEST');
    1: writeln(f,DateTimeToStr(now()),#09,'RESULT');
  end;
  writeln(f,#09,command);
  if qType=1 then
    writeln(f,#09,format('code=%d, value=0x%x',[code,Param]));
  if assigned(aKeys) then
    for i := 0 to akeys.Count-1 do
      writeln(f,#09,#09,aKeys[i]);

  closefile(f);
end;



function TCGIServerGUI.onAnswer(Sender: TMainThread; const mode: byte;
  const Code: DWORD; const QValue: QWORD; const Answer: string;
  const Values: TStrings; const iValues: TParamArray; const Data: TStream
  ): boolean;
var
  i: integer;
  fs: TFileStream;
begin
  try
  LogQuery(1,Answer,Values,code,QValue,iValues);
  edtAnswer.Text := Answer;
  case mode of
    cmdAnswer: StatusPanel.Caption := format('OK(%d)',[code]);
    cmdError: StatusPanel.Caption := format('ERROR(%d)',[code]);
  end;
  edtQValue.Text:=IntToHex(QValue,16);
  if assigned(Values) then
    retValues.Lines.Assign(Values)
  else
    retValues.Clear;
  intValues.Clear;
  for i := low(iValues) to high(iValues) do
    intValues.AddItem(inttostr(ivalues[i]),TObject(PtrInt(iValues[i])));
  if Assigned(Data) then
    begin
      Data.seek(0,soFromBeginning);
      fs := TFileStream.Create('out/'+Answer,fmCreate);
      try
        fs.CopyFrom(Data,Data.size);
      finally
        fs.free;
      end;
    end;
  finally
    Sender.SetComplete;
    cmdDone := true;
  end;

end;




end.