Changeset 26 for trunk/Packages
- Timestamp:
- Sep 10, 2022, 8:03:08 PM (2 years ago)
- Location:
- trunk
- Files:
-
- 3 added
- 1 deleted
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk
- Property svn:ignore
-
old new 7 7 heaptrclog.trc 8 8 MyData.exe 9 MyData.dbg 10
-
- Property svn:ignore
-
trunk/Packages/Common/UFormAbout.lfm
r25 r26 8 8 ClientWidth = 702 9 9 DesignTimePPI = 144 10 OnCreate = FormCreate11 10 OnShow = FormShow 12 11 Position = poScreenCenter 13 LCLVersion = '2. 0.10.0'12 LCLVersion = '2.2.2.0' 14 13 object LabelDescription: TLabel 15 14 Left = 30 16 Height = 2 415 Height = 26 17 16 Top = 135 18 17 Width = 642 … … 28 27 object LabelContent: TLabel 29 28 Left = 30 30 Height = 2 431 Top = 1 8929 Height = 26 30 Top = 191 32 31 Width = 642 33 32 Align = alTop … … 94 93 end 95 94 object ButtonClose: TButton 96 Left = 53 295 Left = 536 97 96 Height = 38 98 97 Top = 24 -
trunk/Packages/Database/Database.lpk
r19 r26 1 1 <?xml version="1.0" encoding="UTF-8"?> 2 2 <CONFIG> 3 <Package Version=" 4">3 <Package Version="5"> 4 4 <PathDelim Value="\"/> 5 5 <Name Value="Database"/> … … 9 9 <PathDelim Value="\"/> 10 10 <SearchPaths> 11 <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS) \"/>11 <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> 12 12 </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> 13 26 </CompilerOptions> 14 27 <Files Count="1"> … … 18 31 </Item1> 19 32 </Files> 33 <CompatibilityMode Value="True"/> 34 <i18n> 35 <EnableI18N Value="True"/> 36 <OutDir Value="Languages"/> 37 <EnableI18NForLFM Value="True"/> 38 </i18n> 20 39 <RequiredPkgs Count="2"> 21 40 <Item1> 22 <PackageName Value=" TemplateGenerics"/>41 <PackageName Value="Common"/> 23 42 </Item1> 24 43 <Item2> -
trunk/Packages/Database/USqlDatabase.pas
r19 r26 1 1 unit USqlDatabase; 2 2 3 {$mode Delphi}{$H+} 4 5 // Modified: 2010-12-24 3 // Modified: 2022-09-08 6 4 7 5 interface 8 6 9 7 uses 10 SysUtils, Classes, Dialogs, mysql57dyn, TypInfo, 11 SpecializedDictionary, SpecializedList; 8 SysUtils, Classes, Dialogs, mysql50, TypInfo, UGenerics, Generics.Collections; 12 9 13 10 type … … 23 20 TLogEvent = procedure(Sender: TObject; Text: string) of object; 24 21 25 TDbRows = class(TList Object)22 TDbRows = class(TList<TDictionaryStringString>) 26 23 private 27 24 function GetData(Index: Integer): TDictionaryStringString; … … 52 49 procedure SetConnected(const AValue: Boolean); 53 50 procedure SetDatabase(const Value: string); 51 procedure SetEncoding(AValue: string); 54 52 public 55 53 LastUsedTable: string; 56 54 LastQuery: string; 55 function EscapeString(Text: string): string; 57 56 procedure CreateDatabase; 58 57 procedure CreateTable(Name: string); 59 58 procedure CreateColumn(Table, ColumnName: string; ColumnType: TTypeKind); 60 59 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 = ''; 63 63 Schema: string = ''); 64 64 procedure Insert(ATable: string; Data: TDictionaryStringString; 65 65 Schema: string = ''); 66 66 procedure Update(ATable: string; Data: TDictionaryStringString; 67 Condition: string = ' 1'; Schema: string = '');67 Condition: string = ''; Schema: string = ''); 68 68 procedure Replace(ATable: string; Data: TDictionaryStringString; 69 69 Schema: string = ''); … … 83 83 property Password: string read FPassword write FPassword; 84 84 property Port: Word read FPort write FPort; 85 property Encoding: string read FEncoding write FEncoding;85 property Encoding: string read FEncoding write SetEncoding; 86 86 property OnLogQuery: TLogEvent read FOnLogQuery write FOnLogQuery; 87 87 end; … … 98 98 99 99 uses 100 DateUtils , Math;100 DateUtils; 101 101 102 102 resourcestring … … 149 149 TimeParts: TListString; 150 150 begin 151 if Value = '' then Result := 0 else152 151 try 153 152 Parts := TListString.Create; … … 155 154 TimeParts := TListString.Create; 156 155 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]); 161 158 Result := EncodeDate(StrToInt(DateParts[0]), StrToInt(DateParts[1]), 162 159 StrToInt(DateParts[2])); 163 160 if Parts.Count > 1 then begin 164 TimeParts.Explode( Parts[1], ':', StrToStr);161 TimeParts.Explode(':', Parts[1]); 165 162 Result := Result + EncodeTime(StrToInt(TimeParts[0]), StrToInt(TimeParts[1]), 166 163 StrToInt(TimeParts[2]), 0); … … 185 182 Rows: TDbRows; 186 183 begin 187 // mySQLClient1.Connect;188 184 FSession := mysql_init(FSession); 189 // FSession.charset := 'latin2';190 185 NewSession := mysql_real_connect(FSession, PChar(HostName), PChar(UserName), 191 186 PChar(Password), PChar(Database), FPort, nil, CLIENT_LONG_PASSWORD + CLIENT_CONNECT_WITH_DB); … … 200 195 try 201 196 Rows := TDbRows.Create; 202 Query(Rows, 'SET NAMES ' + Encoding);197 Query(Rows, 'SET NAMES ' + FEncoding); 203 198 finally 204 199 Rows.Free; … … 214 209 Value: string; 215 210 DbResult: TDbRows; 211 Item: TPair<string, string>; 216 212 begin 217 213 LastUsedTable := ATable; 218 214 DbNames := ''; 219 215 DbValues := ''; 220 for I := 0 to Data.Count - 1do begin221 Value := Data.Items[I].Value;216 for Item in Data do begin 217 Value := Item.Value; 222 218 StringReplace(Value, '"', '\"', [rfReplaceAll]); 223 219 if Value = 'NOW()' then DbValues := DbValues + ',' + Value 224 220 else DbValues := DbValues + ',"' + Value + '"'; 225 DbNames := DbNames + ',`' + Data.Keys[I]+ '`';221 DbNames := DbNames + ',`' + Item.Key + '`'; 226 222 end; 227 223 System.Delete(DbNames, 1, 1); … … 251 247 252 248 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)^)); 262 259 end; 263 260 end; 264 261 end; 265 end; 266 mysql_free_result(DbResult); 262 end; 263 finally 264 mysql_free_result(DbResult); 265 end; 267 266 end; 268 267 … … 275 274 I: Integer; 276 275 DbResult: TDbRows; 276 Item: TPair<string, string>; 277 277 begin 278 278 LastUsedTable := ATable; 279 279 DbNames := ''; 280 280 DbValues := ''; 281 for I := 0 to Data.Count - 1do begin282 Value := Data.Items[I].Value;281 for Item in Data do begin 282 Value := Item.Value; 283 283 StringReplace(Value, '"', '\"', [rfReplaceAll]); 284 284 if Value = 'NOW()' then DbValues := DbValues + ',' + Value 285 285 else DbValues := DbValues + ',"' + Value + '"'; 286 DbNames := DbNames + ',`' + Data.Keys[I]+ '`';286 DbNames := DbNames + ',`' + Item.Key + '`'; 287 287 end; 288 288 System.Delete(DbNames, 1, 1); … … 297 297 end; 298 298 299 procedure TSqlDatabase.Select(DbRows: TDbRows; ATable: string; Filter: string = '*'; Condition: string = '1'); 299 procedure TSqlDatabase.Select(DbRows: TDbRows; ATable: string; Filter: string = '*'; Condition: string = ''); 300 var 301 QueryText: string; 300 302 begin 301 303 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); 303 307 end; 304 308 305 309 procedure TSqlDatabase.Update(ATable: string; Data: TDictionaryStringString; 306 Condition: string = '1'; Schema: string = ''); 307 var 310 Condition: string = ''; Schema: string = ''); 311 var 312 QueryText: string; 308 313 DbValues: string; 309 314 Value: string; 310 315 I: Integer; 311 316 DbResult: TDbRows; 317 Item: TPair<string, string>; 312 318 begin 313 319 LastUsedTable := ATable; 314 320 DbValues := ''; 315 for I := 0 to Data.Count - 1do begin316 Value := Data.Items[I].Value;321 for Item in Data do begin 322 Value := Item.Value; 317 323 StringReplace(Value, '"', '\"', [rfReplaceAll]); 318 324 if Value = 'NOW()' then DbValues := DbValues + ',' + Value 319 else DbValues := DbValues + ',`' + Data.Keys[I]+ '` =' + '"' + Value + '"';325 else DbValues := DbValues + ',`' + Item.Key + '` =' + '"' + Value + '"'; 320 326 end; 321 327 System.Delete(DbValues, 1, 1); … … 323 329 DbResult := TDbRows.Create; 324 330 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); 326 334 finally 327 335 DbResult.Free; … … 334 342 end; 335 343 336 procedure TSqlDatabase.Delete(ATable: string; Condition: string = ' 1';344 procedure TSqlDatabase.Delete(ATable: string; Condition: string = ''; 337 345 Schema: string = ''); 338 346 var 347 QueryText: string; 339 348 DbResult: TDbRows; 340 349 begin … … 343 352 DbResult := TDbRows.Create; 344 353 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); 346 357 finally 347 358 DbResult.Free; … … 454 465 end; 455 466 467 procedure TSqlDatabase.SetEncoding(AValue: string); 468 var 469 Rows: TDbRows; 470 begin 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; 481 end; 482 483 function TSqlDatabase.EscapeString(Text: string): string; 484 var 485 L: Integer; 486 begin 487 SetLength(Result, Length(Text) * 2 + 1); 488 L := mysql_real_escape_string(FSession, PChar(Result), PChar(Text), Length(Text)); 489 SetLength(Result, L); 490 end; 491 456 492 { TDbRows } 457 493 … … 473 509 end. 474 510 475
Note:
See TracChangeset
for help on using the changeset viewer.