Changeset 26 for trunk/Packages/Database


Ignore:
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:
3 added
3 edited

Legend:

Unmodified
Added
Removed

  • trunk

    • Property svn:ignore

      •  

        old new  
        77heaptrclog.trc
        88MyData.exe
         9MyData.dbg
         10

  • trunk/Packages/Database/Database.lpk

    r19 r26  
    11<?xml version="1.0" encoding="UTF-8"?>
    22<CONFIG>
    3   <Package Version="4">
     3  <Package Version="5">
    44    <PathDelim Value="\"/>
    55    <Name Value="Database"/>
    … …  
    99      <PathDelim Value="\"/>
    1010      <SearchPaths>
    11         <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)\"/>
     11        <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
    1212      </SearchPaths>
     13      <Parsing>
     14        <SyntaxOptions>
     15          <SyntaxMode Value="Delphi"/>
     16          <CStyleOperator Value="False"/>
     17          <AllowLabel Value="False"/>
     18          <CPPInline Value="False"/>
     19        </SyntaxOptions>
     20      </Parsing>
     21      <Linking>
     22        <Debugging>
     23          <GenerateDebugInfo Value="False"/>
     24        </Debugging>
     25      </Linking>
    1326    </CompilerOptions>
    1427    <Files Count="1">
    … …  
    1831      </Item1>
    1932    </Files>
     33    <CompatibilityMode Value="True"/>
     34    <i18n>
     35      <EnableI18N Value="True"/>
     36      <OutDir Value="Languages"/>
     37      <EnableI18NForLFM Value="True"/>
     38    </i18n>
    2039    <RequiredPkgs Count="2">
    2140      <Item1>
    22         <PackageName Value="TemplateGenerics"/>
     41        <PackageName Value="Common"/>
    2342      </Item1>
    2443      <Item2>

  • trunk/Packages/Database/USqlDatabase.pas

    r19 r26  
    11unit USqlDatabase;
    22
    3 {$mode Delphi}{$H+}
    4 
    5 // Modified: 2010-12-24
     3// Modified: 2022-09-08
    64
    75interface
    86
    97uses
    10   SysUtils, Classes, Dialogs, mysql57dyn, TypInfo,
    11   SpecializedDictionary, SpecializedList;
     8  SysUtils, Classes, Dialogs, mysql50, TypInfo, UGenerics, Generics.Collections;
    129
    1310type
    … …  
    2320  TLogEvent = procedure(Sender: TObject; Text: string) of object;
    2421
    25   TDbRows = class(TListObject)
     22  TDbRows = class(TList<TDictionaryStringString>)
    2623  private
    2724    function GetData(Index: Integer): TDictionaryStringString;
    … …  
    5249    procedure SetConnected(const AValue: Boolean);
    5350    procedure SetDatabase(const Value: string);
     51    procedure SetEncoding(AValue: string);
    5452  public
    5553    LastUsedTable: string;
    5654    LastQuery: string;
     55    function EscapeString(Text: string): string;
    5756    procedure CreateDatabase;
    5857    procedure CreateTable(Name: string);
    5958    procedure CreateColumn(Table, ColumnName: string; ColumnType: TTypeKind);
    6059    procedure Query(DbRows: TDbRows; Data: string);
    61     procedure Select(DbRows: TDbRows; ATable: string; Filter: string = '*'; Condition: string = '1');
    62     procedure Delete(ATable: string; Condition: string = '1';
     60    procedure Select(DbRows: TDbRows; ATable: string; Filter: string = '*';
     61      Condition: string = '');
     62    procedure Delete(ATable: string; Condition: string = '';
    6363      Schema: string = '');
    6464    procedure Insert(ATable: string; Data: TDictionaryStringString;
    6565      Schema: string = '');
    6666    procedure Update(ATable: string; Data: TDictionaryStringString;
    67       Condition: string = '1'; Schema: string = '');
     67      Condition: string = ''; Schema: string = '');
    6868    procedure Replace(ATable: string; Data: TDictionaryStringString;
    6969      Schema: string = '');
    … …  
    8383    property Password: string read FPassword write FPassword;
    8484    property Port: Word read FPort write FPort;
    85     property Encoding: string read FEncoding write FEncoding;
     85    property Encoding: string read FEncoding write SetEncoding;
    8686    property OnLogQuery: TLogEvent read FOnLogQuery write FOnLogQuery;
    8787  end;
    … …  
    9898
    9999uses
    100   DateUtils, Math;
     100  DateUtils;
    101101
    102102resourcestring
    … …  
    149149  TimeParts: TListString;
    150150begin
    151   if Value = '' then Result := 0 else
    152151  try
    153152    Parts := TListString.Create;
    … …  
    155154    TimeParts := TListString.Create;
    156155
    157     Parts.Explode(Value, ' ', StrToStr);
    158     DateParts.Explode(Parts[0], '-', StrToStr);
    159     if (StrToInt(DateParts[0]) = 0) or (StrToInt(DateParts[1]) = 0) or
    160     (StrToInt(DateParts[2]) = 0) then Result := 0 else
     156    Parts.Explode(' ', Value);
     157    DateParts.Explode('-', Parts[0]);
    161158    Result := EncodeDate(StrToInt(DateParts[0]), StrToInt(DateParts[1]),
    162159      StrToInt(DateParts[2]));
    163160    if Parts.Count > 1 then begin
    164       TimeParts.Explode(Parts[1], ':', StrToStr);
     161      TimeParts.Explode(':', Parts[1]);
    165162      Result := Result + EncodeTime(StrToInt(TimeParts[0]), StrToInt(TimeParts[1]),
    166163        StrToInt(TimeParts[2]), 0);
    … …  
    185182  Rows: TDbRows;
    186183begin
    187 //  mySQLClient1.Connect;
    188184  FSession := mysql_init(FSession);
    189 //  FSession.charset := 'latin2';
    190185  NewSession := mysql_real_connect(FSession, PChar(HostName), PChar(UserName),
    191186    PChar(Password), PChar(Database), FPort, nil, CLIENT_LONG_PASSWORD + CLIENT_CONNECT_WITH_DB);
    … …  
    200195  try
    201196    Rows := TDbRows.Create;
    202     Query(Rows, 'SET NAMES ' + Encoding);
     197    Query(Rows, 'SET NAMES ' + FEncoding);
    203198  finally
    204199    Rows.Free;
    … …  
    214209  Value: string;
    215210  DbResult: TDbRows;
     211  Item: TPair<string, string>;
    216212begin
    217213  LastUsedTable := ATable;
    218214  DbNames := '';
    219215  DbValues := '';
    220   for I := 0 to Data.Count - 1 do begin
    221     Value := Data.Items[I].Value;
     216  for Item in Data do begin
     217    Value := Item.Value;
    222218    StringReplace(Value, '"', '\"', [rfReplaceAll]);
    223219    if Value = 'NOW()' then DbValues := DbValues + ',' + Value
    224220    else DbValues := DbValues + ',"' + Value + '"';
    225     DbNames := DbNames + ',`' + Data.Keys[I] + '`';
     221    DbNames := DbNames + ',`' + Item.Key + '`';
    226222  end;
    227223  System.Delete(DbNames, 1, 1);
    … …  
    251247
    252248  DbResult := mysql_store_result(FSession);
    253   if Assigned(DbResult) then begin
    254     DbRows.Count := mysql_num_rows(DbResult);
    255     for I := 0 to DbRows.Count - 1 do begin
    256       DbRow := mysql_fetch_row(DbResult);
    257       DbRows[I] := TDictionaryStringString.Create;
    258       with DbRows[I] do begin
    259         for II := 0 to mysql_num_fields(DbResult) - 1 do begin
    260           Add(mysql_fetch_field_direct(DbResult, II)^.Name,
    261             PChar((DbRow + II)^));
     249  try
     250    if Assigned(DbResult) then begin
     251      DbRows.Count := mysql_num_rows(DbResult);
     252      for I := 0 to DbRows.Count - 1 do begin
     253        DbRow := mysql_fetch_row(DbResult);
     254        DbRows[I] := TDictionaryStringString.Create;
     255        with DbRows[I] do begin
     256          for II := 0 to mysql_num_fields(DbResult) - 1 do begin
     257            Add(mysql_fetch_field_direct(DbResult, II)^.Name,
     258              PChar((DbRow + II)^));
    262259          end;
    263260        end;
    264261      end;
    265   end;
    266   mysql_free_result(DbResult);
     262    end;
     263  finally
     264    mysql_free_result(DbResult);
     265  end;
    267266end;
    268267
    … …  
    275274  I: Integer;
    276275  DbResult: TDbRows;
     276  Item: TPair<string, string>;
    277277begin
    278278  LastUsedTable := ATable;
    279279  DbNames := '';
    280280  DbValues := '';
    281   for I := 0 to Data.Count - 1 do begin
    282     Value := Data.Items[I].Value;
     281  for Item in Data do begin
     282    Value := Item.Value;
    283283    StringReplace(Value, '"', '\"', [rfReplaceAll]);
    284284    if Value = 'NOW()' then DbValues := DbValues + ',' + Value
    285285    else DbValues := DbValues + ',"' + Value + '"';
    286     DbNames := DbNames + ',`' + Data.Keys[I] + '`';
     286    DbNames := DbNames + ',`' + Item.Key + '`';
    287287  end;
    288288  System.Delete(DbNames, 1, 1);
    … …  
    297297end;
    298298
    299 procedure TSqlDatabase.Select(DbRows: TDbRows; ATable: string; Filter: string = '*'; Condition: string = '1');
     299procedure TSqlDatabase.Select(DbRows: TDbRows; ATable: string; Filter: string = '*'; Condition: string = '');
     300var
     301  QueryText: string;
    300302begin
    301303  LastUsedTable := ATable;
    302   Query(DbRows, 'SELECT ' + Filter + ' FROM `' + ATable + '` WHERE ' + Condition);
     304  QueryText := 'SELECT ' + Filter + ' FROM `' + ATable + '`';
     305  if Condition <> '' then QueryText := QueryText + ' WHERE ' + Condition;
     306  Query(DbRows, QueryText);
    303307end;
    304308
    305309procedure TSqlDatabase.Update(ATable: string; Data: TDictionaryStringString;
    306   Condition: string = '1'; Schema: string = '');
    307 var
     310  Condition: string = ''; Schema: string = '');
     311var
     312  QueryText: string;
    308313  DbValues: string;
    309314  Value: string;
    310315  I: Integer;
    311316  DbResult: TDbRows;
     317  Item: TPair<string, string>;
    312318begin
    313319  LastUsedTable := ATable;
    314320  DbValues := '';
    315   for I := 0 to Data.Count - 1 do begin
    316     Value := Data.Items[I].Value;
     321  for Item in Data do begin
     322    Value := Item.Value;
    317323    StringReplace(Value, '"', '\"', [rfReplaceAll]);
    318324    if Value = 'NOW()' then DbValues := DbValues + ',' + Value
    319     else DbValues := DbValues + ',`' + Data.Keys[I] + '` =' + '"' + Value + '"';
     325    else DbValues := DbValues + ',`' + Item.Key + '` =' + '"' + Value + '"';
    320326  end;
    321327  System.Delete(DbValues, 1, 1);
    … …  
    323329    DbResult := TDbRows.Create;
    324330    if Schema <> '' then Schema := '`' + Schema + '`.';
    325     Query(DbResult, 'UPDATE ' + Schema + '`' + ATable + '` SET ' + DbValues + ' WHERE ' + Condition);
     331    QueryText := 'UPDATE ' + Schema + '`' + ATable + '` SET ' + DbValues;
     332    if Condition <> '' then QueryText := QueryText + ' WHERE ' + Condition;
     333    Query(DbResult, QueryText);
    326334  finally
    327335    DbResult.Free;
    … …  
    334342end;
    335343
    336 procedure TSqlDatabase.Delete(ATable: string; Condition: string = '1';
     344procedure TSqlDatabase.Delete(ATable: string; Condition: string = '';
    337345  Schema: string = '');
    338346var
     347  QueryText: string;
    339348  DbResult: TDbRows;
    340349begin
    … …  
    343352    DbResult := TDbRows.Create;
    344353    if Schema <> '' then Schema := '`' + Schema + '`.';
    345     Query(DbResult, 'DELETE FROM ' + Schema + '`' + ATable + '` WHERE ' + Condition);
     354    QueryText := 'DELETE FROM ' + Schema + '`' + ATable + '`';
     355    if Condition <> '' then QueryText := QueryText + ' WHERE ' + Condition;
     356    Query(DbResult, QueryText);
    346357  finally
    347358    DbResult.Free;
    … …  
    454465end;
    455466
     467procedure TSqlDatabase.SetEncoding(AValue: string);
     468var
     469  Rows: TDbRows;
     470begin
     471  if FEncoding = AValue then Exit;
     472  FEncoding := AValue;
     473  if Connected then begin
     474    try
     475      Rows := TDbRows.Create;
     476      Query(Rows, 'SET NAMES ' + FEncoding);
     477    finally
     478      Rows.Free;
     479    end;
     480  end;
     481end;
     482
     483function TSqlDatabase.EscapeString(Text: string): string;
     484var
     485  L: Integer;
     486begin
     487  SetLength(Result, Length(Text) * 2 + 1);
     488  L := mysql_real_escape_string(FSession, PChar(Result), PChar(Text), Length(Text));
     489  SetLength(Result, L);
     490end;
     491
    456492{ TDbRows }
    457493
    … …  
    473509end.
    474510
    475 
Note: See TracChangeset for help on using the changeset viewer.