Changeset 7 for trunk/Common/USqlDatabase.pas

Timestamp:

Dec 25, 2010, 9:53:55 PM (14 years ago)

Author:

george

Message:

• Updated: USqlDatabase library.
• Added: Dependency to TemplateGenerics package.
• Modified: Rest of czech strings translated to english.

File:

• trunk/Common/USqlDatabase.pas (modified) (20 diffs)

trunk/Common/USqlDatabase.pas

@@ -2 +2 @@
 
 {$mode Delphi}{$H+}
-// Upraveno: 30.5.2010
+
+// Modified: 2010-12-24
 
 interface
 
 uses
-  SysUtils, Classes, Dialogs, mysql50, TypInfo;
+  SysUtils, Classes, Dialogs, mysql50, TypInfo,
+  SpecializedDictionary, SpecializedList;
 
 type
-  EQueryError = Exception;
+  EQueryError = class(Exception);
 
   TClientCapabilities = (_CLIENT_LONG_PASSWORD, _CLIENT_FOUND_ROWS,
@@ -19 +21 @@
   TSetClientCapabilities = set of TClientCapabilities;
 
-  TAssociativeArray = class(TStringList)
+  TDbRows = class(TListObject)
   private
-    function GetValues(Index: string): string;
-    function GetValuesAtIndex(Index: Integer): string;
-    procedure SetValues(Index: string; const Value: string);
+    function GetData(Index: Integer): TDictionaryStringString;
+    procedure SetData(Index: Integer; const Value: TDictionaryStringString);
   public
-    constructor Create;
-    destructor Destroy; override;
-    function GetAllValues: string;
-    procedure AddKeyValue(Key, Value: string);
-    property ValuesAtIndex[Index: Integer]: string read GetValuesAtIndex;
-    property Values[Index: string]: string read GetValues write SetValues; default;
-  end;
-
-  TDbRows = class(TList)
-  private
-    function GetData(Index: Integer): TAssociativeArray;
-    procedure SetData(Index: Integer; const Value: TAssociativeArray);
-  public
-    property Data[Index: Integer]: TAssociativeArray read GetData write SetData; default;
+    property Data[Index: Integer]: TDictionaryStringString read GetData write SetData; default;
     destructor Destroy; override;
   end;
@@ -51 +39 @@
     function GetLastErrorMessage: string;
     function GetLastErrorNumber: Integer;
-    function CheckError: Boolean;
     function GetCharset: string;
-    procedure SetSchema(const Value: string);
+    procedure SetDatabase(const Value: string);
   public
     Hostname: string;
@@ -65 +52 @@
     procedure CreateTable(Name: string);
     procedure CreateColumn(Table, ColumnName: string; ColumnType: TTypeKind);
-    function Query(Data: string): TDbRows;
-    function Select(ATable: string; Filter: string = '*'; Condition: string = '1'): TDbRows;
+    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 Insert(ATable: string; Data: TAssociativeArray);
-    procedure Update(ATable: string; Data: TAssociativeArray; Condition: string = '1');
-    procedure Replace(ATable: string; Data: TAssociativeArray);
+    procedure Insert(ATable: string; Data: TDictionaryStringString);
+    procedure Update(ATable: string; Data: TDictionaryStringString; Condition: string = '1');
+    procedure Replace(ATable: string; Data: TDictionaryStringString);
     procedure Connect;
     procedure Disconnect;
@@ -80 +67 @@
     destructor Destroy; override;
     property Charset: string read GetCharset;
-    property Schema: string read FDatabase write SetSchema;
+    property Database: string read FDatabase write SetDatabase;
   end;
 
   function MySQLFloatToStr(F: Real): string;
   function MySQLStrToFloat(S: string): Real;
+  function SQLToDateTime(Value: string): TDateTime;
+  function DateTimeToSQL(Value: TDateTime): string;
 
 implementation
 
-uses DateUtils;
+uses
+  DateUtils, Math;
+
+resourcestring
+  SDatabaseQueryError = 'Database query error: "%s"';
 
 const
@@ -105 +98 @@
   CLIENT_TRANSACTIONS = 8192;    // Client knows about transactions
 
-{ TDataModule2 }
-
 function MySQLFloatToStr(F: Real): string;
 var
@@ -112 +103 @@
 begin
   S := FloatToStr(F);
-  if Pos(',', S) > 0 then S[Pos(',',S)] := '.';
+  if Pos(',', S) > 0 then S[Pos(',', S)] := '.';
   Result := S;
 end;
@@ -118 +109 @@
 function MySQLStrToFloat(S: string): Real;
 begin
-  if Pos('.', S) > 0 then  S[Pos('.',S)] := ',';
+  if Pos('.', S) > 0 then S[Pos('.', S)] := ',';
   Result := StrToFloat(S);
 end;
+
+function StrToStr(Value: string): string;
+begin
+  Result := Value;
+end;
+
+function SQLToDateTime(Value: string): TDateTime;
+var
+  Parts: TListString;
+  DateParts: TListString;
+  TimeParts: TListString;
+begin
+  try
+    Parts := TListString.Create;
+    DateParts := TListString.Create;
+    TimeParts := TListString.Create;
+
+    Parts.Explode(Value, ' ', StrToStr);
+    DateParts.Explode(Parts[0], '-', StrToStr);
+    Result := EncodeDate(StrToInt(DateParts[0]), StrToInt(DateParts[1]),
+      StrToInt(DateParts[2]));
+    if Parts.Count > 1 then begin
+      TimeParts.Explode(Parts[1], ':', StrToStr);
+      Result := Result + EncodeTime(StrToInt(TimeParts[0]), StrToInt(TimeParts[1]),
+        StrToInt(TimeParts[2]), 0);
+    end;
+  finally
+    DateParts.Free;
+    TimeParts.Free;
+    Parts.Free;
+  end;
+end;
+
+function DateTimeToSQL(Value: TDateTime): string;
+begin
+  Result := FormatDateTime('yyyy-mm-dd hh.nn.ss', Value);
+end;
+
+{ TSqlDatabase }
 
 procedure TSqlDatabase.Connect;
@@ -132 +162 @@
 //  FSession.charset := 'latin2';
   NewSession := mysql_real_connect(FSession, PChar(HostName), PChar(UserName),
-    PChar(Password), PChar(Schema), 3306, nil, CLIENT_LONG_PASSWORD + CLIENT_CONNECT_WITH_DB);
+    PChar(Password), PChar(Database), 3306, nil, CLIENT_LONG_PASSWORD + CLIENT_CONNECT_WITH_DB);
   if Assigned(NewSession) then begin
     FConnected := True;
     FSession := NewSession;
   end else FConnected := False;
