paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-14 19:39:31 +02:00
Code Issues Packages Projects Releases Wiki Activity

* GetLoadErrorStr implemented

Browse Source 
git-svn-id: trunk@21907 -
This commit is contained in:
Tomas Hajny 2012-07-12 23:30:19 +00:00
parent 7717e43929
commit 4dccf2d321
1 changed files with 83 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

93
rtl/os2/dynlibs.inc
View File

@ -37,32 +37,105 @@ const
uses
DosCalls;
threadvar
DynLibErrNo: cardinal;
DynLibErrPath: array [0..259] of char;
function LoadLibrary (const Name: AnsiString): TLibHandle;
var
ErrPath: array [0..259] of char;
Handle: longint;
begin
if DosLoadModule (@ErrPath, SizeOf (ErrPath), PChar (Name), Handle) = 0
then Result := Handle else Result := NilHandle;
DynLibErrPath [0] := #0;
DynLibErrNo := DosLoadModule (@DynLibErrPath [0], SizeOf (DynLibErrPath),
PChar (Name), Handle);
if DynLibErrNo = 0 then
Result := Handle
else
Result := NilHandle;
end;
function GetProcedureAddress (Lib: TLibHandle; const ProcName: AnsiString): pointer;
var
P: pointer;
begin
if DosQueryProcAddr (Lib, 0, PChar (ProcName), P) = 0 then Result := P
else Result := nil;
DynLibErrPath [0] := #0;
DynLibErrNo := DosQueryProcAddr (Lib, 0, PChar (ProcName), P);
if DynLibErrNo = 0 then
Result := P
else
Result := nil;
end;
function UnloadLibrary (Lib: TLibHandle): boolean;
begin
Result := DosFreeModule (Lib) = 0;
DynLibErrPath [0] := #0;
DynLibErrNo := DosFreeModule (Lib);
Result := DynLibErrNo = 0;
end;
Function GetLoadErrorStr: string;
function GetDynLibsErrorStr: string;
const
SysMsgFile: array [0..10] of char = 'OSO001.MSG'#0;
var
VarArr: array [1..9] of PChar;
OutBuf: array [0..999] of char;
RetMsgSize: cardinal;
RC: cardinal;
begin
Result:='';
if DynLibErrNo = 0 then
GetDynLibsErrorStr := ''
else
begin
VarArr [1] := @DynLibErrPath [0];
RC := DosGetMessage (@VarArr, 1, @OutBuf [0], SizeOf (OutBuf),
DynLibErrNo, @SysMsgFile [0], RetMsgSize);
if RC = 0 then
Result := StrPas (@OutBuf [0])
else
begin
WriteStr (Result, DynLibErrNo);
Result := 'Error ' + Result;
end;
if DynLibErrPath [0] <> #0 then
Result := StrPas (@DynLibErrPath [0]) + ' - ' + Result;
end;
end;
function GetDynLibsError: longint;
begin
GetDynLibsError := DynLibErrNo;
end;
function GetDynLibsErrorStr: string;
const
SysMsgFile: array [0..10] of char = 'OSO001.MSG'#0;
var
VarArr: array [1..9] of PChar;
OutBuf: array [0..999] of char;
RetMsgSize: cardinal;
RC: cardinal;
begin
if DynLibErrNo = 0 then
GetDynLibsErrorStr := ''
else
begin
VarArr [1] := @DynLibErrPath [0];
RC := DosGetMessage (@VarArr, 1, @OutBuf [0], SizeOf (OutBuf),
DynLibErrNo, @SysMsgFile [0], RetMsgSize);
if RC = 0 then
Result := StrPas (@OutBuf [0])
else
begin
WriteStr (Result, DynLibErrNo);
Result := 'Error ' + Result;
end;
if DynLibErrPath [0] <> #0 then
Result := StrPas (@DynLibErrPath [0]) + ' - ' + Result;
end;
end;
function GetLoadErrorStr: string;
begin
GetLoadErrorStr := GetDynLibsErrorStr;
end;
{$endif}