[DUG]: OLE_Error !!!!!!FIXED!!!!!!

[Chris Crowe]

I found some code a guy had written to traverse the dao collections of a database. His 
code does something to LICENCE the instance of the DAO Engine by the looks.....

Below is a working copy of the small app incase someone else finds they have this 
problem.

Chris


unit AddFieldForm;

interface

uses
  CallCentralConstants, CallCentralUtils, Registry,
  {$IFDEF CALLCENTRAL_DEBUG}
  AdrockDelphiDebug,
  {$ENDIF}

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ActiveX,ComObj,
  DAO_TLB, StdCtrls, ComCtrls, ImgList;

type
  TForm1 = class(TForm)
    CreateNewFields: TButton;
    procedure CreateNewFieldsClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    { Private declarations }
    Engine : DBEngine;
    DB     : Database;
  public
    { Public declarations }
    Function ReturnDatabasePath(DatabaseName : String) : String;
  end;

var
  Form1: TForm1;

  implementation

{$R *.DFM}

Function TForm1.ReturnDatabasePath(DatabaseName : String) : String;
Var
 fregistry : TRegistry;
begin
   {$ifdef CALLCENTRAL_DEBUG}
   SendDebug('Start Of ReturnDataBase Path');
   {$endif}

 fregistry := TRegistry.Create;
 try
   fregistry.RootKey := HKEY_LOCAL_MACHINE;
   fRegistry.OpenKey('Software\Titan\Access\Aliases\'+DatabaseName, FALSE);
   Result := fRegistry.ReadString('PhysicalName');
   {$ifdef CALLCENTRAL_DEBUG}
   SendDebug('DataBase Path = '+Result);
   {$endif}
 finally
   fregistry.Free;
 end;
end;

procedure TForm1.FormCreate(Sender: TObject);
const
  DAOLIC = 'mbmabptebkjcdlgtjmskjwtsdhjbmkmwtrak';
var
  pUnk: IUnknown;
  pClass2: IClassFactory2;
  licString2: Widestring;
begin
  pClass2 := nil;
  CoInitialize(NIL);
  OleCheck (CoGetClassObject (CLASS_DBEngine,
    CLSCTX_INPROC_SERVER or CLSCTX_LOCAL_SERVER, nil, IClassFactory2,
    pClass2));
  if Assigned(pClass2) then begin
    Licstring2 := DAOLIC;
    OleCheck(pClass2.CreateInstanceLic (nil, nil, DBEngine, LicString2, Engine));
  end;
end;

procedure TForm1.CreateNewFieldsClick(Sender: TObject);
Const
  dbBoolean                     =  1; // Yes/No
Var
  FieldDef,
  TableDef : Variant;
  TableName : String;
  size     : Integer;
begin
   {$ifdef CALLCENTRAL_DEBUG}
   SendDebug('Before OpenDatabase');
   {$endif}
   DB := Engine.OpenDatabase(ReturnDatabasePath(CallCentralDatabaseName), 0, False, 
';PWD='+ReturnDatabasePassword); //Database Open
   if (DB <> NIL) then
       begin
          {$ifdef CALLCENTRAL_DEBUG}
           SendDebug('After OpenDatabase - DB <> NIL');
          {$endif}

          TableName := 'Adrock_Report';
         {$ifdef CALLCENTRAL_DEBUG}
         SendDebug('tableName = '+TableName);
         {$endif}

         {$ifdef CALLCENTRAL_DEBUG}
         SendDebug('Before  TableDef  := DB.TableDefs[tableName];');
         {$endif}
          TableDef  := DB.TableDefs[tableName];
         {$ifdef CALLCENTRAL_DEBUG}
         SendDebug('After TableDef  := DB.TableDefs[tableName];');
         {$endif}
         size := 0;
         {$ifdef CALLCENTRAL_DEBUG}
         SendDebug('before FieldDef := TableDef.CreateField(''IncludeIncomingCalls'', 
dbBoolean, size);');
         {$endif}
              FieldDef := TableDef.CreateField('IncludeIncomingCalls', dbBoolean, 
size);
         {$ifdef CALLCENTRAL_DEBUG}
         SendDebug('after FieldDef := TableDef.CreateField(''IncludeIncomingCalls'', 
dbBoolean, size);');
         {$endif}
              try
         {$ifdef CALLCENTRAL_DEBUG}
         SendDebug('Before TableDef.Fields.Append( FieldDef );');
         {$endif}
                TableDef.Fields.Append( FieldDef );
         {$ifdef CALLCENTRAL_DEBUG}
         SendDebug('After TableDef.Fields.Append( FieldDef );');
         {$endif}
         {$ifdef CALLCENTRAL_DEBUG}
         SendDebug('Before HALT(1)');
         {$endif}
                DB.Close;
                Halt(1);
         {$ifdef CALLCENTRAL_DEBUG}
         SendDebug('After HALT(1)');
         {$endif}
              except
                 // Do Nothing
         {$ifdef CALLCENTRAL_DEBUG}
         SendDebug('Exception Raised- Before HALT(0)');
         {$endif}
                DB.Close;
                 Halt(0);
         {$ifdef CALLCENTRAL_DEBUG}
         SendDebug('Exception Raised- After HALT(0)');
         {$endif}
              end;
         end
      else
       begin
         {$ifdef CALLCENTRAL_DEBUG}
         SendDebug('After OpenDatabase - DB = NIL');
         {$endif}
       end;
end;


procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CounInitialize;

end;

end.

Christopher Crowe (Software Developer)
Microsoft MVP, MCP

Adrock Software
Byte Computer & Software LTD
P.O Box 13-155 
Christchurch
New Zealand
Phone/Fax (NZ) 03-3651-112

---------------------------------------------------------------------------
    New Zealand Delphi Users group - Delphi List - [EMAIL PROTECTED]
                  Website: http://www.delphi.org.nz