Hostlib.resource

hostlib.resource

[insert background information here]

examples

Example: 1

program Test_HostLib_1;

{$MODE OBJFPC}{$H+}

Uses
  exec, aros_hostlib, sysutils;


const
  Symbols : array[0..2] of pchar =
  (
    'GetEnvironmentStringsA',
    'FreeEnvironmentStringsA',
    nil
  );


Type
  PKernel32Interface = ^TKernel32Interface;
  TKernel32Interface = record
    GetEnvironmentStringsA   : Function(): pchar; stdcall;
    FreeEnvironmentStringsA  : Function(lpszEnvironmentBlock: pchar): longBool; stdcall;
  end;


Var
  kernel32base  : pointer;
  kernel32iface : PKernel32Interface;
  n             : LongWord;


procedure GetHostEnvStrings;
var
  EnvStrings: pchar;
  i : integer;
begin
  Forbid;
  EnvStrings := kernel32iface^.GetEnvironmentStringsA();
  Permit;

  i := 0;

  If (EnvStrings <> nil) then
  while (EnvStrings^ <> #0) do
  begin
    writeln('EnvStrings[', i, ']  ->  ', StrPas(EnvStrings));
    Inc(EnvStrings, StrLen(EnvStrings) + 1);
    inc(i);
  end;

  forbid;
  kernel32iface^.FreeEnvironmentStringsA(EnvStrings);
  permit;
end;




procedure do1;
begin
  If (hostlibbase = nil) then
  begin
    writeln('unable to open hostlib.resource');
    exit;
  end
  else
    writeln('hostlibbase = ', intToHex(longword(hostlibbase),8));


  kernel32Base := HostLib_Open('kernel32.dll', nil);
  if (kernel32Base <> nil) then
  begin
    writeln('kernel32.dll opened succesfully');

    n := 0;
    kernel32iface := PKernel32Interface(HostLib_GetInterface(Kernel32base, Symbols, @n));

    if (Kernel32iface <> nil) then
    begin
      writeln('interface to kernel openen succesfully');
      writeln('n = ', n);

      if (n = 0) then
      begin
        writeln('n was ok');

        // checking functions
        write('function kernel32.dll->GetEnvironmentStrings is ');
        if (pointer(kernel32iface^.GetEnvironmentStringsA) <> nil)
        then writeln('valid')
        else writeln('invalid');

        write('function kernel32.dll->FreeEnvironmentString is ');
        if (pointer(kernel32iface^.FreeEnvironmentStringsA) <> nil)
        then writeln('valid')
        else writeln('invalid');

        // checking out something ;-p
        GetHostEnvStrings;
      end
      else writeln('unresolved functions found');

      HostLib_DropInterface(paptr(Kernel32IFace));
    end
    else writeln('failed to retrieve interface to kernel32');

    HostLib_Close(Kernel32Base, nil);
  end
  else writeln('opening of kernel32.dll failed');
end;


begin
  writeln('enter');
  do1;
  writeln('leave');
end.

the unit

unit aros_hostlib;

{
  Hostlib.resource
}

interface

uses
  exec;
  
Const
  HOSTLIBNAME       = 'hostlib.resource';


type
  pvoid             = pointer;  


  function  HostLib_Open(const filename: pchar; error: ppchar): pvoid;
  function  HostLib_Close(handle: pvoid; error: ppchar): integer;
  function  HostLib_GetPointer(handle: pvoid; const symbol: pchar; error: ppchar): pvoid;
  procedure HostLib_FreeErrorStr(error: ppchar);
  function  HostLib_GetInterface(handle: pvoid; const symbols: ppchar; unresolved: PULONG): pAPTR;
  procedure HostLib_DropInterface(interface_: pAPTR);
  procedure HostLib_Lock;
  procedure HostLib_Unlock;
  
var
  HostLibBase : pLibrary;


implementation


function HostLib_Open(const filename: pchar; error: ppchar): pvoid;
type
  TLocalCall = function(const filename: pchar; error: ppchar; LibBase: Pointer): pvoid; cdecl;
var
  Call: TLocalCall;
begin
  Call := TLocalCall(GetLibAdress(HostLibBase, 1));
  HostLib_Open := Call(filename, error, HostLibBase);
end;


function  HostLib_Close(handle: pvoid; error: ppchar): integer;
type
  TLocalCall = function(handle: pvoid; error: ppchar; LibBase: Pointer): integer; cdecl;
var
  Call: TLocalCall;
begin
  Call := TLocalCall(GetLibAdress(HostLibBase, 2));
  HostLib_Close := Call(handle, error, HostLibBase);
end;


function  HostLib_GetPointer(handle: pvoid; const symbol: pchar; error: ppchar): pvoid;
type
  TLocalCall = function(handle: pvoid; const symbol: pchar; error: ppchar; LibBase: Pointer): pvoid; cdecl;
var
  Call: TLocalCall;
begin
  Call := TLocalCall(GetLibAdress(HostLibBase, 3));
  HostLib_GetPointer := Call(handle, symbol, error, HostLibBase);
end;


procedure HostLib_FreeErrorStr(error: ppchar);
type
  TLocalCall = procedure(error: ppchar; LibBase: Pointer); cdecl;
var
  Call: TLocalCall;
begin
  Call := TLocalCall(GetLibAdress(HostLibBase, 4));
  Call(error, HostLibBase);
end;


function  HostLib_GetInterface(handle: pvoid; const symbols: ppchar; unresolved: PULONG): pAPTR;
type
  TLocalCall = function(handle: pvoid; const symbols: ppchar; unresolved: pulong; LibBase: Pointer): pAPTR; cdecl;
var
  Call: TLocalCall;
begin
  Call := TLocalCall(GetLibAdress(HostLibBase, 5));
  HostLib_GetInterface := Call(handle, symbols, unresolved, HostLibBase);
end;


procedure HostLib_DropInterface(interface_: pAPTR);
type
  TLocalCall = procedure(interface_: pAPTR; LibBase: Pointer); cdecl;
var
  Call: TLocalCall;
begin
  Call := TLocalCall(GetLibAdress(HostLibBase, 6));
  Call(interface_, HostLibBase);
end;


procedure HostLib_Lock;
type
  TLocalCall = procedure(LibBase: Pointer); cdecl;
var
  Call: TLocalCall;
begin
  Call := TLocalCall(GetLibAdress(HostLibBase, 7));
  Call(HostLibBase);
end;


procedure HostLib_Unlock;
type
  TLocalCall = procedure(LibBase: Pointer); cdecl;
var
  Call: TLocalCall;
begin
  Call := TLocalCall(GetLibAdress(HostLibBase, 8));
  Call(HostLibBase);
end;

Initialization
  HostLibBase := OpenResource(HOSTLIBNAME);

finalization
  // resources do not need to be closed
end.

unit documentation

[insert unit documentation here]