407 lines
11 KiB
ObjectPascal
407 lines
11 KiB
ObjectPascal
unit cgiDM;
|
|
|
|
{$mode ObjFPC}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, nnz_data_components, frxClass, nnzDBClient,DB,extTypes;
|
|
|
|
type
|
|
|
|
{ TNIDBDM }
|
|
|
|
TNIDBDM = class(TDataModule)
|
|
nnzQuery1: TnnzQuery;
|
|
procedure DataModuleCreate(Sender: TObject);
|
|
procedure DataModuleDestroy(Sender: TObject);
|
|
private
|
|
fcon: TnnzConnection;
|
|
fMid: integer;
|
|
fLogin: string;
|
|
fID: TGUID;
|
|
fLastConnectTime: TDateTime;
|
|
flogger: TLogger;
|
|
class function DeleteLastChar(const St: String; const CharCount: integer=1): String;
|
|
public
|
|
|
|
class function FloatAsSQL(Value: Double): String;
|
|
class function PeriodAsSQL(BegDate, EndDate: TDateTime): string;
|
|
class function DateAsSQL(Date: TDateTime): String;
|
|
class function DateTimeAsSQL(Stamp: TDateTime): String;
|
|
class function CurrencyAsSQL(Value: Currency): string;
|
|
class function VariantAsSQL(const Value: Variant): String;
|
|
class function BooleanAsSQL(Value: Boolean): String;
|
|
class function StringAsSQL(const St: String): String;
|
|
class function StringAsJSON(const St: String): String;
|
|
class function StreamAsSQL(s: TStream): String;
|
|
class function BytesAsSQL(const data: array of byte; dataSize: integer): string;
|
|
class function IntArrayAsSQL(const data: array of integer): string;
|
|
class procedure UpdateWithArguments(var code: string; const Arguments: TStrings);
|
|
property logger: TLogger read flogger write flogger;
|
|
property connection: TnnzConnection read fCon;
|
|
function CheckConnection: boolean;
|
|
function QueryValue(ASQL: string; Default: string=''): string;
|
|
function QueryIntValue(ASQL: string): integer;
|
|
function QueryDateValue(ASQL: string): TDateTime;
|
|
function GetData(ASQL: string): TDataSet;
|
|
function CheckUser(const login,password: string; out UserID: integer): boolean;
|
|
procedure OpenConnection;
|
|
procedure log(ALevel: TLogLevel; Sender: TObject; msg: string);
|
|
procedure LogError(Sender: TObject; e: Exception; msg: string);
|
|
procedure ExecuteSQL(ASQL: string);
|
|
constructor CreateWithLogger(ALogger: TLogger);
|
|
end;
|
|
|
|
var
|
|
NIDBDM: TNIDBDM;
|
|
|
|
implementation
|
|
uses
|
|
variants,LazUTF8;
|
|
{$R *.lfm}
|
|
|
|
{ TNIDBDM }
|
|
|
|
procedure TNIDBDM.DataModuleCreate(Sender: TObject);
|
|
begin
|
|
log(mtDebug,sender,'TnnzConnection.Create');
|
|
fcon := TnnzConnection.Create(self);
|
|
|
|
end;
|
|
|
|
procedure TNIDBDM.DataModuleDestroy(Sender: TObject);
|
|
begin
|
|
log(mtDebug,sender,'destroy');
|
|
fcon.Connected:=false;
|
|
fcon.free;
|
|
end;
|
|
|
|
class function TNIDBDM.DeleteLastChar(const St: String;
|
|
const CharCount: integer): String;
|
|
begin
|
|
Result := utf8Copy(St, 1, utf8Length(St) - CharCount);
|
|
end;
|
|
|
|
class function TNIDBDM.FloatAsSQL(Value: Double): String;
|
|
var
|
|
fs: TFormatSettings;
|
|
begin
|
|
fs.DecimalSeparator := '.';
|
|
Result := FloatToStr(Value, fs);
|
|
end;
|
|
|
|
|
|
class function TNIDBDM.PeriodAsSQL(BegDate, EndDate: TDateTime): string;
|
|
begin
|
|
if (BegDate <= 2) and (EndDate <= 2) then
|
|
Result := '>=''1900-01-01'''
|
|
else
|
|
Result := 'BETWEEN ' + DateAsSQL(BegDate) + ' AND ' + DateAsSQL(EndDate);
|
|
end;
|
|
|
|
|
|
class function TNIDBDM.DateAsSQL(Date: TDateTime): String;
|
|
begin
|
|
if FormatSettings.ShortMonthNames[1] <> 'JAN' then
|
|
begin
|
|
FormatSettings.ShortMonthNames[1] := 'JAN';
|
|
// без этого дурит MSSQL7/MSSQL2000, который не понимает
|
|
FormatSettings.ShortMonthNames[2] := 'FEB'; // дату в формате '13 окт 1999'
|
|
FormatSettings.ShortMonthNames[3] := 'MAR';
|
|
FormatSettings.ShortMonthNames[4] := 'APR';
|
|
FormatSettings.ShortMonthNames[5] := 'MAY';
|
|
FormatSettings.ShortMonthNames[6] := 'JUN';
|
|
FormatSettings.ShortMonthNames[7] := 'JUL';
|
|
FormatSettings.ShortMonthNames[8] := 'AUG';
|
|
FormatSettings.ShortMonthNames[9] := 'SEP';
|
|
FormatSettings.ShortMonthNames[10] := 'OCT';
|
|
FormatSettings.ShortMonthNames[11] := 'NOV';
|
|
FormatSettings.ShortMonthNames[12] := 'DEC';
|
|
end;
|
|
if Date < 2 then
|
|
Date := 2; // приводим к 1 января 1900 - это ноль для SMALLDATETIME
|
|
Result := QuotedStr(FormatDateTime('yyyy-mm-dd', Date));
|
|
end;
|
|
class function TNIDBDM.DateTimeAsSQL(Stamp: TDateTime): String;
|
|
begin
|
|
// Result := FloatToStr(Real(Stamp) - 2); старый вариант - ldm
|
|
Result := '';
|
|
DateTimeToString(Result, 'hh:nn:ss', Stamp);
|
|
Result := DeleteLastChar(DateAsSQL(Stamp)) + ' ' + Result + '''';
|
|
end;
|
|
|
|
class function TNIDBDM.CurrencyAsSQL(Value: Currency): string;
|
|
begin
|
|
Result := StringAsSQL(CurrToStr(Value));
|
|
end;
|
|
|
|
class function TNIDBDM.VariantAsSQL(const Value: Variant): String;
|
|
var
|
|
Stream: TStringStream;
|
|
begin
|
|
case VarType(Value) of
|
|
varNull:
|
|
Result := 'NULL';
|
|
varEmpty:
|
|
Result := 'NULL';
|
|
varSmallInt, varInteger, varShortInt, varByte, varWord, varLongWord,
|
|
varInt64, varUInt64:
|
|
Result := VarToStr(Value);
|
|
varSingle, varCurrency:
|
|
Result := CurrencyAsSQL(Value);
|
|
varDouble:
|
|
Result := FloatAsSQL(Value);
|
|
varDate:
|
|
Result := DateAsSQL(Value);
|
|
varOleStr:
|
|
begin
|
|
Stream := TStringStream.Create(Value);
|
|
try
|
|
Result := StreamAsSQL(Stream);
|
|
finally
|
|
Stream.Free;
|
|
end;
|
|
end;
|
|
varBoolean:
|
|
Result := BooleanAsSQL(Value);
|
|
varString, varUString:
|
|
Result := StringAsSQL(Value);
|
|
else
|
|
raise Exception.Create('VariantAsSQL: Неверный тип ' + VarToStr(Value));
|
|
end;
|
|
end;
|
|
|
|
class function TNIDBDM.BooleanAsSQL(Value: Boolean): String;
|
|
begin
|
|
if value then result := 'true' else result := 'false';
|
|
end;
|
|
|
|
|
|
class function TNIDBDM.StreamAsSQL(s: TStream): String;
|
|
var
|
|
i: Integer;
|
|
b: Byte;
|
|
begin
|
|
result := 'null';
|
|
if s.size=0 then exit;
|
|
//Result := '0x'; //MySQL
|
|
Result := 'E''\\x'; //PostgreSQL
|
|
s.Position := 0;
|
|
for i := 1 to s.Size do
|
|
begin
|
|
s.Read(b, 1);
|
|
Result := Result + IntToHex(b, 2);
|
|
end;
|
|
result := result +'''';
|
|
end;
|
|
|
|
class function TNIDBDM.BytesAsSQL(const data: array of byte;
|
|
dataSize: integer): string;
|
|
var
|
|
i: integer;
|
|
b: byte;
|
|
begin
|
|
result := 'null';
|
|
if datasize=0 then exit;
|
|
Result := 'E''\\x'; //PostgreSQL
|
|
for i := 0 to dataSize-1 do
|
|
begin
|
|
b := data[i];
|
|
Result := Result + IntToHex(b, 2);
|
|
end;
|
|
result := result +'''';
|
|
end;
|
|
|
|
|
|
class function TNIDBDM.IntArrayAsSQL(const data: array of integer): string;
|
|
var
|
|
i: integer;
|
|
begin
|
|
if length(data)=0 then
|
|
result := 'ARRAY[]::integer[]'
|
|
else
|
|
begin
|
|
result := inttostr(data[low(data)]);
|
|
for i := low(data)+1 to high(data) do
|
|
result := result +','+inttostr(data[i]);
|
|
result := format('ARRAY[%s]::integer[]',[result]);
|
|
end;
|
|
end;
|
|
|
|
class procedure TNIDBDM.UpdateWithArguments(var code: string;
|
|
const Arguments: TStrings);
|
|
var
|
|
i: integer;
|
|
s,v: string;
|
|
begin
|
|
for i := 0 to Arguments.Count-1 do
|
|
begin
|
|
s := Arguments.Names[i];
|
|
v := Arguments.Values[s];
|
|
Code := StringReplace(Code,'{s#'+s+'}', TNidbDM.StringAsSQL(v),[rfReplaceAll]);
|
|
Code := StringReplace(Code,'{d#'+s+'}',TNidbDM.StringAsSQL(v)+'::date',[rfReplaceAll]);
|
|
Code := StringReplace(Code,'{#'+s+'}',v,[rfReplaceAll]);
|
|
end;
|
|
end;
|
|
|
|
function TNIDBDM.CheckConnection: boolean;
|
|
begin
|
|
if not connection.Connected then
|
|
OpenConnection;
|
|
try
|
|
connection.ExecuteSQL('SELECT 1');
|
|
result := true;
|
|
except
|
|
connection.Close(true);
|
|
OpenConnection;
|
|
result := false;
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
|
|
class function TNIDBDM.StringAsSQL(const St: String): String;
|
|
var
|
|
len,i: Cardinal;
|
|
c: Char;
|
|
hasSpecial: boolean;
|
|
begin
|
|
// Result := QuotedStr(StringReplace(St, '\', '\\',
|
|
// [rfReplaceAll, rfIgnoreCase]));
|
|
Result:='';
|
|
len:=Length(St);
|
|
hasSpecial := false;
|
|
for i:=1 to len do begin
|
|
c:=St[i];
|
|
hasSpecial := hasSpecial or (c in [#0,'''','"','\',#8,#10,#13,#9,#26]);
|
|
case(c) of
|
|
#0: Result:=Result+'\0';
|
|
'''','"','\': Result:=Result+'\'+c;
|
|
#8: Result:=Result+'\b';
|
|
#10: Result:=Result+'\n';
|
|
#13: Result:=Result+'\r';
|
|
#9: Result:=Result+'\t';
|
|
#26: Result:=Result+'\Z';
|
|
else
|
|
Result:=Result+c;
|
|
end;
|
|
end;
|
|
Result:=''''+Result+'''';
|
|
if hasSpecial then Result :='E'+Result;
|
|
|
|
end;
|
|
|
|
class function TNIDBDM.StringAsJSON(const St: String): String;
|
|
begin
|
|
result := st;
|
|
result := UTF8StringReplace(result,'\','\\',[rfReplaceAll]);
|
|
result := UTF8StringReplace(result,'"','\"',[rfReplaceAll]);
|
|
end;
|
|
|
|
|
|
function TNIDBDM.QueryValue(ASQL: string; Default: string): string;
|
|
begin
|
|
log(mtDebug,self,'QueryValue'#13#10+ASQL);
|
|
CheckConnection;
|
|
with TnnzQuery.Create(self) do
|
|
try
|
|
Connection := fcon;
|
|
SQL.Text:=ASQL;
|
|
Open;
|
|
if not eof and not Fields[0].IsNull then result := Fields[0].AsString else result := Default;
|
|
finally
|
|
free;
|
|
end;
|
|
end;
|
|
|
|
function TNIDBDM.QueryIntValue(ASQL: string): integer;
|
|
begin
|
|
log(mtDebug,self,'QueryIntValue'#13#10+ASQL);
|
|
CheckConnection;
|
|
with TnnzQuery.Create(self) do
|
|
try
|
|
Connection := fcon;
|
|
SQL.Text:=ASQL;
|
|
Open;
|
|
if not eof then result := Fields[0].AsInteger else result := 0;
|
|
finally
|
|
free;
|
|
end;
|
|
end;
|
|
|
|
function TNIDBDM.QueryDateValue(ASQL: string): TDateTime;
|
|
begin
|
|
log(mtDebug,self,'QueryIntValue'#13#10+ASQL);
|
|
CheckConnection;
|
|
with TnnzQuery.Create(self) do
|
|
try
|
|
Connection := fcon;
|
|
SQL.Text:=ASQL;
|
|
Open;
|
|
if not eof then result := Fields[0].AsDateTime else result := 0;
|
|
finally
|
|
free;
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
function TNIDBDM.GetData(ASQL: string): TDataSet;
|
|
begin
|
|
log(mtDebug,self,'getData '#13#10+ASQL);
|
|
CheckConnection;
|
|
result := TnnzQuery.Create(self);
|
|
with result as TnnzQuery do
|
|
begin
|
|
Connection := fcon;
|
|
SQL.Text:=ASQL;
|
|
Open;
|
|
|
|
end;
|
|
end;
|
|
|
|
function TNIDBDM.CheckUser(const login, password: string; out UserID: integer
|
|
): boolean;
|
|
begin
|
|
log(mtInfo,self,'CheckUser '+login);
|
|
UserID := QueryIntValue(format('Select coalesce((select min(p.mid) from people p where login=%s and password=%s),0) ',[StringAsSQL(login),StringAsSQl(password)]));
|
|
result := UserID>0;
|
|
end;
|
|
|
|
procedure TNIDBDM.OpenConnection;
|
|
begin
|
|
log(mtDebug,self,format('OpenConnection %s:%d',[connection.RemoteHost,connection.RemotePort]));
|
|
fcon.Connected:=true;
|
|
fcon.Identify;
|
|
end;
|
|
|
|
procedure TNIDBDM.log(ALevel: TLogLevel; Sender: TObject; msg: string);
|
|
begin
|
|
if assigned(flogger) then
|
|
flogger(ALevel,Sender,msg);
|
|
end;
|
|
|
|
procedure TNIDBDM.LogError(Sender: TObject; e: Exception; msg: string);
|
|
begin
|
|
log(mtERROR,Sender,'!!ERROT at '+msg+#13#10+e.ClassName+#13#10+e.message);
|
|
end;
|
|
|
|
procedure TNIDBDM.ExecuteSQL(ASQL: string);
|
|
begin
|
|
log(mtDebug,self,'ExecuteSQL '+ASQL);
|
|
CheckConnection;
|
|
connection.ExecuteSQL(ASQL);
|
|
end;
|
|
|
|
constructor TNIDBDM.CreateWithLogger(ALogger: TLogger);
|
|
begin
|
|
fLogger := ALogger;
|
|
log(mtDebug,nil,'TNIDBDM.Create');
|
|
inherited Create(nil);
|
|
end;
|
|
|
|
end.
|
|
|