Changeset 26 for trunk/Packages/Database/USqlDatabase.pas

Timestamp:

Sep 10, 2022, 8:03:08 PM (2 years ago)

Author:

chronos

Message:

• Removed: TemplateGenerics as required package. Used Generics.Collections instead.

Location:

trunk

Files:

• . (modified) (1 prop)
• Packages/Database/USqlDatabase.pas (modified) (18 diffs)

trunk

@@ -7 +7 @@
 heaptrclog.trc
 MyData.exe
+MyData.dbg
+

@@ -7 +7 @@
 heaptrclog.trc
 MyData.exe
+MyData.dbg
+

trunk/Packages/Database/USqlDatabase.pas

@@ -1 +1 @@
 unit USqlDatabase;
 
-{$mode Delphi}{$H+}
-
-// Modified: 2010-12-24
+// Modified: 2022-09-08
 
 interface
 
 uses
-  SysUtils, Classes, Dialogs, mysql57dyn, TypInfo,
-  SpecializedDictionary, SpecializedList;
+  SysUtils, Classes, Dialogs, mysql50, TypInfo, UGenerics, Generics.Collections;
 
 type
@@ -23 +20 @@
   TLogEvent = procedure(Sender: TObject; Text: string) of object;
 
-  TDbRows = class(TListObject)
+  TDbRows = class(TList<TDictionaryStringString>)
   private
     function GetData(Index: Integer): TDictionaryStringString;
@@ -52 +49 @@
     procedure SetConnected(const AValue: Boolean);
     procedure SetDatabase(const Value: string);
+    procedure SetEncoding(AValue: string);
   public
     LastUsedTable: string;
     LastQuery: string;
+    function EscapeString(Text: string): string;
     procedure CreateDatabase;
     procedure CreateTable(Name: string);
     procedure CreateColumn(Table, ColumnName: string; ColumnType: TTypeKind);
     procedure Query(DbRows: TDbRows; Data: string);
-    procedure Select(DbRows: TDbRows; ATable: string; Filter: string = '*'; Condition: string = '1');
-    procedure Delete(ATable: string; Condition: string = '1';
+    procedure Select(DbRows: TDbRows; ATable: string; Filter: string = '*';
+      Condition: string = '');
+    procedure Delete(ATable: string; Condition: string = '';
       Schema: string = '');
     procedure Insert(ATable: string; Data: TDictionaryStringString;
       Schema: string = '');
     procedure Update(ATable: string; Data: TDictionaryStringString;
-      Condition: string = '1'; Schema: string = '');
+      Condition: string = ''; Schema: string = '');
     procedure Replace(ATable: string; Data: TDictionaryStringString;
       Schema: string = '');
@@ -83 +83 @@
     property Password: string read FPassword write FPassword;
     property Port: Word read FPort write FPort;
-    property Encoding: string read FEncoding write FEncoding;
+    property Encoding: string read FEncoding write SetEncoding;
     property OnLogQuery: TLogEvent read FOnLogQuery write FOnLogQuery;
   end;
@@ -98 +98 @@
 
 uses
-  DateUtils, Math;
+  DateUtils;
 
 resourcestring
@@ -149 +149 @@
   TimeParts: TListString;
 begin
-  if Value = '' then Result := 0 else
   try
     Parts := TListString.Create;
@@ -155 +154 @@
     TimeParts := TListString.Create;
 
-    Parts.Explode(Value, ' ', StrToStr);
-    DateParts.Explode(Parts[0], '-', StrToStr);
-    if (StrToInt(DateParts[0]) = 0) or (StrToInt(DateParts[1]) = 0) or
-    (StrToInt(DateParts[2]) = 0) then Result := 0 else
+    Parts.Explode(' ', Value);
+    DateParts.Explode('-', Parts[0]);
     Result := EncodeDate(StrToInt(DateParts[0]), StrToInt(DateParts[1]),
       StrToInt(DateParts[2]));
     if Parts.Count > 1 then begin