-  CheckError;
-  Rows := Query('SET NAMES ' + Encoding);
-  Rows.Free;
-end;
-
-procedure TSqlDatabase.Insert(ATable: string; Data: TAssociativeArray);
+
+  if LastErrorNumber <> 0 then
+    raise EQueryError.Create(Format(SDatabaseQueryError, [LastErrorMessage]));
+
+  try
+    Rows := TDbRows.Create;
+    Query(Rows, 'SET NAMES ' + Encoding);
+  finally
+    Rows.Free;
+  end;
+end;
+
+procedure TSqlDatabase.Insert(ATable: string; Data: TDictionaryStringString);
 var
   DbNames: string;
@@ -154 +191 @@
   DbValues := '';
   for I := 0 to Data.Count - 1 do begin
-    Value := Data.ValuesAtIndex[I];
+    Value := Data.Items[I].Value;
     StringReplace(Value, '"', '\"', [rfReplaceAll]);
     if Value = 'NOW()' then DbValues := DbValues + ',' + Value
     else DbValues := DbValues + ',"' + Value + '"';
-    DbNames := DbNames + ',`' + Data.Names[I] + '`';
+    DbNames := DbNames + ',`' + Data.Keys[I] + '`';
   end;
   System.Delete(DbNames, 1, 1);
   System.Delete(DbValues, 1, 1);
-  DbResult := Query('INSERT INTO `' + Table + '` (' + DbNames + ') VALUES (' + DbValues + ')');
-  DbResult.Free;
-end;
-
-function TSqlDatabase.Query(Data: string): TDbRows;
+  try
+    DbResult := TDbRows.Create;
+    Query(DbResult, 'INSERT INTO `' + Table + '` (' + DbNames + ') VALUES (' + DbValues + ')');
+  finally
+    DbResult.Free;
+  end;
+end;
+
+procedure TSqlDatabase.Query(DbRows: TDbRows; Data: string);
 var
   I, II: Integer;
@@ -172 +213 @@
   DbRow: MYSQL_ROW;
 begin
+  DbRows.Clear;
   //DebugLog('SqlDatabase query: '+Data);
   RepeatLastAction := False;
   LastQuery := Data;
-  //if not Connected then NastaveniPripojeni.ShowModal;
-  Result := TDbRows.Create;
-  //repeat
   mysql_query(FSession, PChar(Data));
