/source/utils/ado/ADOUtilities.pas

  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