-      TimeParts.Explode(Parts[1], ':', StrToStr);
+      TimeParts.Explode(':', Parts[1]);
       Result := Result + EncodeTime(StrToInt(TimeParts[0]), StrToInt(TimeParts[1]),
         StrToInt(TimeParts[2]), 0);
@@ -185 +182 @@
   Rows: TDbRows;
 begin
-//  mySQLClient1.Connect;
   FSession := mysql_init(FSession);
-//  FSession.charset := 'latin2';
   NewSession := mysql_real_connect(FSession, PChar(HostName), PChar(UserName),
     PChar(Password), PChar(Database), FPort, nil, CLIENT_LONG_PASSWORD + CLIENT_CONNECT_WITH_DB);
@@ -200 +195 @@
   try
     Rows := TDbRows.Create;
-    Query(Rows, 'SET NAMES ' + Encoding);
+    Query(Rows, 'SET NAMES ' + FEncoding);
   finally
     Rows.Free;
@@ -214 +209 @@
   Value: string;
   DbResult: TDbRows;
+  Item: TPair<string, string>;
 begin
   LastUsedTable := ATable;
   DbNames := '';
   DbValues := '';
-  for I := 0 to Data.Count - 1 do begin
-    Value := Data.Items[I].Value;
+  for Item in Data do begin
+    Value := Item.Value;
     StringReplace(Value, '"', '\"', [rfReplaceAll]);
     if Value = 'NOW()' then DbValues := DbValues + ',' + Value
     else DbValues := DbValues + ',"' + Value + '"';
-    DbNames := DbNames + ',`' + Data.Keys[I] + '`';
+    DbNames := DbNames + ',`' + Item.Key + '`';
   end;
   System.Delete(DbNames, 1, 1);
@@ -251 +247 @@
 
   DbResult := mysql_store_result(FSession);
-  if Assigned(DbResult) then begin
-    DbRows.Count := mysql_num_rows(DbResult);
-    for I := 0 to DbRows.Count - 1 do begin
-      DbRow := mysql_fetch_row(DbResult);
-      DbRows[I] := TDictionaryStringString.Create;
-      with DbRows[I] do begin
-        for II := 0 to mysql_num_fields(DbResult) - 1 do begin
-          Add(mysql_fetch_field_direct(DbResult, II)^.Name,
-            PChar((DbRow + II)^));
+  try
+    if Assigned(DbResult) then begin
+      DbRows.Count := mysql_num_rows(DbResult);
+      for I := 0 to DbRows.Count - 1 do begin
+        DbRow := mysql_fetch_row(DbResult);
+        DbRows[I] := TDictionaryStringString.Create;
+        with DbRows[I] do begin
+          for II := 0 to mysql_num_fields(DbResult) - 1 do begin
+            Add(mysql_fetch_field_direct(DbResult, II)^.Name,
+              PChar((DbRow + II)^));
           end;
         end;
       end;
-  end;
-  mysql_free_result(DbResult);
+    end;
+  finally
+    mysql_free_result(DbResult);
+  end;
 end;
 
@@ -275 +274 @@
   I: Integer;
   DbResult: TDbRows;
+  Item: TPair<string, string>;
 begin
   LastUsedTable := ATable;
   DbNames := '';
   DbValues := '';
-  for I := 0 to Data.Count - 1 do begin
-    Value := Data.Items[I].Value;
+  for Item in Data do begin
+    Value := Item.Value;
     StringReplace(Value, '"', '\"', [rfReplaceAll]);
     if Value = 'NOW()' then DbValues := DbValues + ',' + Value
     else DbValues := DbValues + ',"' + Value + '"';
-    DbNames := DbNames + ',`' + Data.Keys[I] + '`';
+    DbNames := DbNames + ',`' + Item.Key + '`';
   end;
   System.Delete(DbNames, 1, 1);
@@ -297 +297 @@
 end;
 
