unit ADOUtilities;



interface



uses SysUtils, Windows, Forms, Controls, Classes, IniFiles, StdCtrls, Variants,

     ADODB, ADODB_TLB, ADOX_TLB, JRO_TLB, Registry, FileCtrl, ComObj, Dialogs, DB;



var

  sPath : TFileName;



function SQLFormatDateTime(const AValue: TDateTime): String;



function GetADOVersion : String;



function ConnectionStringForMDBFile(aMDBFile : TFileName) : String; overload;

function ConnectionStringForMDBFile(aMDBFile : TFileName; aPassWord : String) : String; overload;

function ConnectionSetStringMDB(DBFile : TFileName; DBConn : TADOConnection) : Boolean;



procedure CompressRepairMDB(DBFile : TFileName); overload;

procedure CompressRepairMDB(DBFile : TFileName; APassword : String); overload;



procedure CreateAccess97MDB(AFileName : TFileName);

procedure CreateAccess2KMDB(AFileName : TFileName);

procedure CreateExcel8XLS(AFileName : TFileName);

procedure CreateCatalog(AFileName : TFileName; AJetEngineType : Word);



function ContainsTableMDB(DBFile : TFileName; DBTable : String) : Boolean; overload;

function ContainsTableMDB(DBConn : TADOConnection; DBTable : String) : Boolean; overload;

function CreateTableMDB(DBConn : TADOConnection; DBTable : String) : Boolean;



function CountConnectedWorkStations_SQLServer(AnADOConnection : TADOConnection) : Integer;

function CountConnectedWorkStations_Access(AnADOConnection : TADOConnection) : Integer;



function SimpleLookup(AKeyField : String; AKeyValue : Variant; AResultField, ATable : String; DBConn : TADOConnection) : Variant;

function DateToSQLStr(dtDate : TDate) : String;



procedure ShowSQL(DataSet : TDataSet);

procedure ShowSQLText(AString, ACaption : String);





procedure ADOExecuteSQLList(AConnectionString : WideString; ASQLCommandList : TStrings; AVerTable, AVerField, AVerValue : String);

procedure ADOExecuteSQLBatchFile(AControlIniFile : TFileName; ADBPath : String); overload;

procedure ADOExecuteSQLBatchFile(AControlIniFile : TFileName; ASQLServer, AUser, APWD : String); overload;



procedure ADOCopyXMLToStringList(ADataSet : TCustomADODataSet; AStrings : TStrings);



Procedure ADOSaveRequery(ADataSet : TCustomADODataSet);





implementation



function SQLFormatDateTime(const AValue: TDateTime): String;

begin

  Result := '{ts ' + QuotedStr(FormatDateTime('yyyy-mm-dd hh:nn:ss', AValue)) + '}'; // SQL Server sicheres DATETIME, z.B. {ts '2009-04-06 12:00:00'}

end;





Procedure ADOSaveRequery(ADataSet : TCustomADODataSet);

begin

  if Assigned(ADataSet) and ADataSet.Active then ADataSet.Requery();

end;





function GetADOVersion: string;

var

  ADO: OLEVariant;

begin

  try

    ADO := CreateOLEObject('ADODB.Connection');

    Result := ADO.Version;

    ADO:= null;

  except

    Result := ' No version';

  end;

end;



procedure ShowSQL(DataSet : TDataSet);

begin

  if DataSet is TADOQuery then

    ShowSQLText(TADOQuery(DataSet).SQL.Text, DataSet.Name);

  if DataSet is TADODataSet then

    ShowSQLText(TADODataSet(DataSet).CommandText, DataSet.Name);

end;



procedure ShowSQLText(AString, ACaption : String);

var

  frm : TForm;

  tmem : TMemo;

begin

  frm := TForm.Create(nil);

  frm.Caption := ACaption;

  tmem := TMemo.Create(frm);

  tmem.Parent := frm;

  tmem.Align := alClient;

  tmem.Lines.Text := AString;

  frm.ShowModal;

  tmem.Free;

  frm.Free;

end;



function SimpleLookup(AKeyField : String; AKeyValue : Variant; AResultField, ATable : String; DBConn : TADOConnection) : Variant;

var

  tmpSQL : String;

  rs     : ADODB._RecordSet;

begin

  Result := varNull;



  tmpSQL := 'SELECT DISTINCT %s FROM %s WHERE %s = %s';

  tmpSQL := Format(tmpSQL, [AResultField, ATable, AKeyField, VarToStr(AKeyValue)]);

  rs := DBConn.Execute(tmpSQL);

  if (rs.RecordCount > 0) then

    Result := rs.Fields[0].Value;

  rs.Close;

