unit dllutl;
{ DLL import unit for all DLLs, controls loaded dlls, frees them }
{$I DEFINE.PAS}

interface
uses
  Windows, SysUtils;

const
  erDLLLoadFailed = 1000;
  erDLLAssignProcFailed = 1002;
  erEmptyDLLName = 1003;

  DLLReportErrors:boolean = true;
type
  TDLLMethod = function(AInfo:pointer):longint;
  {type for methods to be used with DLLCall procedure or DLLCallSave }

function DLLLoad(DLLName: shortstring; Required: boolean; var Handle:THandle): boolean;
  { Loads DLLName.DLL, if LoadLibary failes then if Required=true RunTime error
    is generated }

function DLLAssignProc(var Proc:pointer; Handle:THandle; AProcName:shortstring;
  Required:boolean):boolean;
  { Assignes procedure of name AProcName from DLL of Handle, to the pointer Proc.
    If failed for any reason and Required=true, RunTime error will be generated }

function DLLFree(var Handle:THandle):boolean;
  { function Loaded:boolean;{true if all calls since last LoadDLL succeded }

{load, call, unload (only for methods with max size of parameters: sizeof(pointer))}
function DLLCallSave(ADLLName:shortstring; AProcName:shortstring; AParam:pointer; var AResult:pointer):boolean;
{retuns true if everything was ok, if not ok call DLLGetError and
  DLLGetErrorMsg to find out what happened}

function DLLCall(ADLLName:shortstring; AProcName:shortstring; AParam:pointer):Pointer;
{... as above, without returning info about successful load and call; call
  DLLGetError to find out if last DLLxxx call succeded}

function DLLGetError:integer;
function DLLGetErrorMsg(AError:integer):shortstring;

procedure NotAssigned;

implementation

procedure NotAssigned;
begin
  if DLLReportErrors then
    writeln('DLL procedure not assigned.');
end;

{*******************************************************}
const
{  IsOK:boolean= true;{all proc calls since last LoadDLL were ok}
{  LastHandle:THandle = 0;{last return param of loaddll}

  LastCallError:integer = 0;
    {set by DLLCallSave or DLLLoad, ONLY if error encountered;
     or by any call to DLLCall (to 0 if no error)}

function DLLAssignProc(var Proc:pointer; Handle: THandle; AProcName:shortstring; Required:boolean):boolean;
var
  p:Pointer;
  n:array[0..255]of char;
begin
  DLLAssignProc := false;
  if (AProcName = '') or (Handle < 32) then
    p := nil
  else
    p := GetProcAddress(Handle, StrPCopy(n, AProcName));
  if (p <> nil) then begin
    Proc := p;
    LastCallError := 0;
    DLLAssignProc := true;
  end else begin
    LastCallError := erDLLAssignProcFailed;
    Proc := @NotAssigned;
    if Required then begin
      RunError(218);
    end;
  end;
end;

function DLLLoad(DLLName:shortstring; Required:boolean; var Handle:THandle):boolean;
var
  n:array[0..255]of char;
{  s:shortstring;
  name:shortstring;
  ext:shortstring;
  i:integer;}

label ex;
begin
  {IsOK := false;}
  Handle := 0;{NoDLLHandle;}
  DLLLoad := false;
  if DLLName = '' then begin
    LastCallError := erEmptyDLLName;
    goto ex;
  end;
  {FileSplit(DLLName, s, name, ext);
  if ext = '' then
    ext := '.DLL';}
  DLLName := ChangeFileExt(DLLName, '.DLL');
  {DLLName := s + name + ext;{ReplaceFileNamePart(fpExt, DLLName, '.DLL', false);}
  Handle := LoadLibrary(StrPCopy(n,DLLName));
  if Handle <> 0 then begin
    LastCallError := 0;
    DLLLoad := true;
  end else begin
    {
    0     ³ System was out of memory, executable file was corrupt, or
          ³ relocations were invalid.
    2     ³ File was not found.
    3     ³ Path was not found.
    5     ³ Attempt was made to dynamically link to a task, or there was a
          ³ sharing or network-protection error.
    6     ³ Library required separate data segments for each task.
    8     ³ There was insufficient memory to start the application.
    10    ³ Windows version was incorrect.
    11    ³ Executable file was invalid. Either it was not a Windows
          ³ application or there was an error in the .EXE image.
    12    ³ Application was designed for a different operating system.
    13    ³ Application was designed for MS-DOS 4.0.
    14    ³ Type of executable file was unknown.
    15    ³ Attempt was made to load a real-mode application (developed for an
          ³ earlier version of Windows).
    16    ³ Attempt was made to load a second instance of an executable file
          ³ containing multiple data segments that were not marked read-only.
    19    ³ Attempt was made to load a compressed executable file. The file
          ³ must be decompressed before it can be loaded.
    20    ³ Dynamic-link library (DLL) file was invalid. One of the DLLs
          ³ required to run this application was corrupt.
    21    ³ Application requires 32-bit extensions.
    }
    LastCallError := GetLastError{Handle};
    Handle := 0{NoDLLHandle};
  end;
ex:
  if (Handle = 0) and Required then begin
    RunError(217);
  end;
end;
{
function Loaded:boolean;
begin
  Loaded := IsOK;
end;
}
function DLLFree(var Handle:THandle):boolean;

{$IFDEF BIOSDATAINFO}
var
  n:array[0..255]of char;
  i:integer;
  s:shortstring;
  name:namestr;
  e:extstr;
{$ENDIF}

begin
  if Handle <> 0{NoDLLHandle} then begin
    {$IFDEF BIOSDATAINFO}
      {BiosDataInfo := PBiosDataInfo(MemL[Seg0040:BiosDataInfoOffset]);}
      {v2.18}
      if BiosDataInfo <> nil then
      {/v2.18}
      begin
        FillChar(n, sizeof(n), 0);
        GetModuleFileName(Handle, n, sizeof(n));
        BiosDataInfo^.UnloadedDLLName := StrPas(n);
        BiosDataInfo^.CheckDLL(BiosDataInfo^.UnloadedDLLName, Handle, false, ModuleInfo);
        BiosDataInfo^.LastDLLName := '';
      end {2.18}
      else begin
        FreeLibrary(Handle);
      end;
      {/v2.18};
    {$ELSE}
      FreeLibrary(Handle);{getmoduleusage}
    {$ENDIF}
    Handle := 0{NoDLLHandle};
  end;
  DLLFree := true;
end;

function DLLCallSave(ADLLName:shortstring; AProcName:shortstring; AParam:pointer; var AResult:pointer):boolean;
{retuns true if everything was ok, if not ok call DLLGetError and
  DLLGetErrorMsg to find out what happened}
type
  TProc = function(AParam:pointer):pointer;
var
  h:THandle;
  Proc:TProc;
begin
  DLLCallSave := false;
  if DLLLoad(ADLLName, false, h) then begin {configI}
    if not DLLAssignProc(@Proc, h, AProcName, false) then begin
      {v2.18}
      DLLFree(h);
      {/v2.18}
      exit;
    end;
    AResult := Proc(AParam);
  end else begin
    {LastCallError := erDLLLoadFailed;}
    exit;
  end;
  DLLCallSave := true;
  DLLFree(h);
end;

function DLLCall(ADLLName:shortstring; AProcName:shortstring; AParam:pointer):Pointer;
var AResult:pointer;
begin
{  LastCallError := 0;}
  DLLCall := nil;
  if DLLCallSave(ADLLName, AProcName, AParam, AResult) then
    DLLCall := AResult;
end;

function DLLGetError:integer;
begin
  DLLGetError := LastCallError;
end;

function DLLGetErrorMsg(AError:integer):shortstring;
var s: shortstring;
begin
  s := '';
  case AError of
    erDLLLoadFailed : s := 'DLL Load failed.';
    erDLLAssignProcFailed : s := 'DLL Proc Load Failed.';
    {
    0     ³ System was out of memory, executable file was corrupt, or
          ³ relocations were invalid.
    2     ³ File was not found.
    3     ³ Path was not found.
    5     ³ Attempt was made to dynamically link to a task, or there was a
          ³ sharing or network-protection error.
    6     ³ Library required separate data segments for each task.
    8     ³ There was insufficient memory to start the application.
    10    ³ Windows version was incorrect.
    11    ³ Executable file was invalid. Either it was not a Windows
          ³ application or there was an error in the .EXE image.
    12    ³ Application was designed for a different operating system.
    13    ³ Application was designed for MS-DOS 4.0.
    14    ³ Type of executable file was unknown.
    15    ³ Attempt was made to load a real-mode application (developed for an
          ³ earlier version of Windows).
    16    ³ Attempt was made to load a second instance of an executable file
          ³ containing multiple data segments that were not marked read-only.
    19    ³ Attempt was made to load a compressed executable file. The file
          ³ must be decompressed before it can be loaded.
    20    ³ Dynamic-link library (DLL) file was invalid. One of the DLLs
          ³ required to run this application was corrupt.
    21    ³ Application requires 32-bit extensions.
    }
  end;
  if s = '' then begin
    str(AError, s);
    s := 'DLL Error ' + s;
  end;
  DLLGetErrorMsg := s;
end;

var OldExitProc:pointer;

{$S-}
procedure Ex;far;
begin
  ExitProc := OldExitProc;
end;


begin
  OldExitProc := ExitProc;
  ExitProc := @Ex;
end.
