Changeset 279 for branches/web/USqlDatabase.pas

Timestamp:

Mar 5, 2010, 8:52:50 PM (15 years ago)

Author:

george

Message:

• Upraveno: Aktualizována třída TSqlDatabase.
• Upraveno: Binární sestavené soubory se nyní vytváří v podsložce bin.

Location:

branches/web

Files:

• . (modified) (1 prop)
• USqlDatabase.pas (modified) (26 diffs)

branches/web

@@ -3 +3 @@
 *.o
 backup
-
 index.cgi
-
 index.compiled
-
 UConfig.pas
+bin

@@ -3 +3 @@
 *.o
 backup
-
 index.cgi
-
 index.compiled
-
 UConfig.pas
+bin

branches/web/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;
@@ -52 +54 @@
     function GetCharset: string;
     procedure SetDatabase(const Value: string);
-    { Private declarations }
   public
     Hostname: string;
     UserName: string;
     Password: string;
+    Encoding: string;
     Table: string;
     RepeatLastAction: Boolean;
@@ -62 +64 @@
     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 +77 @@
     property LastErrorNumber: Integer read GetLastErrorNumber;
     property Connected: Boolean read GetConnected;
-    property OnError: TNotifyEvent read FOnError write FOnError;
     constructor Create;
     destructor Destroy; override;
@@ -84 +85 @@
   function MySQLFloatToStr(F: Real): string;
   function MySQLStrToFloat(S: string): Real;
-  function MySQLDateToDateTime(Date: string): TDateTime;
 
 implementation
@@ -105 +105 @@
   CLIENT_TRANSACTIONS = 8192;    // Client knows about transactions
 
-{ TDataModule2 }
-
-function MySQLDateToDateTime(Date: string): TDateTime;
-begin
-  Result := 0;
-end;
-
 function MySQLFloatToStr(F: Real): string;
 var
@@ -117 +110 @@
 begin
   S := FloatToStr(F);
-  if Pos(',',S) > 0 then S[Pos(',',S)] := '.';
+  if Pos(',', S) > 0 then S[Pos(',',S)] := '.';
   Result := S;
 end;
@@ -123 +116 @@
 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;
+
+{ TSqlDatabase }
 
 procedure TSqlDatabase.Connect;
@@ -143 +138 @@
   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 +148 @@
   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 +162 @@
   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 +171 @@
   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 +186 @@
     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 +208 @@
 end;
 
-procedure TSqlDatabase.Replace(ATable: string; Data: TAssocArray);
+procedure TSqlDatabase.Replace(ATable: string; Data: TAssociativeArray);
 var
   DbNames: string;
@@ -221 +214 @@
   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 +228 @@
   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 +238 @@
 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 +254 @@
   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;
 
@@ -270 +263 @@
 end;
 
-{ TAssocArray }
-
-procedure TAssocArray.AddKeyValue(Key, Value: string);
-begin
-  Add(Key + NameValueSeparator + Value);
-end;
-
-constructor TAssocArray.Create;
-begin
-  NameValueSeparator := '|';
-end;
-
-destructor TAssocArray.Destroy;
-begin
-  inherited;
-end;
-
-function TAssocArray.GetAllValues: string;
-var
-  I: Integer;
-begin
-  Result := '';
-  for I := 0 to Count-1 do begin
-    Result := Result + Names[I] + '=' + ValuesAtIndex[I] + ',';
-  end;
-end;
-
-function TAssocArray.GetValues(Index: string): string;
-begin
-  Result := inherited Values[Index];
-end;
-
-function TAssocArray.GetValuesAtIndex(Index: Integer): string;
-begin
-  Result := inherited Values[Names[Index]];
-end;
-
 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 +287 @@
   inherited;
   FSession := nil;
-end;
-
-procedure TAssocArray.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): TAssocArray;
-begin
-  Result := Items[Index];
-end;
-
-procedure TDbRows.SetData(Index: Integer; const Value: TAssocArray);
-begin
-  Items[Index] := Value;
+  Encoding := 'utf8';
 end;
 
@@ -376 +308 @@
 begin
   Result := LastErrorNumber <> 0;
-  if Result and Assigned(OnError) then OnError(Self);
+  if Result then
+    raise EQueryError.Create('Database query error: "' + LastErrorMessage + '"');
 end;
 
@@ -394 +327 @@
 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
@@ -423 +356 @@
 end;
 
+{ TAssociativeArray }
+
+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 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;
+
 end.
 

@@ -3 +3 @@
 *.o
 backup
-
 index.cgi
-
 index.compiled
-
 UConfig.pas
+bin