end;



function ConnectionSetStringMDB(DBFile : TFileName; DBConn : TADOConnection) : Boolean;

begin

  Result := false;



  if ((not FileExists(DBFile)) or (not Assigned(DBConn))) then

    Exit;



  // Connection-String setzen und Verbindung öffnen

  with DBConn do begin

    // Connection schließen

    Connected := false;

    LoginPrompt := false;

    // Connection-String aufbauen

    ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;';

    ConnectionString := ConnectionString + 'Password="";';

    ConnectionString := ConnectionString + 'User ID=Admin;';

    ConnectionString := ConnectionString + 'Data Source=' + DBFile + ';';

    ConnectionString := ConnectionString + 'Mode=ReadWrite;';

    ConnectionString := ConnectionString + 'Extended Properties="";';

    ConnectionString := ConnectionString + 'Locale Identifier=1033;';

    ConnectionString := ConnectionString + 'Jet OLEDB:System database="";';

    ConnectionString := ConnectionString + 'Jet OLEDB:Registry Path="";';

    ConnectionString := ConnectionString + 'Jet OLEDB:Database Password="";';

    ConnectionString := ConnectionString + 'Jet OLEDB:Engine Type=5;';

    ConnectionString := ConnectionString + 'Jet OLEDB:Database Locking Mode=1;';

    ConnectionString := ConnectionString + 'Jet OLEDB:Global Partial Bulk Ops=2;';

    ConnectionString := ConnectionString + 'Jet OLEDB:Global Bulk Transactions=1;';

    ConnectionString := ConnectionString + 'Jet OLEDB:New Database Password="";';

    ConnectionString := ConnectionString + 'Jet OLEDB:Create System Database=False;';

    ConnectionString := ConnectionString + 'Jet OLEDB:Encrypt Database=False;';

    ConnectionString := ConnectionString + 'Jet OLEDB:Don''t Copy Locale on Compact=False;';

    ConnectionString := ConnectionString + 'Jet OLEDB:Compact Without Replica Repair=False;';

//    ConnectionString := ConnectionString + 'Jet OLEDB:Page Timeout=0;';

    ConnectionString := ConnectionString + 'Jet OLEDB:SFP=False';

    Result := true;

  end;

end;



function ConnectionStringForMDBFile(aMDBFile : TFileName) : String;

begin

  result := ConnectionStringForMDBFile(aMDBFile, '');

end;



function ConnectionStringForMDBFile(aMDBFile : TFileName; aPassWord : String) : String;

var

  cs : String;

begin

  cs := '';



  if FileExists(aMDBFile) then begin

    // Connection-String aufbauen

    cs := 'Provider=Microsoft.Jet.OLEDB.4.0;';

    cs := cs + 'Password="";';

    cs := cs + 'User ID=Admin;';

    cs := cs + 'Data Source=' + aMDBFile + ';';

    cs := cs + 'Mode=Share Deny None;';

    cs := cs + 'Extended Properties="";';

    cs := cs + 'Locale Identifier=1033;';

    cs := cs + 'Jet OLEDB:System database="";';

    cs := cs + 'Jet OLEDB:Registry Path="";';

    cs := cs + 'Jet OLEDB:Database Password="' + aPassWord+ '";';

    cs := cs + 'Jet OLEDB:Engine Type=5;';

    cs := cs + 'Jet OLEDB:Database Locking Mode=1;';

    cs := cs + 'Jet OLEDB:Global Partial Bulk Ops=2;';

    cs := cs + 'Jet OLEDB:Global Bulk Transactions=1;';

    cs := cs + 'Jet OLEDB:New Database Password="";';

    cs := cs + 'Jet OLEDB:Create System Database=False;';

    cs := cs + 'Jet OLEDB:Encrypt Database=False;';

    cs := cs + 'Jet OLEDB:Don''t Copy Locale on Compact=False;';

    cs := cs + 'Jet OLEDB:Compact Without Replica Repair=False;';

    cs := cs + 'Jet OLEDB:SFP=False';

  end;

  Result := cs;

end;



function CountConnectedWorkStations_SQLServer(AnADOConnection : TADOConnection) : Integer;

const

  SQL = 'SET NOCOUNT ON ' + #13#10 +

        '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 +

        'INSERT #who EXEC sp_who ' + #13#10 +

        'SELECT Count(*) AS connections FROM #who where dbname = ''%s'' ' + #13#10 +

        'DROP TABLE #who ' + #13#10 +

        'SET NOCOUNT OFF';