-  //until not
-  CheckError;
-  //if not CheckError then
-  begin
-    DbResult := mysql_store_result(FSession);
-    if Assigned(DbResult) then begin
-      Result.Count := mysql_num_rows(DbResult);
-      for I := 0 to Result.Count - 1 do begin
-        DbRow := mysql_fetch_row(DbResult);
-        Result[I] := TAssociativeArray.Create;
-        with Result[I] do begin
-          for II := 0 to mysql_num_fields(DbResult) - 1 do begin
-            Add(mysql_fetch_field_direct(DbResult, II)^.Name +
-              NameValueSeparator + PChar((DbRow + II)^));
+  if LastErrorNumber <> 0 then begin
+    raise EQueryError.Create(Format(SDatabaseQueryError, [LastErrorMessage]));
+  end;
+
+  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)^));
           end;
         end;
       end;
-    end;
   end;
   mysql_free_result(DbResult);
-  (*
-  if Assigned(DatabaseIntegrity) then
-  with DatabaseIntegrity do if not Checking then begin
-    Check;
-    DebugLog('Database integrity: Unreferenced='+IntToStr(Unreferenced)+' BadReferences='+IntToStr(BadReferences));
-  end;
-  *)
-end;
-
-procedure TSqlDatabase.Replace(ATable: string; Data: TAssociativeArray);
+end;
+
+procedure TSqlDatabase.Replace(ATable: string; Data: TDictionaryStringString);
 var
   DbNames: string;
@@ -220 +251 @@
   DbValues := '';
   for I := 0 to Data.Count - 1 do begin
-    Value := Data.ValuesAtIndex[I];
+    Value := Data.Items[I].Value;
     StringReplace(Value, '"', '\"', [rfReplaceAll]);
     if Value = 'NOW()' then DbValues := DbValues + ',' + Value
     else DbValues := DbValues + ',"' + Value + '"';
-    DbNames := DbNames + ',`' + Data.Names[I] + '`';
+    DbNames := DbNames + ',`' + Data.Keys[I] + '`';
   end;
   System.Delete(DbNames, 1, 1);
   System.Delete(DbValues, 1, 1);
-  DbResult := Query('REPLACE INTO `' + Table + '` (' + DbNames + ') VALUES (' + DbValues + ')');
-  DbResult.Free;
-end;
-
-function TSqlDatabase.Select(ATable: string; Filter: string = '*'; Condition: string = '1'): TDbRows;
+  try
+    DbResult := TDbRows.Create;
+    Query(DbResult, 'REPLACE INTO `' + Table + '` (' + DbNames + ') VALUES (' + DbValues + ')');
+  finally
+    DbResult.Free;
+  end;
+end;
+
+procedure TSqlDatabase.Select(DbRows: TDbRows; ATable: string; Filter: string = '*'; Condition: string = '1');
 begin
   Table := ATable;
-  Result := Query('SELECT ' + Filter + ' FROM `' + Table + '` WHERE '+Condition);
-end;
-
-procedure TSqlDatabase.Update(ATable: string; Data: TAssociativeArray; Condition: string = '1');
+  Query(DbRows, 'SELECT ' + Filter + ' FROM `' + Table + '` WHERE ' + Condition);
+end;
+
+procedure TSqlDatabase.Update(ATable: string; Data: TDictionaryStringString; Condition: string = '1');
 var
   DbValues: string;
@@ -248 +283 @@
   DbValues := '';
   for I := 0 to Data.Count - 1 do begin
-    Value := Data.ValuesAtIndex[I];
+    Value := Data.Items[I].Value;
     StringReplace(Value, '"', '\"', [rfReplaceAll]);
     if Value = 'NOW()' then DbValues := DbValues + ',' + Value
-    else DbValues := DbValues + ',' + Data.Names[I] + '=' + '"' + Value + '"';
+    else DbValues := DbValues + ',' + Data.Keys[I] + '=' + '"' + Value + '"';
   end;
   System.Delete(DbValues, 1, 1);
-  DbResult := Query('UPDATE `' + Table + '` SET (' + DbValues + ') WHERE ' + Condition);
-  DbResult.Free;
+  try
+    DbResult := TDbRows.Create;
+    Query(DbResult, 'UPDATE `' + Table + '` SET (' + DbValues + ') WHERE ' + Condition);
+  finally
+    DbResult.Free;
+  end;
 end;
 
@@ -263 +302 @@
 end;
 
-{ TAssocArray }
-
-procedure TAssociativeArray.AddKeyValue(Key, Value: string);
-begin
-  Add(Key + NameValueSeparator + Value);
-end;
-
-constructor TAssociativeArray.Create;
-begin
-  NameValueSeparator := '|';
-end;
-
-destructor TAssociativeArray.Destroy;
-begin
-  inherited;
-end;
-
-function TAssociativeArray.GetAllValues: string;
-var
-  I: Integer;
-begin
-  Result := '';
-  for I := 0 to Count - 1 do begin
-    Result := Result + Names[I] + '=' + ValuesAtIndex[I] + ',';
-  end;
-end;
-
-function TAssociativeArray.GetValues(Index: string): string;
-begin
-  Result := inherited Values[Index];
-end;
-
-function TAssociativeArray.GetValuesAtIndex(Index: Integer): string;
-begin
-  Result := inherited Values[Names[Index]];
-end;
-
 procedure TSqlDatabase.Delete(ATable: string; Condition: string = '1');
 var
