Difference between revisions of "Hostlib.resource"
Jump to navigation
Jump to search
(→the unit: Added unit) |
(→Example: 1: added example for Windows) |
||
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> | ||
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]