var

  rs : ADODB._RecordSet;

begin

  Result := 0;

  rs := AnADOConnection.Execute(Format(SQL, [AnADOConnection.Properties['Initial Catalog'].Value]));

  if (rs.RecordCount > 0) then

      Result := StrToInt(VarToStr(rs.Fields['connections'].Value));

end;



function CountConnectedWorkStations_Access(AnADOConnection : TADOConnection) : Integer;

const JET_SCHEMA_USERROSTER = '{947bb102-5d43-11d1-bdbf-00c04fb92675}';

var

  tmpADODataSet : TADODataSet;

  tmpStrLst     : TStringList;

begin

 Result := 0;

 try

   tmpADODataSet := TADODataSet.Create(nil);

   tmpStrLst     := TStringList.Create;



   AnADOConnection.OpenSchema(siProviderSpecific, EmptyParam, JET_SCHEMA_USERROSTER, tmpADODataSet);



   tmpADODataSet.First;

   while not tmpADODataSet.EOF do begin

     if (tmpStrLst.IndexOf(tmpADODataSet['COMPUTER_NAME']) = -1) then

       tmpStrLst.Add(tmpADODataSet['COMPUTER_NAME']);

     tmpADODataSet.Next;

   end;



   Result := tmpStrLst.Count;

 finally

   tmpStrLst.Free;

   tmpADODataSet.Free;

 end;

end;



procedure CreateAccess97MDB(AFileName : TFileName);

begin

  CreateCatalog(AFileName, 4);

end;



procedure CreateAccess2KMDB(AFileName : TFileName);

begin

  CreateCatalog(AFileName, 5);

end;



procedure CreateExcel8XLS(AFileName : TFileName);

begin

  CreateCatalog(AFileName, 23);

end;



procedure CreateCatalog(AFileName : TFileName; AJetEngineType : Word);

var

  Catalog    : _Catalog; // the database

  DataSource : String;

begin

  // A spot of housekeeping first up

  if FileExists(AFileName) then

    DeleteFile(PChar(AFileName));



  // Create a catalog (database) object using the provided COM object

  // creation method - no need for wrappers and no need for garbage

  // collection.  All COM objects created will be automatically destroyed

  // when they go out of scope. (The OP compiler adds code to decrement

  // each object's reference count when they go out of scope.  Since creating

  // the object in OP automatically increments its reference count to 1, this

  // ensures that COM will destroy the object because its reference count

  // then equals 0.  Note that the scope is defined by the object's

  // declaration procedure, which is not necessarily where they are created).

  Catalog := CoCatalog.Create;



  // Set the connection string.

  // Note that properties specified in the connection string, such as

  // Jet OLEDB:Engine Type or Jet OLEDB:Encrypt Database are subsequently

  // used in the Catalog.Create method, but not all connection properties are

  // supported.  See the Microsoft Jet 4.0 OLE DB Properties Reference for

  // further details.

  // BTW, Jet Engine Type 5 = Access 2000; Type 4 = Access 97

    { Global Const JET_ENGINETYPE_UNKNOWN = 0

      Global Const JET_ENGINETYPE_JET10 = 1

      Global Const JET_ENGINETYPE_JET11 = 2

      Global Const JET_ENGINETYPE_JET20 = 3

      Global Const JET_ENGINETYPE_JET3X = 4

      Global Const JET_ENGINETYPE_JET4X = 5

      Global Const JET_ENGINETYPE_DBASE3 = 10

      Global Const JET_ENGINETYPE_DBASE4 = 11

      Global Const JET_ENGINETYPE_DBASE5 = 12

      Global Const JET_ENGINETYPE_EXCEL30 = 20

      Global Const JET_ENGINETYPE_EXCEL40 = 21

      Global Const JET_ENGINETYPE_EXCEL50 = 22

      Global Const JET_ENGINETYPE_EXCEL80 = 23

      Global Const JET_ENGINETYPE_EXCEL90 = 24

      Global Const JET_ENGINETYPE_EXCHANGE4 = 30

      Global Const JET_ENGINETYPE_LOTUSWK1 = 40

      Global Const JET_ENGINETYPE_LOTUSWK3 = 41

      Global Const JET_ENGINETYPE_LOTUSWK4 = 42

      Global Const JET_ENGINETYPE_PARADOX3X = 50

      Global Const JET_ENGINETYPE_PARADOX4X = 51

      Global Const JET_ENGINETYPE_PARADOX5X = 52

      Global Const JET_ENGINETYPE_PARADOX7X = 53

      Global Const JET_ENGINETYPE_TEXT1X = 60

      Global Const JET_ENGINETYPE_HTML1X = 70  }

  DataSource := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' + AFileName + ';Jet OLEDB:Engine Type=' + IntToStr(AJetEngineType);

  if AJetEngineType = 23 then

    DataSource := DataSource + ';Extended Properties=Excel 8.0'; 



  // Create a new Access database

  Catalog.Create(DataSource);

