Changeset 359 for tools/dbc_export/USqlDatabase.pas

Timestamp:

Mar 5, 2010, 8:46:18 AM (15 years ago)

Author:

george

Message:

• Upraveno: V třída TSqlDatabase doplněn výběr kódování spojení, přidáno generování vyjímky při chybném dotazu.
• Opraveno: Objekty vracející metodou Query je nutno uvolňovat.

File:

• tools/dbc_export/USqlDatabase.pas (modified) (27 diffs)

tools/dbc_export/USqlDatabase.pas

@@ -1 +1 @@
 unit USqlDatabase;
 
-{$mode delphi}{$H+}
+{$mode Delphi}{$H+}
+// Upraveno: 16.12.2009
 
 interface
 
 uses
-  SysUtils, Classes, mysql50, TypInfo;
+  SysUtils, Classes, Dialogs, mysql50, TypInfo;
 
 type
+  EQueryError = Exception;
+
   TClientCapabilities = (_CLIENT_LONG_PASSWORD, _CLIENT_FOUND_ROWS,
     _CLIENT_LONG_FLAG, _CLIENT_CONNECT_WITH_DB, _CLIENT_NO_SCHEMA,
@@ -16 +19 @@
   TSetClientCapabilities = set of TClientCapabilities;
 
-  TAssocArray = class(TStringList)
+  TAssociativeArray = class(TStringList)
   private
     function GetValues(Index: string): string;
@@ -32 +35 @@
   TDbRows = class(TList)
   private
-    function GetData(Index: Integer): TAssocArray;
-    procedure SetData(Index: Integer; const Value: TAssocArray);
+    function GetData(Index: Integer): TAssociativeArray;
+    procedure SetData(Index: Integer; const Value: TAssociativeArray);
   public
-    property Data[Index: Integer]: TAssocArray read GetData write SetData; default;
+    property Data[Index: Integer]: TAssociativeArray read GetData write SetData; default;
     destructor Destroy; override;
   end;
@@ -44 +47 @@
     FSession: PMYSQL;
     FConnected: Boolean;
-    FOnError: TNotifyEvent;
     FDatabase: string;
     function GetConnected: Boolean;
@@ -57 +59 @@
     UserName: string;
     Password: string;
+    Encoding: string;
     Table: string;
     RepeatLastAction: Boolean;
@@ -62 +65 @@
     procedure CreateDatabase;
     procedure CreateTable(Name: string);
-    procedure CreateColumn(ATable, ColumnName: string; ColumnType: TTypeKind);
+    procedure CreateColumn(Table, ColumnName: string; ColumnType: TTypeKind);
     function Query(Data: string): TDbRows;
     function Select(ATable: string; Filter: string = '*'; Condition: string = '1'): TDbRows;
     procedure Delete(ATable: string; Condition: string = '1');
-    procedure Insert(ATable: string; Data: TAssocArray);
-    procedure Update(ATable: string; Data: TAssocArray; Condition: string = '1');
-    procedure Replace(ATable: string; Data: TAssocArray);
+    procedure Insert(ATable: string; Data: TAssociativeArray);
+    procedure Update(ATable: string; Data: TAssociativeArray; Condition: string = '1');
+    procedure Replace(ATable: string; Data: TAssociativeArray);
     procedure Connect;
     procedure Disconnect;
@@ -75 +78 @@
     property LastErrorNumber: Integer read GetLastErrorNumber;
     property Connected: Boolean read GetConnected;
-    property OnError: TNotifyEvent read FOnError write FOnError;
     constructor Create;
     destructor Destroy; override;
@@ -84 +86 @@
   function MySQLFloatToStr(F: Real): string;
   function MySQLStrToFloat(S: string): Real;
-  function MySQLDateToDateTime(Date: string): TDateTime;
 
 implementation
@@ -107 +108 @@
 { TDataModule2 }
 
-function MySQLDateToDateTime(Date: string): TDateTime;
-begin
-  Result := 0;
-end;
-
 function MySQLFloatToStr(F: Real): string;
 var
@@ -117 +113 @@
 begin
   S := FloatToStr(F);
-  if Pos(',',S) > 0 then S[Pos(',',S)] := '.';
+  if Pos(',', S) > 0 then S[Pos(',',S)] := '.';
   Result := S;
 end;
@@ -123 +119 @@
 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;
@@ -143 +139 @@
   end else FConnected := False;
   CheckError;
-  Rows := Query('SET NAMES cp1250');
+  Rows := Query('SET NAMES ' + Encoding);
   Rows.Free;
 end;
 
-procedure TSqlDatabase.Insert(ATable: string; Data: TAssocArray);
+procedure TSqlDatabase.Insert(ATable: string; Data: TAssociativeArray);
 var
   DbNames: string;
@@ -153 +149 @@
   I: Integer;
   Value: string;
-  DbRows: TDbRows;
+  DbResult: TDbRows;
 begin
   Table := ATable;
   DbNames := '';
   DbValues := '';
-  for I := 0 to Data.Count-1 do begin
+  for I := 0 to Data.Count - 1 do begin
     Value := Data.ValuesAtIndex[I];
     StringReplace(Value, '"', '\"', [rfReplaceAll]);
@@ -167 +163 @@
   System.Delete(DbNames, 1, 1);
   System.Delete(DbValues, 1, 1);
-  DbRows := Query('INSERT INTO `' + Table + '` (' + DbNames + ') VALUES (' + DbValues + ')');
-  DbRows.Free;
+  DbResult := Query('INSERT INTO `' + Table + '` (' + DbNames + ') VALUES (' + DbValues + ')');
+  DbResult.Free;
 end;
 
@@ -176 +172 @@
   DbResult: PMYSQL_RES;
   DbRow: MYSQL_ROW;
-type
-  PMYSQL_ROW2 = ^TMYSQL_ROW2;  // return data as array of strings
-  TMYSQL_ROW2 = array[0..MaxInt div SizeOf(pChar) - 1] of pChar;
 begin
   //DebugLog('SqlDatabase query: '+Data);
@@ -194 +187 @@
     if Assigned(DbResult) then begin
       Result.Count := mysql_num_rows(DbResult);
-      for I := 0 to Result.Count-1 do begin
+      for I := 0 to Result.Count - 1 do begin
         DbRow := mysql_fetch_row(DbResult);
-        Result[I] := TAssocArray.Create;
+        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 + PMYSQL_ROW2(DbRow)^[II]);
+          for II := 0 to mysql_num_fields(DbResult) - 1 do begin
+            Add(mysql_fetch_field_direct(DbResult, II)^.Name +
+              NameValueSeparator + PChar((DbRow + II)^));
           end;
         end;
