Changeset 81


Ignore:
Timestamp:
Oct 30, 2010, 7:43:01 PM (14 years ago)
Author:
george
Message:
  • Deleted: Class ByteQueue deleted. Replaced by specialized generic class TQueueByte.
  • Modified: Class TSqlDatabase updated for use specialized generic class TDictionaryStringString instead of custom TAssociativeArray.
Files:
1 deleted
1 edited

Legend:

Unmodified
Added
Removed

  • Network/MysqlClient/USqlDatabase.pas

    r35 r81  
    22
    33{$mode Delphi}{$H+}
    4 // Upraveno: 16.12.2009
     4
     5// Upraveno: 28.10.2010
    56
    67interface
    78
    89uses
    9   SysUtils, Classes, Dialogs, mysql50, TypInfo;
     10  SysUtils, Classes, Dialogs, mysql50, TypInfo, UStringListEx,
     11  ListObject, DictionaryStringString;
    1012
    1113type
    12   EQueryError = Exception;
     14  EQueryError = class(Exception);
    1315
    1416  TClientCapabilities = (_CLIENT_LONG_PASSWORD, _CLIENT_FOUND_ROWS,
    … …  
    1921  TSetClientCapabilities = set of TClientCapabilities;
    2022
    21   TAssociativeArray = class(TStringList)
     23  TDbRows = class(TListObject)
    2224  private
    23     function GetValues(Index: string): string;
    24     function GetValuesAtIndex(Index: Integer): string;
    25     procedure SetValues(Index: string; const Value: string);
     25    function GetData(Index: Integer): TDictionaryStringString;
     26    procedure SetData(Index: Integer; const Value: TDictionaryStringString);
    2627  public
    27     constructor Create;
    28     destructor Destroy; override;
    29     function GetAllValues: string;
    30     procedure AddKeyValue(Key, Value: string);
    31     property ValuesAtIndex[Index: Integer]: string read GetValuesAtIndex;
    32     property Values[Index: string]: string read GetValues write SetValues; default;
    33   end;
    34 
    35   TDbRows = class(TList)
    36   private
    37     function GetData(Index: Integer): TAssociativeArray;
    38     procedure SetData(Index: Integer; const Value: TAssociativeArray);
    39   public
    40     property Data[Index: Integer]: TAssociativeArray read GetData write SetData; default;
     28    property Data[Index: Integer]: TDictionaryStringString read GetData write SetData; default;
    4129    destructor Destroy; override;
    4230  end;
    … …  
    5139    function GetLastErrorMessage: string;
    5240    function GetLastErrorNumber: Integer;
    53     function CheckError: Boolean;
    5441    function GetCharset: string;
    5542    procedure SetDatabase(const Value: string);
    56     { Private declarations }
    5743  public
    5844    Hostname: string;
    … …  
    6955    function Select(ATable: string; Filter: string = '*'; Condition: string = '1'): TDbRows;
    7056    procedure Delete(ATable: string; Condition: string = '1');
    71     procedure Insert(ATable: string; Data: TAssociativeArray);
    72     procedure Update(ATable: string; Data: TAssociativeArray; Condition: string = '1');
    73     procedure Replace(ATable: string; Data: TAssociativeArray);
     57    procedure Insert(ATable: string; Data: TDictionaryStringString);
     58    procedure Update(ATable: string; Data: TDictionaryStringString; Condition: string = '1');
     59    procedure Replace(ATable: string; Data: TDictionaryStringString);
    7460    procedure Connect;
    7561    procedure Disconnect;
    … …  
    8672  function MySQLFloatToStr(F: Real): string;
    8773  function MySQLStrToFloat(S: string): Real;
     74  function SQLToDateTime(Value: string): TDateTime;
     75  function DateTimeToSQL(Value: TDateTime): string;
    8876
    8977implementation
    9078
    91 uses DateUtils, Math;
     79uses
     80  DateUtils, Math;
     81
     82resourcestring
     83  SDatabaseQueryError = 'Database query error: "%s"';
    9284
    9385const
    … …  
    10698  CLIENT_TRANSACTIONS = 8192;    // Client knows about transactions
    10799
    108 { TDataModule2 }
    109 
    110100function MySQLFloatToStr(F: Real): string;
    111101var
    … …  
    113103begin
    114104  S := FloatToStr(F);
    115   if Pos(',', S) > 0 then S[Pos(',',S)] := '.';
     105  if Pos(',', S) > 0 then S[Pos(',', S)] := '.';
    116106  Result := S;
    117107end;
    … …  
    119109function MySQLStrToFloat(S: string): Real;
    120110begin
    121   if Pos('.', S) > 0 then S[Pos('.',S)] := ',';
     111  if Pos('.', S) > 0 then S[Pos('.', S)] := ',';
    122112  Result := StrToFloat(S);
    123113end;
     114
     115function SQLToDateTime(Value: string): TDateTime;
     116var
     117  Parts: TStringListEx;
     118  DateParts: TStringListEx;
     119  TimeParts: TStringListEx;
     120begin
     121  try
     122    Parts := TStringListEx.Create;
     123    DateParts := TStringListEx.Create;
     124    TimeParts := TStringListEx.Create;
     125
     126    Parts.Explode(' ', Value);
     127    DateParts.Explode('-', Parts[0]);
     128    Result := EncodeDate(StrToInt(DateParts[0]), StrToInt(DateParts[1]),
     129      StrToInt(DateParts[2]));
     130    if Parts.Count > 1 then begin
     131      TimeParts.Explode(':', Parts[1]);
     132      Result := Result + EncodeTime(StrToInt(TimeParts[0]), StrToInt(TimeParts[1]),
     133        StrToInt(TimeParts[2]), 0);
     134    end;
     135  finally
     136    DateParts.Free;
     137    TimeParts.Free;
     138    Parts.Free;
     139  end;
     140end;
     141
     142function DateTimeToSQL(Value: TDateTime): string;
     143begin
     144  Result := FormatDateTime('yyyy-mm-dd hh.nn.ss', Value);
     145end;
     146
     147{ TSqlDatabase }
    124148
    125149procedure TSqlDatabase.Connect;
    … …  
    138162    FSession := NewSession;
    139163  end else FConnected := False;
    140   CheckError;
    141   Rows := Query('SET NAMES ' + Encoding);
    142   Rows.Free;
    143 end;
    144 
    145 procedure TSqlDatabase.Insert(ATable: string; Data: TAssociativeArray);
     164
     165  if LastErrorNumber <> 0 then
     166    raise EQueryError.Create(Format(SDatabaseQueryError, [LastErrorMessage]));
     167
     168  try
     169    Rows := Query('SET NAMES ' + Encoding);
     170  finally
     171    Rows.Free;
     172  end;
     173end;
     174
     175procedure TSqlDatabase.Insert(ATable: string; Data: TDictionaryStringString);
    146176var
    147177  DbNames: string;
    … …  
    155185  DbValues := '';
    156186  for I := 0 to Data.Count - 1 do begin
    157     Value := Data.ValuesAtIndex[I];
     187    Value := Data.Items[I].Value;
    158188    StringReplace(Value, '"', '\"', [rfReplaceAll]);
    159189    if Value = 'NOW()' then DbValues := DbValues + ',' + Value
    160190    else DbValues := DbValues + ',"' + Value + '"';
    161     DbNames := DbNames + ',`' + Data.Names[I] + '`';
     191    DbNames := DbNames + ',`' + Data.Keys[I] + '`';
    162192  end;
    163193  System.Delete(DbNames, 1, 1);
    164194  System.Delete(DbValues, 1, 1);
    165   DbResult := Query('INSERT INTO `' + Table + '` (' + DbNames + ') VALUES (' + DbValues + ')');
    166   DbResult.Free;
     195  try
     196    DbResult := Query('INSERT INTO `' + Table + '` (' + DbNames + ') VALUES (' + DbValues + ')');
     197  finally
     198    DbResult.Free;
     199  end;
    167200end;
    168201
    … …  
    176209  RepeatLastAction := False;
    177210  LastQuery := Data;
    178   //if not Connected then NastaveniPripojeni.ShowModal;
    179211  Result := TDbRows.Create;
    180   //repeat
    181212  mysql_query(FSession, PChar(Data));
    182   //until not
    183   CheckError;
    184   //if not CheckError then
    185   begin
    186     DbResult := mysql_store_result(FSession);
    187     if Assigned(DbResult) then begin
    188       Result.Count := mysql_num_rows(DbResult);
    189       for I := 0 to Result.Count - 1 do begin
    190         DbRow := mysql_fetch_row(DbResult);
    191         Result[I] := TAssociativeArray.Create;
    192         with Result[I] do begin
    193           for II := 0 to mysql_num_fields(DbResult) - 1 do begin
    194             Add(mysql_fetch_field_direct(DbResult, II)^.Name +
    195               NameValueSeparator + PChar((DbRow + II)^));
     213  if LastErrorNumber <> 0 then begin
     214    raise EQueryError.Create(Format(SDatabaseQueryError, [LastErrorMessage]));
     215  end;
     216
     217  DbResult := mysql_store_result(FSession);
     218  if Assigned(DbResult) then begin
     219    Result.Count := mysql_num_rows(DbResult);
     220    for I := 0 to Result.Count - 1 do begin
     221      DbRow := mysql_fetch_row(DbResult);
     222      Result[I] := TDictionaryStringString.Create;
     223      with Result[I] do begin
     224        for II := 0 to mysql_num_fields(DbResult) - 1 do begin
     225          Add(mysql_fetch_field_direct(DbResult, II)^.Name,
     226            PChar((DbRow + II)^));
    196227          end;
    197228        end;
    198229      end;
    199     end;
    200230  end;
    201231  mysql_free_result(DbResult);
    202   (*
    203   if Assigned(DatabaseIntegrity) then
    204   with DatabaseIntegrity do if not Checking then begin
    205     Check;
    206     DebugLog('Database integrity: Unreferenced='+IntToStr(Unreferenced)+' BadReferences='+IntToStr(BadReferences));
    207   end;
    208   *)
    209 end;
    210 
    211 procedure TSqlDatabase.Replace(ATable: string; Data: TAssociativeArray);
     232end;
     233
     234procedure TSqlDatabase.Replace(ATable: string; Data: TDictionaryStringString);
    212235var
    213236  DbNames: string;
    … …  
    221244  DbValues := '';
    222245  for I := 0 to Data.Count - 1 do begin
    223     Value := Data.ValuesAtIndex[I];
     246    Value := Data.Items[I].Value;
    224247    StringReplace(Value, '"', '\"', [rfReplaceAll]);
    225248    if Value = 'NOW()' then DbValues := DbValues + ',' + Value
    226249    else DbValues := DbValues + ',"' + Value + '"';
    227     DbNames := DbNames + ',`' + Data.Names[I] + '`';
     250    DbNames := DbNames + ',`' + Data.Keys[I] + '`';
    228251  end;
    229252  System.Delete(DbNames, 1, 1);
    230253  System.Delete(DbValues, 1, 1);
    231   DbResult := Query('REPLACE INTO `' + Table + '` (' + DbNames + ') VALUES (' + DbValues + ')');
    232   DbResult.Free;
     254  try
     255    DbResult := Query('REPLACE INTO `' + Table + '` (' + DbNames + ') VALUES (' + DbValues + ')');
     256  finally
     257    DbResult.Free;
     258  end;
    233259end;
    234260
    … …  
    236262begin
    237263  Table := ATable;
    238   Result := Query('SELECT ' + Filter + ' FROM `' + Table + '` WHERE '+Condition);
    239 end;
    240 
    241 procedure TSqlDatabase.Update(ATable: string; Data: TAssociativeArray; Condition: string = '1');
     264  Result := Query('SELECT ' + Filter + ' FROM `' + Table + '` WHERE ' + Condition);
     265end;
     266
     267procedure TSqlDatabase.Update(ATable: string; Data: TDictionaryStringString; Condition: string = '1');
    242268var
    243269  DbValues: string;
    … …  
    249275  DbValues := '';
    250276  for I := 0 to Data.Count - 1 do begin
    251     Value := Data.ValuesAtIndex[I];
     277    Value := Data.Items[I].Value;
    252278    StringReplace(Value, '"', '\"', [rfReplaceAll]);
    253279    if Value = 'NOW()' then DbValues := DbValues + ',' + Value
    254     else DbValues := DbValues + ',' + Data.Names[I] + '=' + '"' + Value + '"';
     280    else DbValues := DbValues + ',' + Data.Keys[I] + '=' + '"' + Value + '"';
    255281  end;
    256282  System.Delete(DbValues, 1, 1);
    257   DbResult := Query('UPDATE `' + Table + '` SET (' + DbValues + ') WHERE ' + Condition);
    258   DbResult.Free;
     283  try
     284    DbResult := Query('UPDATE `' + Table + '` SET (' + DbValues + ') WHERE ' + Condition);
     285  finally
     286    DbResult.Free;
     287  end;
    259288end;
    260289
    … …  
    264293end;
    265294
    266 { TAssocArray }
    267 
    268 procedure TAssociativeArray.AddKeyValue(Key, Value: string);
    269 begin
    270   Add(Key + NameValueSeparator + Value);
    271 end;
    272 
    273 constructor TAssociativeArray.Create;
    274 begin
    275   NameValueSeparator := '|';
    276 end;
    277 
    278 destructor TAssociativeArray.Destroy;
    279 begin
    280   inherited;
    281 end;
    282 
    283 function TAssociativeArray.GetAllValues: string;
    284 var
    285   I: Integer;
    286 begin
    287   Result := '';
    288   for I := 0 to Count - 1 do begin
    289     Result := Result + Names[I] + '=' + ValuesAtIndex[I] + ',';
    290   end;
    291 end;
    292 
    293 function TAssociativeArray.GetValues(Index: string): string;
    294 begin
    295   Result := inherited Values[Index];
    296 end;
    297 
    298 function TAssociativeArray.GetValuesAtIndex(Index: Integer): string;
    299 begin
    300   Result := inherited Values[Names[Index]];
    301 end;
    302 
    303295procedure TSqlDatabase.Delete(ATable: string; Condition: string = '1');
     296var
     297  DbResult: TDbRows;
    304298begin
    305299  Table := ATable;
    306   Query('DELETE FROM `' + Table + '` WHERE ' + Condition);
     300  try
     301    DbResult := Query('DELETE FROM `' + Table + '` WHERE ' + Condition);
     302  finally
     303    DbResult.Free;
     304  end;
    307305end;
    308306
    … …  
    325323end;
    326324
    327 procedure TAssociativeArray.SetValues(Index: string; const Value: string);
    328 begin
    329   inherited Values[Index] := Value;
    330 end;
    331 
    332 { TDbRows }
    333 
    334 destructor TDbRows.Destroy;
    335 var
    336   I: Integer;
    337 begin
    338   for I := 0 to Count - 1 do
    339     Data[I].Free;
    340   inherited;
    341 end;
    342 
    343 function TDbRows.GetData(Index: Integer): TAssociativeArray;
    344 begin
    345   Result := Items[Index];
    346 end;
    347 
    348 procedure TDbRows.SetData(Index: Integer; const Value: TAssociativeArray);
    349 begin
    350   Items[Index] := Value;
    351 end;
    352 
    353325function TSqlDatabase.LastInsertId: Integer;
    354326begin
    … …  
    364336begin
    365337  Result := mysql_errno(FSession);
    366 end;
    367 
    368 function TSqlDatabase.CheckError: Boolean;
    369 begin
    370   Result := LastErrorNumber <> 0;
    371   if Result then
    372     raise EQueryError.Create('Database query error: "' + LastErrorMessage + '"');
    373338end;
    374339
    … …  
    386351
    387352procedure TSqlDatabase.CreateTable(Name: string);
    388 var
    389   DbRows: TDbRows;
    390 begin
    391   DbRows := Query('CREATE TABLE `' + Name + '`' +
     353begin
     354  Query('CREATE TABLE `' + Name + '`' +
    392355  ' (`Id` INT NOT NULL AUTO_INCREMENT, PRIMARY KEY (`Id`));');
    393   DbRows.Destroy;
    394356end;
    395357
    … …  
    420382end;
    421383
     384{ TDbRows }
     385
     386destructor TDbRows.Destroy;
     387begin
     388  inherited;
     389end;
     390
     391function TDbRows.GetData(Index: Integer): TDictionaryStringString;
     392begin
     393  Result := TDictionaryStringString(Items[Index]);
     394end;
     395
     396procedure TDbRows.SetData(Index: Integer; const Value: TDictionaryStringString);
     397begin
     398  Items[Index] := Value;
     399end;
     400
    422401end.
    423402
Note: See TracChangeset for help on using the changeset viewer.