end;



procedure CompressRepairMDB(DBFile : TFileName);

begin

  CompressRepairMDB(DBFile, '');

end;



procedure CompressRepairMDB(DBFile : TFileName; APassword : String);

const

  tmpDBName = 'compress.mdb';

var

  JROJetEngine : TJetEngine;

  srcConn,

  destConn : String;

begin

  JROJetEngine := TJetEngine.Create(nil);

  try

    srcConn  := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' + DBFile;

    destConn := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' + sPath + tmpDBName;



    if APassWord <> '' then begin

      srcConn  := srcConn + ';Jet OLEDB:Database Password="' + APassWord+ '"';

      destConn := destConn + ';Jet OLEDB:Database Password="' + APassWord+ '"';

    end;



    // Datenbank reparieren & komprimieren

    JROJetEngine.CompactDatabase(srcConn, destConn);



    if FileExists(sPath + tmpDBName) then begin

      // Ausgangsdatenbank löschen

      DeleteFile(PChar(DBFile));

      // Komprimierte DB anstelle der AusgangsDB kopieren

      CopyFile(PChar(sPath + tmpDBName), PChar(DBFile), false);

      // Komprimierte DB löschen

      DeleteFile(PChar(sPath + tmpDBName));

    end;

  finally

    JROJetEngine.Disconnect;

    JROJetEngine.Free;

  end;

end;



function ContainsTableMDB(DBFile : TFileName; DBTable : String) : Boolean;

var ADOConnTmp  : TADOConnection;

    ADOXCatalog : ADOX_TLB.TCatalog;

    nCount : LongInt;

begin

  Result := false;

  ADOConnTmp := TADOConnection.Create(nil);

  try

    if ConnectionSetStringMDB(DBFile, ADOConnTmp) then begin

      ADOConnTmp.Connected := true;

      ADOXCatalog := TCatalog.Create(nil);

      try

        ADOXCatalog.Set_ActiveConnection(ADOConnTmp.ConnectionObject);

        for nCount := 0 to ADOXCatalog.Tables.Count - 1 do begin

          if (AnsiUpperCase(DBTable) = AnsiUpperCase(ADOXCatalog.Tables.Item[nCount].Name)) then begin

            Result := true;

            Exit;

          end;

        end;

      finally

        ADOXCatalog.Free;

      end;

    end;

  finally

    ADOConnTmp.Free;

  end;

end;



function ContainsTableMDB(DBConn : TADOConnection; DBTable : String) : Boolean;

var ADOXCatalog : TCatalog;

    nCount : LongInt;

begin

  Result := false;

  DBConn.Connected := true;

  ADOXCatalog := TCatalog.Create(nil);

  try

    ADOXCatalog.Set_ActiveConnection(DBConn.ConnectionObject);

    for nCount := 0 to ADOXCatalog.Tables.Count - 1 do begin

      if (AnsiUpperCase(DBTable) = AnsiUpperCase(ADOXCatalog.Tables.Item[nCount].Name)) then begin

        Result := true;

        Exit;

      end;

    end;

  finally

    ADOXCatalog.Free;

  end;

end;



function CreateTableMDB(DBConn : TADOConnection; DBTable : String) : Boolean;

var ADOXCatalog : TCatalog;

    ADOX_Table   : _Table;

    nCount : LongInt;

begin

  Result := false;

  DBConn.Connected := true;

  ADOXCatalog := TCatalog.Create(nil);

  try

    ADOXCatalog.Set_ActiveConnection(DBConn.ConnectionObject);

    ADOX_Table := {TADOXTable}CoTable.Create;

    try

      ADOX_Table.Name := DBTable;

      ADOXCatalog.Tables.Append(ADOX_Table);

      Result := false;

    finally

      ADOX_Table := nil;

    end;

  finally

    ADOXCatalog.Free;

  end;

end;



