811 lines
22 KiB
ObjectPascal
811 lines
22 KiB
ObjectPascal
unit ConnectionsDmUnit;
|
||
|
||
{$mode ObjFPC}{$H+}
|
||
|
||
interface
|
||
|
||
uses
|
||
Classes, Contnrs, SysUtils, types, process, cgiDM, reportDMUnit, LNet,eventlog,
|
||
lnetbase,tcpserver, tcpthreadhelper, DCPsha1, extTypes,syncobjs, baseconnection,LazLoggerBase,LazLogger;
|
||
|
||
type
|
||
|
||
{ TCommand }
|
||
|
||
|
||
|
||
|
||
|
||
{ TConnectionsDM }
|
||
|
||
TConnectionsDM = class(TDataModule)
|
||
Hash: TDCP_sha1;
|
||
Process1: TProcess;
|
||
procedure DataModuleCreate(Sender: TObject);
|
||
procedure DataModuleDestroy(Sender: TObject);
|
||
private
|
||
MainCon: TNIDBDM;
|
||
conlist: TList;
|
||
Input: TServerMainThread;
|
||
fDataHost: string;
|
||
fDataPort: integer;
|
||
fDataBase: string;
|
||
fServicePort: integer;
|
||
fLogger: TEventLog;
|
||
fTimeOut: integer;
|
||
fRunning: boolean;
|
||
fTermiinateCheck: TChecker;
|
||
function getConnection(ID: string): TBaseConnection;
|
||
function NewConnection(ID: string=''): TBaseConnection;
|
||
procedure Remove(con: TBaseConnection); overload;
|
||
procedure Remove(ID: string); overload;
|
||
procedure ClearConnections;
|
||
procedure ClearTerminated;
|
||
procedure ConnectNew(aSocket: TLSocket);
|
||
function ProcessLogin(UserName,UserPassword: string; out UserID: integer):boolean;
|
||
function ProcessArguments(ReportName: string; out RetValue: QWORD;out ReportTitle: string; out rValues: TStrings): boolean;
|
||
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 LogError(Sender: TObject; e: Exception; Command: string);
|
||
procedure InitBaseCon;
|
||
procedure Start(isTerminated: TChecker);
|
||
procedure Stop;
|
||
procedure Idle(Sender: TObject);
|
||
property Running: boolean read fRunning;
|
||
function ProcessRequest(Sender: TMainThread;
|
||
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);
|
||
procedure TestReport(ReportID: integer);
|
||
function CalcHash(Data: TStream): string;
|
||
end;
|
||
|
||
var
|
||
ConnectionsDM: TConnectionsDM;
|
||
|
||
implementation
|
||
uses
|
||
xpUtilUnit, strutils, xpAccessUnit, inifiles,commandcol, cgiReport;
|
||
{$R *.lfm}
|
||
|
||
|
||
|
||
|
||
{ TConnectionsDM }
|
||
|
||
procedure TConnectionsDM.DataModuleCreate(Sender: TObject);
|
||
var
|
||
con: TBaseConnection;
|
||
begin
|
||
fRunning := false;
|
||
conList := TList.Create;
|
||
MainCon := TNIDBDM.CreateWithLogger(@log);
|
||
LoadConfig;
|
||
input := nil;
|
||
{$IFDEF DEBUG}
|
||
con := NewConnection('0');
|
||
con.User:='anonymous';
|
||
con.UserID := 0;
|
||
con.Start;
|
||
{$ENDIF}
|
||
end;
|
||
|
||
procedure TConnectionsDM.DataModuleDestroy(Sender: TObject);
|
||
begin
|
||
log(mtExtra,Sender,'Destroy');
|
||
ClearConnections;
|
||
|
||
if fRunning then
|
||
begin
|
||
Input.Terminate;
|
||
Input.WaitFor;
|
||
Input.Free;
|
||
end;
|
||
|
||
|
||
MainCon.Free;
|
||
conList.Free;
|
||
|
||
end;
|
||
|
||
function TConnectionsDM.getConnection(ID: string): TBaseConnection;
|
||
var
|
||
i: integer;
|
||
begin
|
||
for i := 0 to conList.Count-1 do
|
||
if TBaseConnection(conlist[i]).ConnectionID=ID then
|
||
begin
|
||
result := TBaseConnection(conlist[i]);
|
||
result.LastAccess := NOW();
|
||
exit;
|
||
end;
|
||
result := nil;
|
||
end;
|
||
|
||
function TConnectionsDM.NewConnection(ID: string): TBaseConnection;
|
||
var
|
||
g: TGUID;
|
||
s: string;
|
||
i: integer;
|
||
begin
|
||
result := TBaseConnection.Create(self,fTimeOut,@Log,ID);
|
||
conlist.add(result);
|
||
result.Host:=DataHost;
|
||
result.port:=DataPort;
|
||
result.DataBase:=DataBase;
|
||
log(mtDebug, self, 'Новое соединение с БД '+result.ConnectionID);
|
||
result.Init;
|
||
|
||
end;
|
||
|
||
procedure TConnectionsDM.Remove(con: TBaseConnection);
|
||
var
|
||
i: integer;
|
||
begin
|
||
|
||
for i := conList.Count-1 downto 0 do
|
||
if TBaseConnection(conlist[i])=con then
|
||
begin
|
||
log(mtDebug,self,'Закрытие соединения '+con.ConnectionID);
|
||
TBaseConnection(conlist[i]).terminate;
|
||
exit;
|
||
end;
|
||
end;
|
||
|
||
procedure TConnectionsDM.Remove(ID: string);
|
||
var
|
||
i: integer;
|
||
begin
|
||
|
||
for i := conList.Count-1 downto 0 do
|
||
if TBaseConnection(conlist[i]).ConnectionID=ID then
|
||
begin
|
||
log(mtDebug,self,'Закрытие соединения '+ID);
|
||
TBaseConnection(conlist[i]).terminate;
|
||
exit;
|
||
end;
|
||
end;
|
||
|
||
|
||
procedure TConnectionsDM.ClearConnections;
|
||
var
|
||
i: integer;
|
||
con: TBaseConnection;
|
||
begin
|
||
log(mtExtra, self,'ClearConnections');
|
||
for i := 0 to conList.Count-1 do
|
||
begin
|
||
con := TBaseConnection(conlist[i]);
|
||
con.terminate;
|
||
con.WaitFor;
|
||
con.Free;
|
||
end;
|
||
conList.Clear;
|
||
end;
|
||
|
||
procedure TConnectionsDM.ClearTerminated;
|
||
var
|
||
i: integer;
|
||
con: TBaseConnection;
|
||
begin
|
||
log(mtExtra,self,'ClearTerminated');
|
||
for i := conlist.Count-1 downto 0 do
|
||
begin
|
||
con := TBaseConnection(conlist[i]);
|
||
if con.Finished then
|
||
begin
|
||
log(mtDebug, self,'Закрытие по таймауту '+con.ConnectionID);
|
||
con.free;
|
||
conlist.delete(i);
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
procedure TConnectionsDM.ConnectNew(aSocket: TLSocket);
|
||
begin
|
||
// aSocket
|
||
end;
|
||
|
||
function TConnectionsDM.ProcessRequest(Sender: TMainThread;
|
||
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;
|
||
procedure waitforresult(Pause: integer; acmd: TCommand);
|
||
begin
|
||
if acmd.Status in [StatusComplete,StatusError] then exit;
|
||
while (pause>0) and not(acmd.Status in [StatusWaiting,StatusProcessing]) do
|
||
begin
|
||
Sleep(1000);
|
||
dec(pause);
|
||
end;
|
||
end;
|
||
var
|
||
UserID: integer;
|
||
con: TBaseConnection;
|
||
userName,conID,cmdID: string;
|
||
cmd: TCommand;
|
||
i: integer;
|
||
begin
|
||
try
|
||
log(mtInfo, Self,'Обработка запроса '+ACommand);
|
||
ClearTerminated;
|
||
result := false;
|
||
RetValue := 0;
|
||
Code := 0;
|
||
rValues := nil;
|
||
ByteData := nil;
|
||
setLength(iValues,0);
|
||
if ACommand='stop' then
|
||
begin
|
||
log(mtDebug,self,'stop');
|
||
ClearConnections;
|
||
Input.Terminate;
|
||
fRunning:=false;
|
||
result := true;
|
||
exit;
|
||
end;
|
||
if ACommand='help' then
|
||
begin
|
||
result := true;
|
||
rValues := TStringList.Create;
|
||
rvalues.Add('{action:"help",params:[]}');
|
||
rvalues.Add('{action:"version",params:[]}');
|
||
rValues.add('{action:"reports",params:[]}');
|
||
rValues.add('{action:"arguments",params:["report"]}');
|
||
rValues.add('{action:"login",params:["user","password"]}');
|
||
rValues.add('{action:"logout",params:["connect"]}');
|
||
rValues.add('{action:"test",params:["connect"]}');
|
||
rValues.add('{action:"log",params:["connect"]}');
|
||
rValues.add('{action:"option_values",params:["connect","report","name"]}');
|
||
rValues.add('{action:"report",params:["connect","name"]}');
|
||
rValues.add('{action:"status",params:["connect","operation?"]}');
|
||
rValues.add('{action:"result",params:["connect","operation"]}');
|
||
end;
|
||
if ACommand='version' then
|
||
begin
|
||
result := true;
|
||
Answer := extTypes.version;
|
||
exit;
|
||
end;
|
||
if ACommand='arguments' then
|
||
begin
|
||
result := ProcessArguments(Fields.Values['report'],RetValue,Answer,rValues);
|
||
if not result then
|
||
begin
|
||
Code := ErrorArguments;
|
||
end;
|
||
exit;
|
||
end;
|
||
if ACommand='reports' then
|
||
begin
|
||
result := ProcessReports(rValues);
|
||
exit;
|
||
end;
|
||
if ACommand='login' then
|
||
begin
|
||
UserName :=Fields.Values['user'];
|
||
if ProcessLogin(UserName,EncryptText(Fields.Values['password'],Hash),UserID) then
|
||
begin
|
||
con := NewConnection;
|
||
con.User:=UserName;
|
||
con.UserID := UserID;
|
||
Answer := con.ConnectionID;
|
||
con.Start;
|
||
result := true;
|
||
end
|
||
else
|
||
begin
|
||
Answer := 'Invalid password';
|
||
code := ErrorLogin;
|
||
end;
|
||
exit;
|
||
end;
|
||
conID := fields.Values['connect'];
|
||
con := getConnection(conID);
|
||
|
||
if not assigned(con) or (con.Finished) then
|
||
begin
|
||
Answer := 'invalid connectionID';
|
||
code := ErrorConnect;
|
||
exit;
|
||
end;
|
||
if ACommand='test' then
|
||
begin
|
||
result := true;
|
||
answer := 'OK';
|
||
exit;
|
||
end;
|
||
if ACommand='logout' then
|
||
begin
|
||
result := true;
|
||
Answer := 'OK';
|
||
Remove(con.ConnectionID);
|
||
exit;
|
||
end;
|
||
if ACommand='log' then
|
||
begin
|
||
result := true;
|
||
Answer := 'OK';
|
||
rValues := TStringList.Create;
|
||
for i := 0 to con.Journal.count-1 do
|
||
begin
|
||
rValues.add('"'+TNIDBDM.StringAsJSON(con.Journal[i])+'"');
|
||
end;
|
||
con.Journal.Clear;
|
||
exit;
|
||
end;
|
||
con.Log(mtInfo,self,'Получен запрос '+ACommand);
|
||
if ACommand='connectStatus' then
|
||
begin
|
||
result := true;
|
||
SetLength(iValues,7);
|
||
iValues[0] := round(con.Created*24*60*60*100);
|
||
iValues[1] := round(con.LastReceive*24*60*60*100);
|
||
iValues[2] := round(con.LastComplete*24*60*60*100);
|
||
iValues[3] := con.CountReceived;
|
||
iValues[4] := con.CountCompleted;
|
||
iValues[5] := con.CountReady;
|
||
iValues[6] := con.CountErrors;
|
||
Answer := 'OK';
|
||
exit;
|
||
end;
|
||
if (ACommand='option_values') then
|
||
begin
|
||
result := con.ProcessOptionValues(fields.Values['report'],fields.Values['name'],fields,Answer,RetValue,rValues);
|
||
exit;
|
||
end;
|
||
|
||
if (ACommand='status') or (ACommand='result') then
|
||
begin
|
||
cmdID := fields.Values['operation'];
|
||
cmd := con.FindCommand(cmdID);
|
||
if (ACommand='result') and (cmdID='') then
|
||
begin
|
||
Answer := 'operation not specified';
|
||
Code := ErrorCommand;
|
||
exit;
|
||
end;
|
||
if (ACommand='result') and not assigned(cmd) then
|
||
begin
|
||
Answer := 'operation not found '+cmdID;
|
||
Code := ErrorCommand;
|
||
exit;
|
||
end;
|
||
if (cmdID<>'') and not assigned(cmd) then
|
||
begin
|
||
Answer := 'operation not found '+cmdID;
|
||
Code := ErrorCommand;
|
||
exit;
|
||
end;
|
||
if ACommand='status' then
|
||
begin
|
||
if not assigned(cmd) then
|
||
begin
|
||
RetValue:=con.CommandCount;
|
||
rValues := TStringList.Create;
|
||
{action:"help",params:[]}
|
||
rValues.Add('operations:[');
|
||
for i := 0 to RetValue-1 do
|
||
begin
|
||
cmd := con.AllCommands[i];
|
||
Answer := cmd.currentStage;
|
||
code := cmd.Status;
|
||
rValues.Add(format('{id:"%s",name:"%s",status:%d,stage:"%s"},',[NIDBDM.StringAsJSON(cmd.CommandID),NIDBDM.StringAsJSON(cmd.CommandName),cmd.Status, NIDBDM.StringAsJSON(cmd.CurrentStage)]));
|
||
end;
|
||
rValues.Add('{id:"",name:"",status:-1,stage:""}]');
|
||
end
|
||
else
|
||
begin
|
||
Answer := cmd.currentStage;
|
||
if assigned(cmd.Results) then
|
||
cmd.Results.AssignTo(Code,RetValue,Answer,rValues)
|
||
else
|
||
begin
|
||
rValues := TSTringList.Create;
|
||
for i := 0 to cmd.Journal.count-1 do
|
||
rValues.add('"'+TNIDBDM.StringAsJSON(cmd.Journal[i])+'"');
|
||
end;
|
||
code := cmd.Status;
|
||
if (code=StatusComplete) and assigned(cmd.Results.Data) then
|
||
RetValue:=cmd.Results.Data.Size
|
||
else
|
||
RetValue := 0;
|
||
end;
|
||
result := true;
|
||
exit;
|
||
end;
|
||
if ACommand='result' then
|
||
begin
|
||
waitforresult(StrToIntDef(Fields.Values['wait'],0),cmd);
|
||
if cmd.Status=StatusComplete then
|
||
begin
|
||
cmd.Results.AssignTo(Code,RetValue,Answer,rValues,iValues,ByteData);
|
||
cmd.Done;
|
||
result := true;
|
||
end
|
||
else if cmd.Status=StatusError then
|
||
begin
|
||
cmd.Results.AssignTo(Code,RetValue,Answer,rValues,iValues,ByteData);
|
||
cmd.Done;
|
||
result := false;
|
||
end
|
||
else
|
||
begin
|
||
Code := ErrorComplete;
|
||
Answer:='command not complete';
|
||
end;
|
||
exit;
|
||
end;
|
||
|
||
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;
|
||
LogError(self,e, format('ProcessRequest(%s)',[ACommand]));
|
||
end;
|
||
end;
|
||
|
||
end;
|
||
|
||
constructor TConnectionsDM.CreateWithLog(ALogger: TEventLog);
|
||
begin
|
||
fLogger:=Alogger;
|
||
inherited Create(nil);
|
||
end;
|
||
|
||
procedure TConnectionsDM.FillTemplates(RepList: TStrings);
|
||
var
|
||
asql: string;
|
||
begin
|
||
try
|
||
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;
|
||
|
||
except on e: Exception do
|
||
begin
|
||
logError(Self,e,format('FillTemplates',[]));
|
||
raise;
|
||
end;
|
||
end;
|
||
end;
|
||
function TConnectionsDM.CalcHash(Data: TStream): string;
|
||
var
|
||
Digest: packed array[0..19] of byte;
|
||
i,l: integer;
|
||
b: array[0..$100000-1] of byte;
|
||
begin
|
||
Result := '';
|
||
Hash.Init;
|
||
Data.Seek(0,soFromBeginning);
|
||
repeat
|
||
l := Data.Read(b,sizeof(b));
|
||
Hash.Update(b,l);
|
||
until l=0;
|
||
Data.Seek(0,soFromBeginning);
|
||
Hash.Final(Digest);
|
||
Hash.Burn;
|
||
for i:= 0 to 19 do
|
||
Result := Result + AnsiString(IntToHex(Digest[i], 2));
|
||
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);
|
||
cc := TCommandCollection.Find('report',RName);
|
||
cmd := cc.Create('', MainCon,RName,@Log,'',0) as TReportCommand;
|
||
try
|
||
cmd.ReportID := ReportID;
|
||
cmd.ReportName:=RName;
|
||
cmd.FillDefaults;
|
||
cmd.EditTemplate(@CalcHash);
|
||
finally
|
||
cmd.free;
|
||
end;
|
||
end;
|
||
|
||
procedure TConnectionsDM.TestReport(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);
|
||
cc := TCommandCollection.Find('report',RName);
|
||
cmd := cc.Create('', MainCon,RName,@Log,'',0) as TReportCommand;
|
||
try
|
||
cmd.ReportID := ReportID;
|
||
cmd.ReportName:=RName;
|
||
cmd.FillDefaults;
|
||
cmd.Run();
|
||
|
||
finally
|
||
cmd.free;
|
||
end;
|
||
end;
|
||
|
||
|
||
function TConnectionsDM.ProcessLogin(UserName, UserPassword: string; out UserID: integer): boolean;
|
||
var
|
||
ASQL: string;
|
||
begin
|
||
try
|
||
Result := MainCon.CheckUser(UserName,UserPassword,UserID);
|
||
|
||
except on e: Exception do
|
||
begin
|
||
logError(Self,e,format('ProcessLogin(user=%s)',[UserName]));
|
||
raise;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
function TConnectionsDM.ProcessArguments(ReportName: string; out
|
||
RetValue: QWORD; out ReportTitle: string; out rValues: TStrings): boolean;
|
||
var
|
||
ASQL: string;
|
||
begin
|
||
result := false;
|
||
rValues := TStringList.Create;
|
||
try
|
||
ASQL := format(
|
||
'select r.xp_rpt_id,r.name as reportname,p.name as paramname, '+
|
||
'case p.type '+
|
||
' when 0 then ''A'' '+
|
||
' when 1 then ''ID'' '+
|
||
' when 2 then ''N'' '+
|
||
' when 3 then ''F'' '+
|
||
' when 4 then ''D'' '+
|
||
' when 5 then ''T'' '+
|
||
' when 6 then ''B'' '+
|
||
' when 17 then ''IDS'' '+
|
||
'end as type, '+
|
||
|
||
'case coalesce(p.required,false) or p.def_val is null '+
|
||
'when true then ''!'' '+
|
||
'else p.def_val '+
|
||
'end as def_val, '+
|
||
'string_agg(''"'' || p.argument || ''"'','';'') as arguments, '+
|
||
'p.description '+
|
||
'from xp_report_cgi c '+
|
||
' join xp_report r on r.xp_rpt_id=c.xp_rpt_id '+
|
||
' left join ( '+
|
||
' select xp_rpt_id, type,name, required,def_val,description,fill_order, unnest(coalesce(arguments,array[null])) as argument '+
|
||
' from xp_report_params '+
|
||
')p on p.xp_rpt_id=r.xp_rpt_id '+
|
||
'where c.cgi_name=%0:s '+
|
||
'group by r.xp_rpt_id,r.name, p.name,p.type,p.required, p.def_val,p.description, p.fill_order '+
|
||
'order by p.fill_order, p.name ',
|
||
[TNIDBDM.StringAsSQL(ReportName)]);
|
||
with MainCon.GetData(ASQL) do
|
||
try
|
||
while not eof do
|
||
begin
|
||
ReportTitle := fieldByName('reportname').AsString;
|
||
rValues.Add(format('{"name":"%s","type":"%s","default":"%s","arguments":[%s],"description":"%s"}',
|
||
[fieldbyname('paramname').asString, fieldbyname('type').asString,fieldbyname('def_val').asString,fieldbyname('arguments').asString, TNIDBDM.StringAsJSON(fieldbyname('description').asString)]));
|
||
result := true;
|
||
next;
|
||
end;
|
||
finally
|
||
free;
|
||
end;
|
||
|
||
except on e: Exception do
|
||
begin
|
||
logError(Self,e,format('ProcessArguments(report=%s)',[ReportName]));
|
||
raise;
|
||
end;
|
||
end;
|
||
|
||
end;
|
||
|
||
function TConnectionsDM.ProcessReports(out rValues: TStrings): boolean;
|
||
var
|
||
ASQL: string;
|
||
begin
|
||
try
|
||
rValues := TStringList.Create;
|
||
ASQL :=
|
||
'select c.cgi_name,r.name as rep_name '+
|
||
'from xp_report_cgi c '+
|
||
' join xp_report r on r.xp_rpt_id=c.xp_rpt_id '+
|
||
'order by 2 ';
|
||
with MainCon.GetData(ASQL) do
|
||
try
|
||
while not eof do
|
||
begin
|
||
rValues.Add(format('{"name":"%s","title":"%s"}',[fieldbyname('cgi_name').asString, TNIDBDM.StringAsJSON(fieldbyname('rep_name').asString)]));
|
||
result := true;
|
||
next;
|
||
end;
|
||
finally
|
||
free;
|
||
end;
|
||
|
||
except on e: Exception do
|
||
begin
|
||
LogError(self,e,format('ProcessReports',[]));
|
||
raise;
|
||
end;
|
||
end;
|
||
result := true;
|
||
end;
|
||
|
||
function TConnectionsDM.ProcessOptionValues(ReportName, ParamName: string;
|
||
ParamValues: TStrings; out Answer: string; out RetValue: QWORD; out
|
||
OptionValues: TStrings): boolean;
|
||
var
|
||
ASQL: string;
|
||
code: string;
|
||
i: integer;
|
||
begin
|
||
try
|
||
ASQL := format(
|
||
'select source from xp_report_params p '+
|
||
' 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 (1,17) ',
|
||
[TNIDBDM.StringAsSQL(ReportName), TNIDBDM.StringAsSQL(ParamName)]);
|
||
code := MainCon.QueryValue(ASQL);
|
||
TNIDBDM.UpdateWithArguments(code,ParamValues);
|
||
if pos('{',code)>0 then
|
||
begin
|
||
result := false;
|
||
Answer := 'недостаточно данных';
|
||
exit;
|
||
end;
|
||
ASQL := code;
|
||
OptionValues := TStringList.Create;
|
||
if ASQL<>'' then
|
||
with MainCon.GetData(ASQL) do
|
||
try
|
||
while not eof do
|
||
begin
|
||
OptionValues.Add(format('{"id":"%d","value":"%s"}',
|
||
[Fields[0].AsInteger, TNIDBDM.StringAsJSON(Fields[1].AsString)]));
|
||
next;
|
||
end;
|
||
finally
|
||
free;
|
||
end;
|
||
result := true;
|
||
|
||
except on e: Exception do
|
||
begin
|
||
LogError(self,e,format('ProcessOptionValues(report=%s,param=%s)',[ReportName,ParamName]));
|
||
raise;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
|
||
procedure TConnectionsDM.LoadConfig;
|
||
var
|
||
ini: TIniFile;
|
||
inifile: string;
|
||
begin
|
||
inifile := ChangeFileExt(ParamStr(0),'.ini');
|
||
ini := TIniFile.Create(inifile);
|
||
try
|
||
fDataHost := ini.ReadString('DATA','host','localhost');
|
||
fDataPort := ini.ReadInteger('DATA','port',7079);
|
||
fDataBase:= ini.ReadString('DATA','database','studium');
|
||
fServicePort := ini.ReadInteger('PARAMS','port',6543);
|
||
fTimeOut:=ini.ReadInteger('PARAMS','timeout',CONNECT_TIMEOUT);
|
||
finally
|
||
ini.free;
|
||
end;
|
||
log(mtInfo,self,format('База данных %s:%d/%s Порт для соединения %d',[fDataHost,fDataPort,fDataBase,fServicePort]));
|
||
end;
|
||
|
||
|
||
|
||
procedure TConnectionsDM.Log(ALevel: TLogLevel; Sender: TObject; msg: string);
|
||
var
|
||
s: string;
|
||
begin
|
||
if not assigned(fLogger) then exit;
|
||
try
|
||
|
||
// assignefile(fLogFolder
|
||
if Sender is TComponent then
|
||
s := Sender.ClassName+'-'+(Sender as TComponent).Name
|
||
else if assigned(Sender) then
|
||
s := Sender.ClassName
|
||
else
|
||
s := '[NIL]';
|
||
s := DateTimeToStr(NOW())+#09+s+#09+Msg;
|
||
case ALevel of
|
||
mtError: fLogger.Error(s);
|
||
mtWarning: fLogger.Warning(s);
|
||
mtInfo: flogger.Info(s);
|
||
{$IFDEF DEBUG}
|
||
mtDebug: fLogger.Debug(s);
|
||
mtExtra: fLogger.Log(#09+s);
|
||
{$ENDIF}
|
||
end;
|
||
except
|
||
end;
|
||
end;
|
||
|
||
procedure TConnectionsDM.LogError(Sender: TObject; e: Exception; Command: string
|
||
);
|
||
begin
|
||
log(mtError,Sender,format('%s вызвала ошибку %s(%s) ',[Command, e.classname,e.message]));
|
||
end;
|
||
|
||
procedure TConnectionsDM.InitBaseCon;
|
||
begin
|
||
MainCon.connection.RemoteHost:=DataHost;
|
||
MainCon.connection.RemotePort:=DataPort;
|
||
MainCon.connection.Database:=DataBase;
|
||
MainCon.OpenConnection;
|
||
end;
|
||
|
||
procedure TConnectionsDM.Start(isTerminated: TChecker);
|
||
begin
|
||
fTermiinateCheck := isTerminated;
|
||
InitBaseCon;//Input.OnIdle:=@Idle;
|
||
input := TServerMainThread.Create(@log,fServicePort,fTermiinateCheck,@ProcessRequest);
|
||
Input.Start;
|
||
fRunning:=true;
|
||
end;
|
||
|
||
procedure TConnectionsDM.Stop;
|
||
begin
|
||
if fRunning then
|
||
Input.Terminate;
|
||
Input.WaitFor;
|
||
fRunning := false;
|
||
end;
|
||
|
||
|
||
procedure TConnectionsDM.Idle(Sender: TObject);
|
||
var
|
||
i: integer;
|
||
begin
|
||
MainCon.ExecuteSQL('select 1');
|
||
for i := conlist.Count-1 downto 0 do
|
||
if not TBaseConnection(conList[i]).Finished then
|
||
TBaseConnection(conList[i]).SetIdle;
|
||
end;
|
||
|
||
end.
|
||
|