/source/utils/ado/ADOUtilities.pas
Pascal | 829 lines | 628 code | 75 blank | 126 comment | 30 complexity | 348df8eb3dc443bd4ee91727971b751d MD5 | raw file
1unit ADOUtilities; 2 3interface 4 5uses SysUtils, Windows, Forms, Controls, Classes, IniFiles, StdCtrls, Variants, 6 ADODB, ADODB_TLB, ADOX_TLB, JRO_TLB, Registry, FileCtrl, ComObj, Dialogs, DB; 7 8var 9 sPath : TFileName; 10 11function SQLFormatDateTime(const AValue: TDateTime): String; 12 13function GetADOVersion : String; 14 15function ConnectionStringForMDBFile(aMDBFile : TFileName) : String; overload; 16function ConnectionStringForMDBFile(aMDBFile : TFileName; aPassWord : String) : String; overload; 17function ConnectionSetStringMDB(DBFile : TFileName; DBConn : TADOConnection) : Boolean; 18 19procedure CompressRepairMDB(DBFile : TFileName); overload; 20procedure CompressRepairMDB(DBFile : TFileName; APassword : String); overload; 21 22procedure CreateAccess97MDB(AFileName : TFileName); 23procedure CreateAccess2KMDB(AFileName : TFileName); 24procedure CreateExcel8XLS(AFileName : TFileName); 25procedure CreateCatalog(AFileName : TFileName; AJetEngineType : Word); 26 27function ContainsTableMDB(DBFile : TFileName; DBTable : String) : Boolean; overload; 28function ContainsTableMDB(DBConn : TADOConnection; DBTable : String) : Boolean; overload; 29function CreateTableMDB(DBConn : TADOConnection; DBTable : String) : Boolean; 30 31function CountConnectedWorkStations_SQLServer(AnADOConnection : TADOConnection) : Integer; 32function CountConnectedWorkStations_Access(AnADOConnection : TADOConnection) : Integer; 33 34function SimpleLookup(AKeyField : String; AKeyValue : Variant; AResultField, ATable : String; DBConn : TADOConnection) : Variant; 35function DateToSQLStr(dtDate : TDate) : String; 36 37procedure ShowSQL(DataSet : TDataSet); 38procedure ShowSQLText(AString, ACaption : String); 39 40 41procedure ADOExecuteSQLList(AConnectionString : WideString; ASQLCommandList : TStrings; AVerTable, AVerField, AVerValue : String); 42procedure ADOExecuteSQLBatchFile(AControlIniFile : TFileName; ADBPath : String); overload; 43procedure ADOExecuteSQLBatchFile(AControlIniFile : TFileName; ASQLServer, AUser, APWD : String); overload; 44 45procedure ADOCopyXMLToStringList(ADataSet : TCustomADODataSet; AStrings : TStrings); 46 47Procedure ADOSaveRequery(ADataSet : TCustomADODataSet); 48 49 50implementation 51 52function SQLFormatDateTime(const AValue: TDateTime): String; 53begin 54 Result := '{ts ' + QuotedStr(FormatDateTime('yyyy-mm-dd hh:nn:ss', AValue)) + '}'; // SQL Server sicheres DATETIME, z.B. {ts '2009-04-06 12:00:00'} 55end; 56 57 58Procedure ADOSaveRequery(ADataSet : TCustomADODataSet); 59begin 60 if Assigned(ADataSet) and ADataSet.Active then ADataSet.Requery(); 61end; 62 63 64function GetADOVersion: string; 65var 66 ADO: OLEVariant; 67begin 68 try 69 ADO := CreateOLEObject('ADODB.Connection'); 70 Result := ADO.Version; 71 ADO:= null; 72 except 73 Result := ' No version'; 74 end; 75end; 76 77procedure ShowSQL(DataSet : TDataSet); 78begin 79 if DataSet is TADOQuery then 80 ShowSQLText(TADOQuery(DataSet).SQL.Text, DataSet.Name); 81 if DataSet is TADODataSet then 82 ShowSQLText(TADODataSet(DataSet).CommandText, DataSet.Name); 83end; 84 85procedure ShowSQLText(AString, ACaption : String); 86var 87 frm : TForm; 88 tmem : TMemo; 89begin 90 frm := TForm.Create(nil); 91 frm.Caption := ACaption; 92 tmem := TMemo.Create(frm); 93 tmem.Parent := frm; 94 tmem.Align := alClient; 95 tmem.Lines.Text := AString; 96 frm.ShowModal; 97 tmem.Free; 98 frm.Free; 99end; 100 101function SimpleLookup(AKeyField : String; AKeyValue : Variant; AResultField, ATable : String; DBConn : TADOConnection) : Variant; 102var 103 tmpSQL : String; 104 rs : ADODB._RecordSet; 105begin 106 Result := varNull; 107 108 tmpSQL := 'SELECT DISTINCT %s FROM %s WHERE %s = %s'; 109 tmpSQL := Format(tmpSQL, [AResultField, ATable, AKeyField, VarToStr(AKeyValue)]); 110 rs := DBConn.Execute(tmpSQL); 111 if (rs.RecordCount > 0) then 112 Result := rs.Fields[0].Value; 113 rs.Close; 114end; 115 116function ConnectionSetStringMDB(DBFile : TFileName; DBConn : TADOConnection) : Boolean; 117begin 118 Result := false; 119 120 if ((not FileExists(DBFile)) or (not Assigned(DBConn))) then 121 Exit; 122 123 // Connection-String setzen und Verbindung öffnen 124 with DBConn do begin 125 // Connection schließen 126 Connected := false; 127 LoginPrompt := false; 128 // Connection-String aufbauen 129 ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;'; 130 ConnectionString := ConnectionString + 'Password="";'; 131 ConnectionString := ConnectionString + 'User ID=Admin;'; 132 ConnectionString := ConnectionString + 'Data Source=' + DBFile + ';'; 133 ConnectionString := ConnectionString + 'Mode=ReadWrite;'; 134 ConnectionString := ConnectionString + 'Extended Properties="";'; 135 ConnectionString := ConnectionString + 'Locale Identifier=1033;'; 136 ConnectionString := ConnectionString + 'Jet OLEDB:System database="";'; 137 ConnectionString := ConnectionString + 'Jet OLEDB:Registry Path="";'; 138 ConnectionString := ConnectionString + 'Jet OLEDB:Database Password="";'; 139 ConnectionString := ConnectionString + 'Jet OLEDB:Engine Type=5;'; 140 ConnectionString := ConnectionString + 'Jet OLEDB:Database Locking Mode=1;'; 141 ConnectionString := ConnectionString + 'Jet OLEDB:Global Partial Bulk Ops=2;'; 142 ConnectionString := ConnectionString + 'Jet OLEDB:Global Bulk Transactions=1;'; 143 ConnectionString := ConnectionString + 'Jet OLEDB:New Database Password="";'; 144 ConnectionString := ConnectionString + 'Jet OLEDB:Create System Database=False;'; 145 ConnectionString := ConnectionString + 'Jet OLEDB:Encrypt Database=False;'; 146 ConnectionString := ConnectionString + 'Jet OLEDB:Don''t Copy Locale on Compact=False;'; 147 ConnectionString := ConnectionString + 'Jet OLEDB:Compact Without Replica Repair=False;'; 148// ConnectionString := ConnectionString + 'Jet OLEDB:Page Timeout=0;'; 149 ConnectionString := ConnectionString + 'Jet OLEDB:SFP=False'; 150 Result := true; 151 end; 152end; 153 154function ConnectionStringForMDBFile(aMDBFile : TFileName) : String; 155begin 156 result := ConnectionStringForMDBFile(aMDBFile, ''); 157end; 158 159function ConnectionStringForMDBFile(aMDBFile : TFileName; aPassWord : String) : String; 160var 161 cs : String; 162begin 163 cs := ''; 164 165 if FileExists(aMDBFile) then begin 166 // Connection-String aufbauen 167 cs := 'Provider=Microsoft.Jet.OLEDB.4.0;'; 168 cs := cs + 'Password="";'; 169 cs := cs + 'User ID=Admin;'; 170 cs := cs + 'Data Source=' + aMDBFile + ';'; 171 cs := cs + 'Mode=Share Deny None;'; 172 cs := cs + 'Extended Properties="";'; 173 cs := cs + 'Locale Identifier=1033;'; 174 cs := cs + 'Jet OLEDB:System database="";'; 175 cs := cs + 'Jet OLEDB:Registry Path="";'; 176 cs := cs + 'Jet OLEDB:Database Password="' + aPassWord+ '";'; 177 cs := cs + 'Jet OLEDB:Engine Type=5;'; 178 cs := cs + 'Jet OLEDB:Database Locking Mode=1;'; 179 cs := cs + 'Jet OLEDB:Global Partial Bulk Ops=2;'; 180 cs := cs + 'Jet OLEDB:Global Bulk Transactions=1;'; 181 cs := cs + 'Jet OLEDB:New Database Password="";'; 182 cs := cs + 'Jet OLEDB:Create System Database=False;'; 183 cs := cs + 'Jet OLEDB:Encrypt Database=False;'; 184 cs := cs + 'Jet OLEDB:Don''t Copy Locale on Compact=False;'; 185 cs := cs + 'Jet OLEDB:Compact Without Replica Repair=False;'; 186 cs := cs + 'Jet OLEDB:SFP=False'; 187 end; 188 Result := cs; 189end; 190 191function CountConnectedWorkStations_SQLServer(AnADOConnection : TADOConnection) : Integer; 192const 193 SQL = 'SET NOCOUNT ON ' + #13#10 + 194 'CREATE TABLE #who (spid int, ecid int, status nvarchar(50), loginname nvarchar(50), hostname nvarchar(50), blk int, dbname nvarchar(50), cmd nvarchar(50), request_id int) ' + #13#10 + 195 'INSERT #who EXEC sp_who ' + #13#10 + 196 'SELECT Count(*) AS connections FROM #who where dbname = ''%s'' ' + #13#10 + 197 'DROP TABLE #who ' + #13#10 + 198 'SET NOCOUNT OFF'; 199var 200 rs : ADODB._RecordSet; 201begin 202 Result := 0; 203 rs := AnADOConnection.Execute(Format(SQL, [AnADOConnection.Properties['Initial Catalog'].Value])); 204 if (rs.RecordCount > 0) then 205 Result := StrToInt(VarToStr(rs.Fields['connections'].Value)); 206end; 207 208function CountConnectedWorkStations_Access(AnADOConnection : TADOConnection) : Integer; 209const JET_SCHEMA_USERROSTER = '{947bb102-5d43-11d1-bdbf-00c04fb92675}'; 210var 211 tmpADODataSet : TADODataSet; 212 tmpStrLst : TStringList; 213begin 214 Result := 0; 215 try 216 tmpADODataSet := TADODataSet.Create(nil); 217 tmpStrLst := TStringList.Create; 218 219 AnADOConnection.OpenSchema(siProviderSpecific, EmptyParam, JET_SCHEMA_USERROSTER, tmpADODataSet); 220 221 tmpADODataSet.First; 222 while not tmpADODataSet.EOF do begin 223 if (tmpStrLst.IndexOf(tmpADODataSet['COMPUTER_NAME']) = -1) then 224 tmpStrLst.Add(tmpADODataSet['COMPUTER_NAME']); 225 tmpADODataSet.Next; 226 end; 227 228 Result := tmpStrLst.Count; 229 finally 230 tmpStrLst.Free; 231 tmpADODataSet.Free; 232 end; 233end; 234 235procedure CreateAccess97MDB(AFileName : TFileName); 236begin 237 CreateCatalog(AFileName, 4); 238end; 239 240procedure CreateAccess2KMDB(AFileName : TFileName); 241begin 242 CreateCatalog(AFileName, 5); 243end; 244 245procedure CreateExcel8XLS(AFileName : TFileName); 246begin 247 CreateCatalog(AFileName, 23); 248end; 249 250procedure CreateCatalog(AFileName : TFileName; AJetEngineType : Word); 251var 252 Catalog : _Catalog; // the database 253 DataSource : String; 254begin 255 // A spot of housekeeping first up 256 if FileExists(AFileName) then 257 DeleteFile(PChar(AFileName)); 258 259 // Create a catalog (database) object using the provided COM object 260 // creation method - no need for wrappers and no need for garbage 261 // collection. All COM objects created will be automatically destroyed 262 // when they go out of scope. (The OP compiler adds code to decrement 263 // each object's reference count when they go out of scope. Since creating 264 // the object in OP automatically increments its reference count to 1, this 265 // ensures that COM will destroy the object because its reference count 266 // then equals 0. Note that the scope is defined by the object's 267 // declaration procedure, which is not necessarily where they are created). 268 Catalog := CoCatalog.Create; 269 270 // Set the connection string. 271 // Note that properties specified in the connection string, such as 272 // Jet OLEDB:Engine Type or Jet OLEDB:Encrypt Database are subsequently 273 // used in the Catalog.Create method, but not all connection properties are 274 // supported. See the Microsoft Jet 4.0 OLE DB Properties Reference for 275 // further details. 276 // BTW, Jet Engine Type 5 = Access 2000; Type 4 = Access 97 277 { Global Const JET_ENGINETYPE_UNKNOWN = 0 278 Global Const JET_ENGINETYPE_JET10 = 1 279 Global Const JET_ENGINETYPE_JET11 = 2 280 Global Const JET_ENGINETYPE_JET20 = 3 281 Global Const JET_ENGINETYPE_JET3X = 4 282 Global Const JET_ENGINETYPE_JET4X = 5 283 Global Const JET_ENGINETYPE_DBASE3 = 10 284 Global Const JET_ENGINETYPE_DBASE4 = 11 285 Global Const JET_ENGINETYPE_DBASE5 = 12 286 Global Const JET_ENGINETYPE_EXCEL30 = 20 287 Global Const JET_ENGINETYPE_EXCEL40 = 21 288 Global Const JET_ENGINETYPE_EXCEL50 = 22 289 Global Const JET_ENGINETYPE_EXCEL80 = 23 290 Global Const JET_ENGINETYPE_EXCEL90 = 24 291 Global Const JET_ENGINETYPE_EXCHANGE4 = 30 292 Global Const JET_ENGINETYPE_LOTUSWK1 = 40 293 Global Const JET_ENGINETYPE_LOTUSWK3 = 41 294 Global Const JET_ENGINETYPE_LOTUSWK4 = 42 295 Global Const JET_ENGINETYPE_PARADOX3X = 50 296 Global Const JET_ENGINETYPE_PARADOX4X = 51 297 Global Const JET_ENGINETYPE_PARADOX5X = 52 298 Global Const JET_ENGINETYPE_PARADOX7X = 53 299 Global Const JET_ENGINETYPE_TEXT1X = 60 300 Global Const JET_ENGINETYPE_HTML1X = 70 } 301 DataSource := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' + AFileName + ';Jet OLEDB:Engine Type=' + IntToStr(AJetEngineType); 302 if AJetEngineType = 23 then 303 DataSource := DataSource + ';Extended Properties=Excel 8.0'; 304 305 // Create a new Access database 306 Catalog.Create(DataSource); 307end; 308 309procedure CompressRepairMDB(DBFile : TFileName); 310begin 311 CompressRepairMDB(DBFile, ''); 312end; 313 314procedure CompressRepairMDB(DBFile : TFileName; APassword : String); 315const 316 tmpDBName = 'compress.mdb'; 317var 318 JROJetEngine : TJetEngine; 319 srcConn, 320 destConn : String; 321begin 322 JROJetEngine := TJetEngine.Create(nil); 323 try 324 srcConn := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' + DBFile; 325 destConn := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' + sPath + tmpDBName; 326 327 if APassWord <> '' then begin 328 srcConn := srcConn + ';Jet OLEDB:Database Password="' + APassWord+ '"'; 329 destConn := destConn + ';Jet OLEDB:Database Password="' + APassWord+ '"'; 330 end; 331 332 // Datenbank reparieren & komprimieren 333 JROJetEngine.CompactDatabase(srcConn, destConn); 334 335 if FileExists(sPath + tmpDBName) then begin 336 // Ausgangsdatenbank löschen 337 DeleteFile(PChar(DBFile)); 338 // Komprimierte DB anstelle der AusgangsDB kopieren 339 CopyFile(PChar(sPath + tmpDBName), PChar(DBFile), false); 340 // Komprimierte DB löschen 341 DeleteFile(PChar(sPath + tmpDBName)); 342 end; 343 finally 344 JROJetEngine.Disconnect; 345 JROJetEngine.Free; 346 end; 347end; 348 349function ContainsTableMDB(DBFile : TFileName; DBTable : String) : Boolean; 350var ADOConnTmp : TADOConnection; 351 ADOXCatalog : ADOX_TLB.TCatalog; 352 nCount : LongInt; 353begin 354 Result := false; 355 ADOConnTmp := TADOConnection.Create(nil); 356 try 357 if ConnectionSetStringMDB(DBFile, ADOConnTmp) then begin 358 ADOConnTmp.Connected := true; 359 ADOXCatalog := TCatalog.Create(nil); 360 try 361 ADOXCatalog.Set_ActiveConnection(ADOConnTmp.ConnectionObject); 362 for nCount := 0 to ADOXCatalog.Tables.Count - 1 do begin 363 if (AnsiUpperCase(DBTable) = AnsiUpperCase(ADOXCatalog.Tables.Item[nCount].Name)) then begin 364 Result := true; 365 Exit; 366 end; 367 end; 368 finally 369 ADOXCatalog.Free; 370 end; 371 end; 372 finally 373 ADOConnTmp.Free; 374 end; 375end; 376 377function ContainsTableMDB(DBConn : TADOConnection; DBTable : String) : Boolean; 378var ADOXCatalog : TCatalog; 379 nCount : LongInt; 380begin 381 Result := false; 382 DBConn.Connected := true; 383 ADOXCatalog := TCatalog.Create(nil); 384 try 385 ADOXCatalog.Set_ActiveConnection(DBConn.ConnectionObject); 386 for nCount := 0 to ADOXCatalog.Tables.Count - 1 do begin 387 if (AnsiUpperCase(DBTable) = AnsiUpperCase(ADOXCatalog.Tables.Item[nCount].Name)) then begin 388 Result := true; 389 Exit; 390 end; 391 end; 392 finally 393 ADOXCatalog.Free; 394 end; 395end; 396 397function CreateTableMDB(DBConn : TADOConnection; DBTable : String) : Boolean; 398var ADOXCatalog : TCatalog; 399 ADOX_Table : _Table; 400 nCount : LongInt; 401begin 402 Result := false; 403 DBConn.Connected := true; 404 ADOXCatalog := TCatalog.Create(nil); 405 try 406 ADOXCatalog.Set_ActiveConnection(DBConn.ConnectionObject); 407 ADOX_Table := {TADOXTable}CoTable.Create; 408 try 409 ADOX_Table.Name := DBTable; 410 ADOXCatalog.Tables.Append(ADOX_Table); 411 Result := false; 412 finally 413 ADOX_Table := nil; 414 end; 415 finally 416 ADOXCatalog.Free; 417 end; 418end; 419 420{ 421function CreateAndPopulateRemoteTable(DBConnSrc, DBConnDest : TADOConnection; RecordSet : TRecordSet; sName : String) : Boolean; 422var 423 ADOXCatalog : TCatalog; 424 ADOXTable : TADOXTable; 425 nFields : Integer; 426 ADOXRecordSet : TRecordset; 427begin 428 // Open a connection to your Remote Jet Database 429 ADOXCatalog := TCatalog.Create(nil); 430 ADOXTable := TADOXTable.Create(nil); 431 ADOXCatalog.Set_ActiveConnection(DBConn.ConnectionObject); 432 ADOXTable.Name = sName; 433 434 for nFields = 0 to RecordSet.Fields.Count - 1 do begin 435 case RecordSet.Fields(nFields).Type of 436 203, 202, 201, 200 : 437 ADOXTable.Columns.Append(RecordSet.Fields(nFields).Name, adVarChar, rst.Fields(nFields).DefinedSize; 438 135, 134, 133, 7 439 ADOXTable.Columns.Append RecordSet.Fields(Fields).Name, adDate, RecordSet.Fields(nFields).DefinedSize; 440 11 441 ADOXTable.Columns.Append RecordSet.Fields(nFields).Name, adBoolean, RecordSet.Fields(nFields).DefinedSize; 442 131, 14, 6, 5, 4 443 ADOXTable.Columns.Append RecordSet.Fields(nFields).Name, adDouble; 444 20, 19, 18, 17, 16, 3, 2 445 ADOXTable.Columns.Append RecordSet.Fields(nFields).Name, adInteger; 446 else 447 ADOXTable.Columns.Append RecordSet.Fields(nFields).Name, adVarChar, 255; 448 end; 449 end; 450 451 // Drop Table if it already exists 452 ADOXCatalog.Tables.Delete(sName) 453 // Append table to TableDefs collection 454 ADOXCatalog.Tables.Append(ADOXTable) 455 456 ADOXRecordSet.Set_ActiveConnection(DBConn.ConnectionObject); 457 ADOXRecordSet.Open(sName, DBConn, adOpenDynamic, adLockOptimistic); 458 459 if not ADOXRecordSet.BOF then ADOXRecordSet.MoveFirst 460 while not ADOXRecordSet.EOF do begin 461 nFields = 0; 462 ADOXRecordSet.AddNew; 463 for nFields = 0 to RecordSet.Fields.Count - 1 do 464 ADOXRecordSet.Fields(ADOXRecordSet.Fields(nFields).Name) = RecordSet.Fields(ADOXRecordSet.Fields(nFields).Name) + '"'; 465 ADOXRecordSet.Update; 466 RecordSet.MoveNext 467 end; 468 469 ADOXTable.Free; 470 ADOXCatalog.Free; 471end; 472} 473 474function CheckUpdateNeeded(theConnectionString, theVerTable, theVerField, theVerValue : String; IgnoreDBPassWordError : Boolean) : Boolean; 475var 476 rs : ADODB._RecordSet; 477 connVersionTest : TADOConnection; 478 tmpSQL : String; 479begin 480 Result := true; 481 482 if ((theVerTable = '') and (theVerField = '') and (theVerValue = '')) then 483 Exit; 484 485 connVersionTest := TADOConnection.Create(nil); 486 with connVersionTest do 487 try 488 ConnectionString := theConnectionString; 489 CursorLocation := clUseServer; 490 LoginPrompt := false; 491 try 492 Connected := true; 493 494 try 495 if ContainsTableMDB(connVersionTest, theVerTable) then begin 496 tmpSQL := 'SELECT * FROM ' + theVerTable + ' WHERE (' + theVerField + ' < ' + theVerValue + ')'; 497 rs := connVersionTest.Execute(tmpSQL); 498 Result := (Abs(rs.RecordCount) > 0) and (not (rs.EOF or rs.BOF)); 499 end 500 except 501 on E : Exception do 502 raise Exception.Create('Fehler bei Überprüfung der Versionsinformation.'#13#10 + E.Message); 503 end; 504 505 except 506 on E : EOleException do begin 507 // Fehler bei falschem Password übergehen ? 508 if (Errors[Errors.Count-1].SQLState = '3031') and IgnoreDBPassWordError then 509 Result := false 510 else 511 raise E; 512 end; 513 end; 514 515 516 Connected := false; 517 finally 518 Free; 519 end; 520end; 521 522// führt eine liste von sql-befehlen aus einer ini-datei aus 523// ini-datei besitzt dazu eine section connections mit ado-connection strings 524// und je connectionstring eine section mit einer liste von sql-statements. 525// diese sections tragen jeweils den namen des connectionsstrings. 526// um relative pfade im connectionstring und den sql-string zu ermöglichen 527// wird die zeichenfolge %APPDIR% generell gegen das Verzeichnis der 528// anwendung erstezt. 529 530// Aufruf in etwa : 531// if FileExists(FAppPath + 'update.bat') then begin 532// ADOExecuteSQLBatchFile(FAppPath + 'update.bat'); 533// DeleteFile(FAppPath + 'update.bat'); 534// end; 535 536procedure ADOExecuteSQLBatchFile(AControlIniFile : TFileName; ADBPath : String); 537var 538 nCount, 539 nConnCount, 540 nSQLCount : Integer; 541 ABatchFile : TMemIniFile; 542 ASQLList, 543 AConnList : TStringList; 544 AConnection : WideString; 545 AppPath : TFileName; 546 tmpSQL, 547 tmpConn, 548 tmpVerTable, 549 tmpVerField, 550 tmpVerValue : String; 551begin 552 // pfad der anwendung ohne abschliessenden backslash 553 AppPath := ExtractFilePath(Application.ExeName); 554 if AppPath[Length(AppPath)] = '\' then Delete(AppPath, Length(AppPath), 1); 555 556 if (ADBPath <> '') and (not DirectoryExists(ADBPath)) then 557 raise Exception.Create('Fehler bei der Datenbank-Aktualisierung.'#13#10'''' + ADBPath + ''' existiert nicht.') 558 else 559 if ADBPath[Length(ADBPath)] = '\' then Delete(ADBPath, Length(ADBPath), 1); 560 561 ABatchFile := TMemIniFile.Create(AControlIniFile); 562 ASQLList := TStringList.Create; 563 AConnList := TStringList.Create; 564 try 565 ABatchFile.ReadSectionValues('Connections', AConnList); 566 567 // prüfen ob alle zu aktualisierenden Datenbanken exklusiv geöffnet werden können 568 nConnCount := 0; 569 while nConnCount < AConnList.Count do begin 570 // ersetzen der %APPDIR%'s und %DBDIR%'s im connectionstring 571 tmpConn := StringReplace(AConnList.Values[AConnList.Names[nConnCount]], '%APPDIR%', AppPath, [rfReplaceAll, rfIgnoreCase]); 572 tmpConn := StringReplace(tmpConn, '%DBDIR%', ADBPath, [rfReplaceAll, rfIgnoreCase]); 573 574 // Information für Versionstabelle, Feld und neuen Wert auslesen 575 tmpVerTable := ABatchFile.ReadString(AConnList.Names[nConnCount], 'TBL_VER', ''); 576 tmpVerField := ABatchFile.ReadString(AConnList.Names[nConnCount], 'FLD_VER', ''); 577 tmpVerValue := ABatchFile.ReadString(AConnList.Names[nConnCount], 'NEW_VER', ''); 578 579 // ... wenn die Datenbank aktualisiert werden muss 580 if ABatchFile.ValueExists(AConnList.Names[nConnCount], 'SQL1') and CheckUpdateNeeded(tmpConn, tmpVerTable, tmpVerField, tmpVerValue, true) then begin 581 // prüfen ob die Verbindung exklusiv geöffnet werden kann 582 with TADOConnection.Create(nil) do 583 try 584 ConnectionString := tmpConn; 585 CursorLocation := clUseServer; 586 Mode := cmShareExclusive; 587 LoginPrompt := false; 588 try 589 Connected := true; 590 except 591 on E : EOleException do 592 if Errors[nCount].SQLState = '3356' then 593 raise Exception.CreateHelp('Fehler bei der Datenbank-Aktualisierung.'#13#10'''' + ADBPath + ''' kann nicht exklusiv geöffnet werden.'#13#10'Stellen Sie sicher daß die Datenbank nicht genutzt wird.', 3356) 594 else 595 raise E; 596 end; 597 Connected := false; 598 finally 599 Free; 600 end; 601 602 AConnList.Values[AConnList.Names[nConnCount]] := tmpConn; 603 nConnCount := nConnCount + 1; 604 end 605 else 606 AConnList.Delete(nConnCount); 607 end; {for - connections} 608 609 610 for nConnCount := 0 to AConnList.Count - 1 do begin 611 // Information für Versionstabelle, Feld und neuen Wert auslesen 612 tmpVerTable := ABatchFile.ReadString(AConnList.Names[nConnCount], 'TBL_VER', ''); 613 tmpVerField := ABatchFile.ReadString(AConnList.Names[nConnCount], 'FLD_VER', ''); 614 tmpVerValue := ABatchFile.ReadString(AConnList.Names[nConnCount], 'NEW_VER', ''); 615 616 ABatchFile.ReadSectionValues(AConnList.Names[nConnCount], ASQLList); 617 618 // zugehörige liste der sql-statements ermitteln und %APPDIR%'s und %DBDIR%'s ersetzen 619 nSQLCount := 0; 620 while nSQLCount < ASQLList.Count do 621 if Pos('SQL', ANSIUpperCase(ASQLList.Names[nSQLCount])) = 1 then begin 622 tmpSQL := StringReplace(ASQLList.Values[ASQLList.Names[nSQLCount]], '%APPDIR%', AppPath, [rfReplaceAll, rfIgnoreCase]); 623 tmpSQL := StringReplace(tmpSQL, '%DBPATH%', ADBPath, [rfReplaceAll, rfIgnoreCase]); 624 ASQLList[nSQLCount] := tmpSQL; 625 nSQLCount := nSQLCount + 1; 626 end 627 else 628 ASQLList.Delete(nSQLCount); 629 630 if (ASQLList.Count > 0) then 631 try 632 ADOExecuteSQLList(AConnList.Values[AConnList.Names[nConnCount]], ASQLList, tmpVerTable, tmpVerField, tmpVerValue); 633 finally 634 end; 635 end; 636 finally 637 ASQLList.Free; 638 AConnList.Free; 639 ABatchFile.Free; 640 end; 641end; 642 643procedure ADOExecuteSQLBatchFile(AControlIniFile : TFileName; ASQLServer, AUser, APWD : String); 644var 645 nCount, 646 nConnCount, 647 nSQLCount : Integer; 648 ABatchFile : TMemIniFile; 649 ASQLList, 650 AConnList : TStringList; 651 AConnection : WideString; 652 AppPath : TFileName; 653 tmpSQL, 654 tmpConn, 655 tmpVerTable, 656 tmpVerField, 657 tmpVerValue : String; 658begin 659 // pfad der anwendung ohne abschliessenden backslash 660 AppPath := ExtractFilePath(Application.ExeName); 661 if AppPath[Length(AppPath)] = '\' then Delete(AppPath, Length(AppPath), 1); 662 663 ABatchFile := TMemIniFile.Create(AControlIniFile); 664 ASQLList := TStringList.Create; 665 AConnList := TStringList.Create; 666 try 667 ABatchFile.ReadSectionValues('Connections', AConnList); 668 669 // prüfen ob alle zu aktualisierenden Datenbanken exklusiv geöffnet werden können 670 nConnCount := 0; 671 while nConnCount < AConnList.Count do begin 672 // ersetzen der %APPDIR%'s und %DBDIR%'s im connectionstring 673 tmpConn := StringReplace(AConnList.Values[AConnList.Names[nConnCount]], '%APPDIR%', AppPath, [rfReplaceAll, rfIgnoreCase]); 674 tmpConn := StringReplace(tmpConn, '%SQLSERVER%', ASQLServer, [rfReplaceAll, rfIgnoreCase]); 675 tmpConn := StringReplace(tmpConn, '%SQLUSER%', AUser, [rfReplaceAll, rfIgnoreCase]); 676 tmpConn := StringReplace(tmpConn, '%SQLPWD%', APWD, [rfReplaceAll, rfIgnoreCase]); 677 678 679 // Information für Versionstabelle, Feld und neuen Wert auslesen 680 tmpVerTable := ABatchFile.ReadString(AConnList.Names[nConnCount], 'TBL_VER', ''); 681 tmpVerField := ABatchFile.ReadString(AConnList.Names[nConnCount], 'FLD_VER', ''); 682 tmpVerValue := ABatchFile.ReadString(AConnList.Names[nConnCount], 'NEW_VER', ''); 683 684 // ... wenn die Datenbank aktualisiert werden muss 685 if ABatchFile.ValueExists(AConnList.Names[nConnCount], 'SQL1') and CheckUpdateNeeded(tmpConn, tmpVerTable, tmpVerField, tmpVerValue, true) then begin 686 AConnList.Values[AConnList.Names[nConnCount]] := tmpConn; 687 nConnCount := nConnCount + 1; 688 end 689 else 690 AConnList.Delete(nConnCount); 691 end; {for - connections} 692 693 694 for nConnCount := 0 to AConnList.Count - 1 do begin 695 // Information für Versionstabelle, Feld und neuen Wert auslesen 696 tmpVerTable := ABatchFile.ReadString(AConnList.Names[nConnCount], 'TBL_VER', ''); 697 tmpVerField := ABatchFile.ReadString(AConnList.Names[nConnCount], 'FLD_VER', ''); 698 tmpVerValue := ABatchFile.ReadString(AConnList.Names[nConnCount], 'NEW_VER', ''); 699 700 ABatchFile.ReadSectionValues(AConnList.Names[nConnCount], ASQLList); 701 702 // zugehörige liste der sql-statements ermitteln und %APPDIR%'s und %DBDIR%'s ersetzen 703 nSQLCount := 0; 704 while nSQLCount < ASQLList.Count do 705 if Pos('SQL', ANSIUpperCase(ASQLList.Names[nSQLCount])) = 1 then begin 706 tmpSQL := StringReplace(ASQLList.Values[ASQLList.Names[nSQLCount]], '%APPDIR%', AppPath, [rfReplaceAll, rfIgnoreCase]); 707 tmpSQL := StringReplace(tmpSQL, '%SQLSERVER%', ASQLServer, [rfReplaceAll, rfIgnoreCase]); 708 tmpSQL := StringReplace(tmpSQL, '%SQLUSER%', AUser, [rfReplaceAll, rfIgnoreCase]); 709 tmpSQL := StringReplace(tmpSQL, '%SQLPWD%', APWD, [rfReplaceAll, rfIgnoreCase]); 710 ASQLList[nSQLCount] := tmpSQL; 711 nSQLCount := nSQLCount + 1; 712 end 713 else 714 ASQLList.Delete(nSQLCount); 715 716 if (ASQLList.Count > 0) then 717 try 718 ADOExecuteSQLList(AConnList.Values[AConnList.Names[nConnCount]], ASQLList, tmpVerTable, tmpVerField, tmpVerValue); 719 finally 720 end; 721 end; 722 finally 723 ASQLList.Free; 724 AConnList.Free; 725 ABatchFile.Free; 726 end; 727end; 728 729procedure CreateVersionTable(theConnection : TADOConnection; theVerTable, theVerField, theVerValue : String); 730var 731 tmpSQL : String; 732 rs : ADODB._RecordSet; 733begin 734 if not ContainsTableMDB(theConnection, theVerTable) then begin 735 // Tabelle anlegen 736 tmpSQL := 'CREATE TABLE ' + theVerTable + ' (' + theVerField + ' Double DEFAULT NULL)'; 737 rs := theConnection.Execute(tmpSQL); 738 // Versionseintrag anlegen 739 tmpSQL := 'INSERT INTO ' + theVerTable + ' (' + theVerField + ') VALUES (NULL)'; 740 rs := theConnection.Execute(tmpSQL); 741 end; 742end; 743 744procedure UpdateVersionTable(theConnection : TADOConnection; theVerTable, theVerField, theVerValue : String); 745var 746 tmpSQL : String; 747begin 748 // sicherstellen, daß Tabelle für Versionsinformationen vorhanden ist. 749 CreateVersionTable(theConnection, theVerTable, theVerField, theVerValue); 750 // neue Versionsinformation schreiben 751 if ((theVerTable <> '') and (theVerField <> '') and (theVerValue <> '')) then begin 752 tmpSQL := 'UPDATE ' + theVerTable + ' SET ' + theVerField + ' = ' + theVerValue; 753 theConnection.Execute(tmpSQL); 754 end; 755end; 756 757// führt im kontext des übergebenen connectionsstrings eine liste von 758// sql-statements aus 759procedure ADOExecuteSQLList(AConnectionString : WideString; ASQLCommandList : TStrings; AVerTable, AVerField, AVerValue : String); 760var 761 AnAdoConnection : TADOConnection; 762 outRecAffected : OleVariant; 763 nCount : Integer; 764begin 765 AnAdoConnection := TADOConnection.Create(nil); 766 767 if ASQLCommandList.Count > 0 then 768 if CheckUpdateNeeded(AConnectionString, AVerTable, AVerField, AVerValue, false) then 769 try 770 with AnAdoConnection do begin 771 ConnectionString := AConnectionString; 772 LoginPrompt := false; 773 Mode := cmShareExclusive; 774 Connected := true; 775 end; 776 777 try 778 // Liste der SQLs auf Verbindung ausführen. 779 for nCount := 0 to ASQLCommandList.Count - 1 do 780 try 781 AnAdoConnection.Execute(ASQLCommandList[nCount]); 782 except 783 end; 784 finally 785 if (AVerTable <> '') then 786 UpdateVersionTable(AnAdoConnection, AVerTable, AVerField, AVerValue); 787 end; 788 finally 789 AnAdoConnection.Connected := false; 790 AnAdoConnection.Free; 791 end; 792end; 793 794function DateToSQLStr(dtDate : TDate) : String; 795begin 796 Result := FormatDateTime('"#"mm"/"dd"/"yyyy"#"', dtDate); 797end; 798 799// kopiert den inhalt eines ado-datasets in eine stringlist ohne 800// ohne hierzu eine externe datei anzulegen (vgl. SaveAs Methode) 801procedure ADOCopyXMLToStringList(ADataSet : TCustomADODataSet; AStrings : TStrings); 802var 803 ADOXRecordSet : ADODB_TLB.TRecordset; 804 tempADOStream : ADODB_TLB.TStream; 805begin 806 tempADOStream := ADODB_TLB.TStream.Create(nil); 807 try 808 // XML aus ADODataSet in TRecordSet (ADOX) übernehmen 809 // und via save-Methode direkt in Stream ablegen 810 ADOXRecordSet := ADODB_TLB.TRecordSet.Create(nil); 811 try 812 ADOXRecordSet.ConnectTo(ADataSet.RecordSet as _RecordSet); 813 ADOXRecordSet.Save(tempADOStream.DefaultInterface, adPersistXML); 814 AStrings.SetText(PChar(tempADOStream.ReadText(tempADOStream.Size))); 815 finally 816 ADOXRecordSet.Free; 817 end; 818 finally 819 tempADOStream.Free; 820 end; 821end; 822 823end. 824 825initialization 826 sPath := ExtractFilePath(Application.ExeName); 827 828 829