@@ -215 +209 @@
 end;
 
-procedure TSqlDatabase.Replace(ATable: string; Data: TAssocArray);
+procedure TSqlDatabase.Replace(ATable: string; Data: TAssociativeArray);
 var
   DbNames: string;
@@ -221 +215 @@
   Value: string;
   I: Integer;
-  DbRows: TDbRows;
+  DbResult: TDbRows;
 begin
   Table := ATable;
   DbNames := '';
   DbValues := '';
-  for I := 0 to Data.Count-1 do begin
+  for I := 0 to Data.Count - 1 do begin
     Value := Data.ValuesAtIndex[I];
     StringReplace(Value, '"', '\"', [rfReplaceAll]);
@@ -235 +229 @@
   System.Delete(DbNames, 1, 1);
   System.Delete(DbValues, 1, 1);
-  DbRows := Query('REPLACE INTO `' + Table + '` (' + DbNames + ') VALUES (' + DbValues + ')');
-  DbRows.Free;
+  DbResult := Query('REPLACE INTO `' + Table + '` (' + DbNames + ') VALUES (' + DbValues + ')');
+  DbResult.Free;
 end;
 
@@ -245 +239 @@
 end;
 
-procedure TSqlDatabase.Update(ATable: string; Data: TAssocArray; Condition: string = '1');
+procedure TSqlDatabase.Update(ATable: string; Data: TAssociativeArray; Condition: string = '1');
 var
   DbValues: string;
   Value: string;
   I: Integer;
-  DbRows: TDbRows;
+  DbResult: TDbRows;
 begin
   Table := ATable;
   DbValues := '';
