Difference between revisions of "Hostlib.resource"

From Freepascal Amiga wiki
Jump to navigation Jump to search
(cradle)
 
(→‎Example: 1: added example for Windows)
 
(2 intermediate revisions by the same user not shown)
Line 7: Line 7:
  
 
<source lang="pascal">
 
<source lang="pascal">
 +
 +
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.
 +
 
</source>
 
</source>
  
Line 22: Line 141:
  
 
<source lang="pascal">
 
<source lang="pascal">
 +
 +
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.
 +
</source>
 +
  
 
=== unit documentation ===
 
=== unit documentation ===
−
</source>
 
  
 
[insert unit documentation here]
 
[insert unit documentation here]

Latest revision as of 23:49, 20 September 2014

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.

Example: 2

Example: 3

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]

Retrieved from "http://fpcamigawiki.alb42.de/index.php?title=Hostlib.resource&oldid=249"