@@ -305 +307 @@
 begin
   Table := ATable;
-  DbResult := Query('DELETE FROM `' + Table + '` WHERE ' + Condition);
-  DbResult.Free;
+  try
+    DbResult := TDbRows.Create;
+    Query(DbResult, 'DELETE FROM `' + Table + '` WHERE ' + Condition);
+  finally
+    DbResult.Free;
+  end;
 end;
 
@@ -327 +333 @@
 end;
 
-procedure TAssociativeArray.SetValues(Index: string; const Value: string);
-begin
-  inherited Values[Index] := Value;
-end;
-
-{ TDbRows }
-
-destructor TDbRows.Destroy;
-var
-  I: Integer;
-begin
-  for I := 0 to Count - 1 do
-    Data[I].Free;
-  inherited;
-end;
-
-function TDbRows.GetData(Index: Integer): TAssociativeArray;
-begin
-  Result := Items[Index];
-end;
-
-procedure TDbRows.SetData(Index: Integer; const Value: TAssociativeArray);
-begin
-  Items[Index] := Value;
-end;
-
 function TSqlDatabase.LastInsertId: Integer;
 begin
@@ -368 +348 @@
 end;
 
-function TSqlDatabase.CheckError: Boolean;
-begin
-  Result := LastErrorNumber <> 0;
-  if Result then
-    raise EQueryError.Create('Database query error: "' + LastErrorMessage + '"');
-end;
-
 procedure TSqlDatabase.CreateDatabase;
 var
   TempDatabase: string;
-begin
-  TempDatabase := Schema;
-  Schema := 'mysql';
+  DbRows: TDbRows;
+begin
+  TempDatabase := Database;
+  Database := 'mysql';
   Connect;
-  Query('CREATE DATABASE ' + TempDatabase);
+  try
+    DbRows := TDbRows.Create;
+    Query(DbRows, 'CREATE DATABASE ' + TempDatabase);
+  finally
+    DbRows.Free;
+  end;
   Disconnect;
-  Schema := TempDatabase;
+  Database := TempDatabase;
 end;
 
 procedure TSqlDatabase.CreateTable(Name: string);
-begin
-  Query('CREATE TABLE `' + Name + '`' +
-  ' (`Id` INT NOT NULL AUTO_INCREMENT, PRIMARY KEY (`Id`));');
+var
+  DbRows: TDbRows;
+begin
+  try
+    DbRows := TDbRows.Create;
+    Query(DbRows, 'CREATE TABLE `' + Name + '`' +
+    ' (`Id` INT NOT NULL AUTO_INCREMENT, PRIMARY KEY (`Id`));');
+  finally
+    DbRows.Free;
+  end;
 end;
 
@@ -398 +384 @@
   ColTypes: array[0..17] of string = ('', 'INT', 'CHAR', 'INT', 'DOUBLE',
   'VARCHAR(255)', 'SET', 'INT', '', '', 'TEXT', 'TEXT', '', '', '', '', '', '');
-begin
-  Query('ALTER TABLE `' + Table + '` ADD `' + ColumnName + '` ' +
-    ColTypes[Integer(ColumnType)] + ' NOT NULL');
+var
+  DbRows: TDbRows;
+begin
+  try
+    DbRows := TDbRows.Create;
+    Query(DbRows, 'ALTER TABLE `' + Table + '` ADD `' + ColumnName + '` ' +
+      ColTypes[Integer(ColumnType)] + ' NOT NULL');
+  finally
+    DbRows.Free;
+  end;
 end;
 
@@ -413 +406 @@
 end;
 
-procedure TSqlDatabase.SetSchema(const Value: string);
+procedure TSqlDatabase.SetDatabase(const Value: string);
 begin
   FDatabase := Value;
@@ -419 +412 @@
 end;
 
+{ TDbRows }
+
+destructor TDbRows.Destroy;
+begin
+  inherited;
+end;
+
+function TDbRows.GetData(Index: Integer): TDictionaryStringString;
+begin
+  Result := TDictionaryStringString(Items[Index]);
+end;
+
+procedure TDbRows.SetData(Index: Integer; const Value: TDictionaryStringString);
+begin
+  Items[Index] := Value;
+end;
+
 end.