-  for I := 0 to Data.Count-1 do begin
+  for I := 0 to Data.Count - 1 do begin
     Value := Data.ValuesAtIndex[I];
     StringReplace(Value, '"', '\"', [rfReplaceAll]);
@@ -261 +255 @@
   end;
   System.Delete(DbValues, 1, 1);
-  DbRows := Query('UPDATE `' + Table + '` SET (' + DbValues + ') WHERE ' + Condition);
-  DBRows.Free;
+  DbResult := Query('UPDATE `' + Table + '` SET (' + DbValues + ') WHERE ' + Condition);
+  DbResult.Free;
 end;
 
@@ -272 +266 @@
 { TAssocArray }
 
-procedure TAssocArray.AddKeyValue(Key, Value: string);
+procedure TAssociativeArray.AddKeyValue(Key, Value: string);
 begin
   Add(Key + NameValueSeparator + Value);
 end;
 
-constructor TAssocArray.Create;
+constructor TAssociativeArray.Create;
 begin
   NameValueSeparator := '|';
 end;
 
-destructor TAssocArray.Destroy;
+destructor TAssociativeArray.Destroy;
 begin
   inherited;
 end;
 
-function TAssocArray.GetAllValues: string;
+function TAssociativeArray.GetAllValues: string;
 var
   I: Integer;
 begin
   Result := '';
-  for I := 0 to Count-1 do begin
+  for I := 0 to Count - 1 do begin
     Result := Result + Names[I] + '=' + ValuesAtIndex[I] + ',';
   end;
 end;
 
-function TAssocArray.GetValues(Index: string): string;
+function TAssociativeArray.GetValues(Index: string): string;
 begin
   Result := inherited Values[Index];
 end;
 
-function TAssocArray.GetValuesAtIndex(Index: Integer): string;
+function TAssociativeArray.GetValuesAtIndex(Index: Integer): string;
 begin
   Result := inherited Values[Names[Index]];
@@ -309 +303 @@
 procedure TSqlDatabase.Delete(ATable: string; Condition: string = '1');
 var
-  DbRows: TDbRows;
+  DbResult: TDbRows;
 begin
   Table := ATable;
-  DbRows := Query('DELETE FROM `' + Table + '` WHERE ' + Condition);
-  DbRows.Free;
+  DbResult = Query('DELETE FROM `' + Table + '` WHERE ' + Condition);
+  DbResult.Free;
 end;
 
@@ -331 +325 @@
   inherited;
   FSession := nil;
-end;
-
-procedure TAssocArray.SetValues(Index: string; const Value: string);
+  Encoding := 'utf8';
+end;
+
+procedure TAssociativeArray.SetValues(Index: string; const Value: string);
 begin
   inherited Values[Index] := Value;
@@ -344 +339 @@
   I: Integer;
 begin
-  for I := 0 to Count - 1 do Data[I].Free;
+  for I := 0 to Count - 1 do
+    Data[I].Free;
   inherited;
 end;
 
-function TDbRows.GetData(Index: Integer): TAssocArray;
+function TDbRows.GetData(Index: Integer): TAssociativeArray;
 begin
   Result := Items[Index];
 end;
 
-procedure TDbRows.SetData(Index: Integer; const Value: TAssocArray);
+procedure TDbRows.SetData(Index: Integer; const Value: TAssociativeArray);
 begin
   Items[Index] := Value;
@@ -376 +372 @@
 begin
   Result := LastErrorNumber <> 0;
-  if Result and Assigned(OnError) then OnError(Self);
+  if Result then
+    raise EQueryError.Create('Database query error: "' + LastErrorMessage + '"');
 end;
 
@@ -394 +391 @@
 begin
   Query('CREATE TABLE `' + Name + '`' +
-  ' (`id` INT NOT NULL AUTO_INCREMENT, PRIMARY KEY (`id`));');
-end;
-
-procedure TSqlDatabase.CreateColumn(ATable, ColumnName: string;
+  ' (`Id` INT NOT NULL AUTO_INCREMENT, PRIMARY KEY (`Id`));');
+end;
+
+procedure TSqlDatabase.CreateColumn(Table, ColumnName: string;
   ColumnType: TTypeKind);
 const