1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
|
{
This file is part of the Free Pascal run time library.
Copyright (c) 1999-2000 by the Free Pascal development team
Implements OS dependent part for loading of dynamic libraries.
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
threadvar
DynLibErrNo: cardinal;
DynLibErrPath: array [0..259] of char;
function SysLoadLibraryA (const Name: RawbyteString): TLibHandle;
var
Handle: longint;
begin
DynLibErrPath [0] := #0;
DynLibErrNo := DosLoadModule (@DynLibErrPath [0], SizeOf (DynLibErrPath),
PAnsiChar (Name), Handle);
if DynLibErrNo = 0 then
Result := Handle
else
begin
Result := NilHandle;
OSErrorWatch (DynLibErrNo);
end;
end;
function SysLoadLibraryU (const Name: UnicodeString): TLibHandle;
begin
Result := SysLoadLibraryA(ToSingleByteFileSystemEncodedFileName(Name));
end;
function SysGetProcedureAddress (Lib: TLibHandle; const ProcName: AnsiString): pointer;
var
P: pointer;
begin
DynLibErrPath [0] := #0;
DynLibErrNo := DosQueryProcAddr (Lib, 0, PChar (ProcName), P);
if DynLibErrNo = 0 then
Result := P
else
begin
Result := nil;
OSErrorWatch (DynLibErrNo);
end;
end;
function SysGetProcedureAddressOrdinal (Lib: TLibHandle; Ordinal: TOrdinalEntry): pointer;
var
P: pointer;
begin
DynLibErrPath [0] := #0;
DynLibErrNo := DosQueryProcAddr (Lib, Ordinal, nil, P);
if DynLibErrNo = 0 then
Result := P
else
begin
Result := nil;
OSErrorWatch (DynLibErrNo);
end;
end;
function SysUnloadLibrary (Lib: TLibHandle): boolean;
begin
DynLibErrPath [0] := #0;
DynLibErrNo := DosFreeModule (Lib);
Result := DynLibErrNo = 0;
if DynLibErrNo <> 0 then
OSErrorWatch (DynLibErrNo);
end;
function GetDynLibsError: longint;
begin
GetDynLibsError := DynLibErrNo;
end;
function GetDynLibsErrPath: PChar;
begin
GetDynLibsErrPath := @DynLibErrPath [0];
end;
function SysGetDynLibsErrorStr: 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;
I: cardinal;
AErr: ansistring;
begin
if DynLibErrNo = 0 then
SysGetDynLibsErrorStr := ''
else
begin
Result := '';
VarArr [1] := @DynLibErrPath [0];
RC := DosGetMessage (@VarArr, 1, @OutBuf [0], SizeOf (OutBuf),
DynLibErrNo, @SysMsgFile [0], RetMsgSize);
if RC = 0 then
begin
SetLength (Result, RetMsgSize);
Move (OutBuf [0], Result [1], RetMsgSize);
AErr := ansistring (PChar (@DynlibErrPath [0]));
if (AErr <> '') and (Pos (AErr, Result) = 0) then
begin
if Result [Length (Result)] in [#13, #10, ' '] then
Result := Result + '(' + AErr + ')'
else
Result := Result + ' (' + AErr + ')';
end
end
else
begin
Str (DynLibErrNo, Result);
Result := 'Error ' + Result;
if DynLibErrPath [0] <> #0 then
Result := StrPas (@DynLibErrPath [0]) + ' - ' + Result;
OSErrorWatch (RC);
end;
end;
end;
function SysGetLoadErrorStr: string;
begin
SysGetLoadErrorStr := SysGetDynLibsErrorStr;
end;
const
SysDynLibsManager: TDynLibsManager = (
LoadLibraryU: @SysLoadLibraryU;
LoadLibraryA: @SysLoadLibraryA;
GetProcAddress: @SysGetProcedureAddress;
GetProcAddressOrdinal: @SysGetProcedureAddressOrdinal;
UnloadLibrary: @SysUnloadLibrary;
GetLoadErrorStr: @SysGetLoadErrorStr;
);
procedure InitSystemDynLibs;
begin
SetDynLibsManager(SysDynLibsManager);
end;
|
