Hostlib.resource
Jump to navigation
Jump to search
The printable version is no longer supported and may have rendering errors. Please update your browser bookmarks and please use the default browser print function instead.
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]