hbinit.pas

Midas.dll全部源码

{*******************************************************}
{                                                       }
{         Vladimir Gaitanoff HyperBase                  }
{                                                       }
{         No-DLL MIDAS support                          }
{                                                       }
{         Copyright (c) 1997,99 Vladimir Gaitanoff      }
{                                                       }
{*******************************************************}

{$D-,L-}

unit hbInit;

interface

{$D-,L-}

procedure Initialize;

implementation
uses Windows, ActiveX, ComObj, ComServ, DSIntf, hbCLSID, hbCOMSrv;

// Linking Midas.tlb type library will cause its automatic registration
// If project has another type library you should register Midas type library manualy
{$IFNDEF APPSERVER}
{$R Midas.tlb}
{$ENDIF}

var
  Initialized: Boolean = False;

procedure CreateDbClientObject(const CLSID, IID: TGUID; out Obj);
var
  Factory: TComObjectFactory;
  FactoryIntf: IClassFactory;
  NewCLSID: TGUID;
begin
  if IsEqualCLSID(CLSID, CLSID_DBDSBase1) or
     IsEqualCLSID(CLSID, CLSID_DBDSBase2) or
     IsEqualCLSID(CLSID, CLSID_DBDSBase5) then
       NewCLSID := CLSID_HBDSBase
  else if
     IsEqualCLSID(CLSID, CLSID_DBDSCursor1) or
     IsEqualCLSID(CLSID, CLSID_DBDSCursor2) or
     IsEqualCLSID(CLSID, CLSID_DBDSCursor5) then
       NewCLSID := CLSID_HBDSCursor
  else if
     IsEqualCLSID(CLSID, CLSID_DBDSWriter) or
     IsEqualCLSID(CLSID, CLSID_DBDSWriter5) then
       NewCLSID := CLSID_HBDSWriter;

  Factory := ComClassManager.GetFactoryFromClassID(NewCLSID);
  if not Assigned(Factory) then
    OleCheck(REGDB_E_CLASSNOTREG);
  FactoryIntf := Factory as IClassFactory;
  OleCheck(FactoryIntf.CreateInstance(nil, IID, Obj));
end;

type
  PCodeBlock = ^TCodeBlock;
  TCodeBlock = packed record
    Code: Byte;
    Offs: Integer;
  end;

function CalcJmpOffset(Src, Dest: Pointer): Longint;
begin
  Result := Longint(Dest) - (Longint(Src) + 5);
end;

procedure Initialize;

const
  PageSize = 1024;

var
  CodeBlock: PCodeBlock;
  SaveFlag: DWORD;
begin
  if Initialized then Exit;

  CodeBlock := @DSIntf.CreateDbClientObject;
  if VirtualProtect(CodeBlock, PageSize, PAGE_READWRITE, @SaveFlag) then
  try
    CodeBlock.Code := $E9;
    CodeBlock.Offs := CalcJmpOffset(CodeBlock, @CreateDbClientObject);
  finally
    VirtualProtect(CodeBlock, PageSize, SaveFlag, @SaveFlag);
  end;

  NoUpdateRegistry := True;
  RegisterHBClient;

  Initialized := True;
end;

initialization

finalization
  if Initialized then
    ComServer := nil;

end.