{

function CreateAndPopulateRemoteTable(DBConnSrc, DBConnDest : TADOConnection; RecordSet : TRecordSet; sName : String) : Boolean;

var

  ADOXCatalog : TCatalog;

  ADOXTable : TADOXTable;

  nFields : Integer;

  ADOXRecordSet : TRecordset;

begin

  // Open a connection to your Remote Jet Database

  ADOXCatalog := TCatalog.Create(nil);

  ADOXTable   := TADOXTable.Create(nil);

  ADOXCatalog.Set_ActiveConnection(DBConn.ConnectionObject);

  ADOXTable.Name = sName;



  for nFields = 0 to RecordSet.Fields.Count - 1 do begin

    case RecordSet.Fields(nFields).Type of

      203, 202, 201, 200 :

        ADOXTable.Columns.Append(RecordSet.Fields(nFields).Name, adVarChar, rst.Fields(nFields).DefinedSize;

      135, 134, 133, 7

        ADOXTable.Columns.Append RecordSet.Fields(Fields).Name, adDate, RecordSet.Fields(nFields).DefinedSize;

      11

        ADOXTable.Columns.Append RecordSet.Fields(nFields).Name, adBoolean, RecordSet.Fields(nFields).DefinedSize;

      131, 14, 6, 5, 4

        ADOXTable.Columns.Append RecordSet.Fields(nFields).Name, adDouble;

      20, 19, 18, 17, 16, 3, 2

        ADOXTable.Columns.Append RecordSet.Fields(nFields).Name, adInteger;

      else

        ADOXTable.Columns.Append RecordSet.Fields(nFields).Name, adVarChar, 255;

    end;

  end;



  // Drop Table if it already exists

  ADOXCatalog.Tables.Delete(sName)

  // Append table to TableDefs collection

  ADOXCatalog.Tables.Append(ADOXTable)



  ADOXRecordSet.Set_ActiveConnection(DBConn.ConnectionObject);

  ADOXRecordSet.Open(sName, DBConn, adOpenDynamic, adLockOptimistic);



  if not ADOXRecordSet.BOF then ADOXRecordSet.MoveFirst

  while not ADOXRecordSet.EOF do begin

    nFields = 0;

    ADOXRecordSet.AddNew;

    for nFields = 0 to RecordSet.Fields.Count - 1 do

        ADOXRecordSet.Fields(ADOXRecordSet.Fields(nFields).Name) = RecordSet.Fields(ADOXRecordSet.Fields(nFields).Name) + '"';

    ADOXRecordSet.Update;

    RecordSet.MoveNext

  end;



  ADOXTable.Free;

  ADOXCatalog.Free;

end;

}



function CheckUpdateNeeded(theConnectionString, theVerTable, theVerField, theVerValue : String; IgnoreDBPassWordError : Boolean) : Boolean;

var

  rs              : ADODB._RecordSet;

  connVersionTest : TADOConnection;

  tmpSQL          : String;

begin

  Result := true;



  if ((theVerTable = '') and (theVerField = '') and (theVerValue = '')) then

    Exit;



  connVersionTest := TADOConnection.Create(nil);

  with connVersionTest do

    try

      ConnectionString := theConnectionString;

      CursorLocation   := clUseServer;

      LoginPrompt      := false;

      try

        Connected        := true;



        try

          if ContainsTableMDB(connVersionTest, theVerTable) then begin

            tmpSQL := 'SELECT * FROM ' + theVerTable + ' WHERE (' + theVerField + ' < ' + theVerValue + ')';

            rs := connVersionTest.Execute(tmpSQL);

            Result := (Abs(rs.RecordCount) > 0) and (not (rs.EOF or rs.BOF));

          end

        except

          on E : Exception do

            raise Exception.Create('Fehler bei Überprüfung der Versionsinformation.'#13#10 + E.Message);

        end;



      except

        on E : EOleException do begin

          // Fehler bei falschem Password übergehen ?

          if (Errors[Errors.Count-1].SQLState = '3031') and IgnoreDBPassWordError then

            Result := false

          else

            raise E;

        end;

      end;





      Connected        := false;

    finally

      Free;

    end;

end;



// führt eine liste von sql-befehlen aus einer ini-datei aus

// ini-datei besitzt dazu eine section connections mit ado-connection strings

// und je connectionstring eine section mit einer liste von sql-statements.

// diese sections tragen jeweils den namen des connectionsstrings.

// um relative pfade im connectionstring und den sql-string zu ermöglichen

// wird die zeichenfolge %APPDIR% generell gegen das Verzeichnis der

// anwendung erstezt.



// Aufruf in etwa :

//   if FileExists(FAppPath + 'update.bat') then begin

//     ADOExecuteSQLBatchFile(FAppPath + 'update.bat');

//     DeleteFile(FAppPath + 'update.bat');

//   end;



procedure ADOExecuteSQLBatchFile(AControlIniFile : TFileName; ADBPath : String);

var

  nCount,

  nConnCount,

  nSQLCount   : Integer;

  ABatchFile  : TMemIniFile;

  ASQLList,

  AConnList   : TStringList;

  AConnection : WideString;

  AppPath     : TFileName;

  tmpSQL,

  tmpConn,

  tmpVerTable,

  tmpVerField,

  tmpVerValue : String;

begin

  // pfad der anwendung ohne abschliessenden backslash

  AppPath := ExtractFilePath(Application.ExeName);

  if AppPath[Length(AppPath)] = '\' then Delete(AppPath, Length(AppPath), 1);



  if (ADBPath <> '') and (not DirectoryExists(ADBPath)) then

    raise Exception.Create('Fehler bei der Datenbank-Aktualisierung.'#13#10'''' + ADBPath + ''' existiert nicht.')

  else

    if ADBPath[Length(ADBPath)] = '\' then Delete(ADBPath, Length(ADBPath), 1);



  ABatchFile := TMemIniFile.Create(AControlIniFile);

  ASQLList   := TStringList.Create;

  AConnList  := TStringList.Create;

  try

    ABatchFile.ReadSectionValues('Connections', AConnList);



    // prüfen ob alle zu aktualisierenden Datenbanken exklusiv geöffnet werden können

    nConnCount := 0;

    while nConnCount < AConnList.Count do begin

      // ersetzen der %APPDIR%'s und %DBDIR%'s im connectionstring

      tmpConn := StringReplace(AConnList.Values[AConnList.Names[nConnCount]], '%APPDIR%', AppPath, [rfReplaceAll, rfIgnoreCase]);

      tmpConn := StringReplace(tmpConn, '%DBDIR%', ADBPath, [rfReplaceAll, rfIgnoreCase]);



      // Information für Versionstabelle, Feld und neuen Wert auslesen

      tmpVerTable := ABatchFile.ReadString(AConnList.Names[nConnCount], 'TBL_VER', '');

      tmpVerField := ABatchFile.ReadString(AConnList.Names[nConnCount], 'FLD_VER', '');

      tmpVerValue := ABatchFile.ReadString(AConnList.Names[nConnCount], 'NEW_VER', '');



      // ... wenn die Datenbank aktualisiert werden muss

      if ABatchFile.ValueExists(AConnList.Names[nConnCount], 'SQL1') and CheckUpdateNeeded(tmpConn, tmpVerTable, tmpVerField, tmpVerValue, true) then begin

        // prüfen ob die Verbindung exklusiv geöffnet werden kann

        with TADOConnection.Create(nil) do

          try

            ConnectionString := tmpConn;

            CursorLocation := clUseServer;

            Mode := cmShareExclusive;

            LoginPrompt := false;

            try

              Connected := true;

            except

              on E : EOleException do

                if Errors[nCount].SQLState = '3356' then

                  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)

                else

                  raise E;

            end;

            Connected := false;

          finally

            Free;

          end;



        AConnList.Values[AConnList.Names[nConnCount]] :=  tmpConn;

        nConnCount := nConnCount + 1;

      end

      else

        AConnList.Delete(nConnCount);

    end; {for - connections}





    for nConnCount := 0 to AConnList.Count - 1 do begin

      // Information für Versionstabelle, Feld und neuen Wert auslesen

      tmpVerTable := ABatchFile.ReadString(AConnList.Names[nConnCount], 'TBL_VER', '');

      tmpVerField := ABatchFile.ReadString(AConnList.Names[nConnCount], 'FLD_VER', '');

      tmpVerValue := ABatchFile.ReadString(AConnList.Names[nConnCount], 'NEW_VER', '');



      ABatchFile.ReadSectionValues(AConnList.Names[nConnCount], ASQLList);



      // zugehörige liste der sql-statements ermitteln und %APPDIR%'s und %DBDIR%'s ersetzen

      nSQLCount := 0;

      while nSQLCount < ASQLList.Count do

        if Pos('SQL', ANSIUpperCase(ASQLList.Names[nSQLCount])) = 1 then begin

          tmpSQL := StringReplace(ASQLList.Values[ASQLList.Names[nSQLCount]], '%APPDIR%', AppPath, [rfReplaceAll, rfIgnoreCase]);

          tmpSQL := StringReplace(tmpSQL, '%DBPATH%', ADBPath, [rfReplaceAll, rfIgnoreCase]);

          ASQLList[nSQLCount] := tmpSQL;

          nSQLCount := nSQLCount + 1;

        end

        else

          ASQLList.Delete(nSQLCount);



      if (ASQLList.Count > 0) then

        try

          ADOExecuteSQLList(AConnList.Values[AConnList.Names[nConnCount]], ASQLList, tmpVerTable, tmpVerField, tmpVerValue);

        finally

        end;

    end;

  finally

    ASQLList.Free;

    AConnList.Free;

    ABatchFile.Free;

  end;

end;



procedure ADOExecuteSQLBatchFile(AControlIniFile : TFileName; ASQLServer, AUser, APWD : String);

var

  nCount,

  nConnCount,

  nSQLCount   : Integer;

  ABatchFile  : TMemIniFile;

  ASQLList,

  AConnList   : TStringList;

  AConnection : WideString;

  AppPath     : TFileName;

  tmpSQL,

  tmpConn,

  tmpVerTable,

  tmpVerField,

  tmpVerValue : String;

begin

  // pfad der anwendung ohne abschliessenden backslash

  AppPath := ExtractFilePath(Application.ExeName);

  if AppPath[Length(AppPath)] = '\' then Delete(AppPath, Length(AppPath), 1);



  ABatchFile := TMemIniFile.Create(AControlIniFile);

  ASQLList   := TStringList.Create;

  AConnList  := TStringList.Create;

  try

    ABatchFile.ReadSectionValues('Connections', AConnList);



    // prüfen ob alle zu aktualisierenden Datenbanken exklusiv geöffnet werden können

    nConnCount := 0;

    while nConnCount < AConnList.Count do begin

      // ersetzen der %APPDIR%'s und %DBDIR%'s im connectionstring

      tmpConn := StringReplace(AConnList.Values[AConnList.Names[nConnCount]], '%APPDIR%', AppPath, [rfReplaceAll, rfIgnoreCase]);

      tmpConn := StringReplace(tmpConn, '%SQLSERVER%', ASQLServer, [rfReplaceAll, rfIgnoreCase]);

      tmpConn := StringReplace(tmpConn, '%SQLUSER%', AUser, [rfReplaceAll, rfIgnoreCase]);

      tmpConn := StringReplace(tmpConn, '%SQLPWD%', APWD, [rfReplaceAll, rfIgnoreCase]);





      // Information für Versionstabelle, Feld und neuen Wert auslesen

      tmpVerTable := ABatchFile.ReadString(AConnList.Names[nConnCount], 'TBL_VER', '');

      tmpVerField := ABatchFile.ReadString(AConnList.Names[nConnCount], 'FLD_VER', '');

      tmpVerValue := ABatchFile.ReadString(AConnList.Names[nConnCount], 'NEW_VER', '');



      // ... wenn die Datenbank aktualisiert werden muss

      if ABatchFile.ValueExists(AConnList.Names[nConnCount], 'SQL1') and CheckUpdateNeeded(tmpConn, tmpVerTable, tmpVerField, tmpVerValue, true) then begin

        AConnList.Values[AConnList.Names[nConnCount]] :=  tmpConn;

        nConnCount := nConnCount + 1;

      end

      else

        AConnList.Delete(nConnCount);

    end; {for - connections}





    for nConnCount := 0 to AConnList.Count - 1 do begin

      // Information für Versionstabelle, Feld und neuen Wert auslesen

      tmpVerTable := ABatchFile.ReadString(AConnList.Names[nConnCount], 'TBL_VER', '');

      tmpVerField := ABatchFile.ReadString(AConnList.Names[nConnCount], 'FLD_VER', '');

      tmpVerValue := ABatchFile.ReadString(AConnList.Names[nConnCount], 'NEW_VER', '');



      ABatchFile.ReadSectionValues(AConnList.Names[nConnCount], ASQLList);



      // zugehörige liste der sql-statements ermitteln und %APPDIR%'s und %DBDIR%'s ersetzen

      nSQLCount := 0;

      while nSQLCount < ASQLList.Count do

        if Pos('SQL', ANSIUpperCase(ASQLList.Names[nSQLCount])) = 1 then begin

          tmpSQL := StringReplace(ASQLList.Values[ASQLList.Names[nSQLCount]], '%APPDIR%', AppPath, [rfReplaceAll, rfIgnoreCase]);

          tmpSQL := StringReplace(tmpSQL, '%SQLSERVER%', ASQLServer, [rfReplaceAll, rfIgnoreCase]);

          tmpSQL := StringReplace(tmpSQL, '%SQLUSER%', AUser, [rfReplaceAll, rfIgnoreCase]);

          tmpSQL := StringReplace(tmpSQL, '%SQLPWD%', APWD, [rfReplaceAll, rfIgnoreCase]);

          ASQLList[nSQLCount] := tmpSQL;

          nSQLCount := nSQLCount + 1;

        end

        else

          ASQLList.Delete(nSQLCount);



      if (ASQLList.Count > 0) then

        try

          ADOExecuteSQLList(AConnList.Values[AConnList.Names[nConnCount]], ASQLList, tmpVerTable, tmpVerField, tmpVerValue);

        finally

        end;

    end;

  finally

    ASQLList.Free;

    AConnList.Free;

    ABatchFile.Free;

  end;

end;



procedure CreateVersionTable(theConnection : TADOConnection; theVerTable, theVerField, theVerValue : String);

var

  tmpSQL : String;

  rs     : ADODB._RecordSet;

begin

  if not ContainsTableMDB(theConnection, theVerTable) then begin

    // Tabelle anlegen

    tmpSQL := 'CREATE TABLE ' + theVerTable + ' (' + theVerField + ' Double DEFAULT NULL)';

    rs := theConnection.Execute(tmpSQL);

    // Versionseintrag anlegen

    tmpSQL := 'INSERT INTO ' + theVerTable + ' (' + theVerField + ') VALUES (NULL)';

    rs := theConnection.Execute(tmpSQL);

  end;

end;



procedure UpdateVersionTable(theConnection : TADOConnection; theVerTable, theVerField, theVerValue : String);

var

  tmpSQL : String;

begin

  // sicherstellen, daß Tabelle für Versionsinformationen vorhanden ist.

  CreateVersionTable(theConnection, theVerTable, theVerField, theVerValue);

  // neue Versionsinformation schreiben

  if ((theVerTable <> '') and (theVerField <> '') and (theVerValue <> '')) then begin

    tmpSQL := 'UPDATE ' + theVerTable + ' SET ' + theVerField + ' = ' + theVerValue;

    theConnection.Execute(tmpSQL);

  end;

end;



// führt im kontext des übergebenen connectionsstrings eine liste von

// sql-statements aus

procedure ADOExecuteSQLList(AConnectionString : WideString; ASQLCommandList : TStrings; AVerTable, AVerField, AVerValue : String);

var

  AnAdoConnection : TADOConnection;

  outRecAffected  : OleVariant;

  nCount          : Integer;

begin

  AnAdoConnection := TADOConnection.Create(nil);



  if ASQLCommandList.Count > 0 then

    if CheckUpdateNeeded(AConnectionString, AVerTable, AVerField, AVerValue, false) then

      try

        with AnAdoConnection do begin

          ConnectionString := AConnectionString;

          LoginPrompt := false;

          Mode := cmShareExclusive;

          Connected := true;

        end;



        try

          // Liste der SQLs auf Verbindung ausführen.

          for nCount := 0 to ASQLCommandList.Count - 1 do

            try

              AnAdoConnection.Execute(ASQLCommandList[nCount]);

            except

            end;

        finally

          if (AVerTable <> '') then

            UpdateVersionTable(AnAdoConnection, AVerTable, AVerField, AVerValue);

        end;

      finally

        AnAdoConnection.Connected := false;

        AnAdoConnection.Free;

      end;

end;



function DateToSQLStr(dtDate : TDate) : String;

begin

  Result := FormatDateTime('"#"mm"/"dd"/"yyyy"#"', dtDate);

end;



// kopiert den inhalt eines ado-datasets in eine stringlist ohne

// ohne hierzu eine externe datei anzulegen (vgl. SaveAs Methode)

procedure ADOCopyXMLToStringList(ADataSet : TCustomADODataSet; AStrings : TStrings);

var

  ADOXRecordSet : ADODB_TLB.TRecordset;

  tempADOStream : ADODB_TLB.TStream;

begin

  tempADOStream := ADODB_TLB.TStream.Create(nil);

  try

    // XML aus ADODataSet in TRecordSet (ADOX) übernehmen

    // und via save-Methode direkt in Stream ablegen

    ADOXRecordSet := ADODB_TLB.TRecordSet.Create(nil);

    try

      ADOXRecordSet.ConnectTo(ADataSet.RecordSet as _RecordSet);

      ADOXRecordSet.Save(tempADOStream.DefaultInterface, adPersistXML);

      AStrings.SetText(PChar(tempADOStream.ReadText(tempADOStream.Size)));

    finally

      ADOXRecordSet.Free;

    end;

  finally

    tempADOStream.Free;

  end;

end;



end.



initialization

  sPath := ExtractFilePath(Application.ExeName);