-procedure TSqlDatabase.Select(DbRows: TDbRows; ATable: string; Filter: string = '*'; Condition: string = '1');
+procedure TSqlDatabase.Select(DbRows: TDbRows; ATable: string; Filter: string = '*'; Condition: string = '');
+var
+  QueryText: string;
 begin
   LastUsedTable := ATable;
-  Query(DbRows, 'SELECT ' + Filter + ' FROM `' + ATable + '` WHERE ' + Condition);
+  QueryText := 'SELECT ' + Filter + ' FROM `' + ATable + '`';
+  if Condition <> '' then QueryText := QueryText + ' WHERE ' + Condition;
+  Query(DbRows, QueryText);
 end;
 
 procedure TSqlDatabase.Update(ATable: string; Data: TDictionaryStringString;
-  Condition: string = '1'; Schema: string = '');
-var
+  Condition: string = ''; Schema: string = '');
+var
+  QueryText: string;
   DbValues: string;
   Value: string;
   I: Integer;
   DbResult: TDbRows;
+  Item: TPair<string, string>;
 begin
   LastUsedTable := ATable;
   DbValues := '';
-  for I := 0 to Data.Count - 1 do begin
-    Value := Data.Items[I].Value;
+  for Item in Data do begin
+    Value := Item.Value;
     StringReplace(Value, '"', '\"', [rfReplaceAll]);
     if Value = 'NOW()' then DbValues := DbValues + ',' + Value
-    else DbValues := DbValues + ',`' + Data.Keys[I] + '` =' + '"' + Value + '"';
+    else DbValues := DbValues + ',`' + Item.Key + '` =' + '"' + Value + '"';
   end;
   System.Delete(DbValues, 1, 1);
@@ -323 +329 @@
     DbResult := TDbRows.Create;
     if Schema <> '' then Schema := '`' + Schema + '`.';
-    Query(DbResult, 'UPDATE ' + Schema + '`' + ATable + '` SET ' + DbValues + ' WHERE ' + Condition);
+    QueryText := 'UPDATE ' + Schema + '`' + ATable + '` SET ' + DbValues;
+    if Condition <> '' then QueryText := QueryText + ' WHERE ' + Condition;
+    Query(DbResult, QueryText);
   finally
     DbResult.Free;
@@ -334 +342 @@
 end;
 
-procedure TSqlDatabase.Delete(ATable: string; Condition: string = '1';
+procedure TSqlDatabase.Delete(ATable: string; Condition: string = '';
   Schema: string = '');
 var
+  QueryText: string;
   DbResult: TDbRows;
 begin
@@ -343 +352 @@
     DbResult := TDbRows.Create;
     if Schema <> '' then Schema := '`' + Schema + '`.';
-    Query(DbResult, 'DELETE FROM ' + Schema + '`' + ATable + '` WHERE ' + Condition);
+    QueryText := 'DELETE FROM ' + Schema + '`' + ATable + '`';
+    if Condition <> '' then QueryText := QueryText + ' WHERE ' + Condition;
+    Query(DbResult, QueryText);
   finally
     DbResult.Free;
@@ -454 +465 @@
 end;
 
+procedure TSqlDatabase.SetEncoding(AValue: string);
+var
+  Rows: TDbRows;
+begin
+  if FEncoding = AValue then Exit;
+  FEncoding := AValue;
+  if Connected then begin
+    try
+      Rows := TDbRows.Create;
+      Query(Rows, 'SET NAMES ' + FEncoding);
+    finally
+      Rows.Free;
+    end;
+  end;
+end;
+
+function TSqlDatabase.EscapeString(Text: string): string;
+var
+  L: Integer;
+begin
+  SetLength(Result, Length(Text) * 2 + 1);
+  L := mysql_real_escape_string(FSession, PChar(Result), PChar(Text), Length(Text));
+  SetLength(Result, L);
+end;
+
 { TDbRows }
 
@@ -473 +509 @@
 end.
 
-

@@ -7 +7 @@
 heaptrclog.trc
 MyData.exe
+MyData.dbg
+