LZScene

1
//
2
// This unit is part of the GLScene Engine https://github.com/glscene
3
//
4
{
5
    History: 
6
       17/03/07 - DaStr - Dropped Kylix support in favor of FPC
7
                                                         (BugTracekrID=1681585)
8
}
9
unit GLSModuleLoader;
10
{******************************************************************}
11
{                                                                  }
12
{       Project JEDI                                               }
13
{       OS independent Dynamic Loading Helpers                     }
14
{                                                                  }
15
{ The initial developer of the this code is                        }
16
{ Robert Marquardt <robert_marquardt@gmx.de)                       }
17
{                                                                  }
18
{ Copyright (C) 2000, 2001 Robert Marquardt.                       }
19
{                                                                  }
20
{ Obtained through:                                                }
21
{ Joint Endeavour of Delphi Innovators (Project JEDI)              }
22
{                                                                  }
23
{ You may retrieve the latest version of this file at the Project  }
24
{ JEDI home page, located at http://delphi-jedi.org                }
25
{                                                                  }
26
{ The contents of this file are used with permission, subject to   }
27
{ the Mozilla Public License Version 1.1 (the "License"); you may  }
28
{ not use this file except in compliance with the License. You may }
29
{ obtain a copy of the License at                                  }
30
{ http://www.mozilla.org/NPL/NPL-1_1Final.html                     }
31
{                                                                  }
32
{ Software distributed under the License is distributed on an      }
33
{ "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or   }
34
{ implied. See the License for the specific language governing     }
35
{ rights and limitations under the License.                        }
36
{                                                                  }
37
{******************************************************************}
38

39
interface
40

41
{$I pascaldefines.inc}
42
{$WEAKPACKAGEUNIT ON}
43

44
// each OS gets its own IFDEFed complete code block to make reading easier
45

46
{$IFDEF MSWINDOWS}
47
uses
48
  Windows;
49

50
type
51
  // Handle to a loaded DLL
52
  TModuleHandle = HINST;
53

54
const
55
  // Value designating an unassigned TModuleHandle od a failed loading
56
  INVALID_MODULEHANDLE_VALUE = TModuleHandle(0);
57

58
function LoadModule(var Module: TModuleHandle; FileName: PChar): Boolean; stdcall;
59
function LoadModuleEx(var Module: TModuleHandle; FileName: PChar; Flags: Cardinal): Boolean; stdcall;
60
procedure UnloadModule(var Module: TModuleHandle); stdcall;
61
function GetModuleSymbol(Module: TModuleHandle; SymbolName: PChar): Pointer; stdcall;
62
function GetModuleSymbolEx(Module: TModuleHandle; SymbolName: PChar; var Accu: Boolean): Pointer; stdcall;
63
function ReadModuleData(Module: TModuleHandle; SymbolName: PChar; var Buffer; Size: Cardinal): Boolean; stdcall;
64
function WriteModuleData(Module: TModuleHandle; SymbolName: PChar; var Buffer; Size: Cardinal): Boolean; stdcall;
65

66
//--------------------------------------------------------------------
67
implementation
68
//--------------------------------------------------------------------
69

70
(* load the DLL file FileName
71
   the rules for FileName are those of LoadLibrary
72
   Returns: True = success, False = failure to load
73
   Assigns: the handle of the loaded DLL to Module
74
   Warning: if Module has any other value than INVALID_MODULEHANDLE_VALUE
75
   on entry the function will do nothing but returning success. *)
76
function LoadModule(var Module: TModuleHandle; FileName: PChar): Boolean;
77
begin
78
  if Module = INVALID_MODULEHANDLE_VALUE then
79
    Module := LoadLibrary( FileName );
80
  Result := Module <> INVALID_MODULEHANDLE_VALUE;
81
end;
82

83
// load the DLL file FileName
84
// LoadLibraryEx is used to get better control of the loading
85
// for the allowed values for flags see LoadLibraryEx documentation.
86

87
function LoadModuleEx(var Module: TModuleHandle; FileName: PChar; Flags: Cardinal): Boolean;
88
begin
89
  if Module = INVALID_MODULEHANDLE_VALUE then
90
    Module := LoadLibraryEx( FileName, 0, Flags);
91
  Result := Module <> INVALID_MODULEHANDLE_VALUE;
92
end;
93

94
// unload a DLL loaded with LoadModule or LoadModuleEx
95
// The procedure will not try to unload a handle with
96
// value INVALID_MODULEHANDLE_VALUE and assigns this value
97
// to Module after unload.
98

99
procedure UnloadModule(var Module: TModuleHandle);
100
begin
101
  if Module <> INVALID_MODULEHANDLE_VALUE then
102
    FreeLibrary(Module);
103
  Module := INVALID_MODULEHANDLE_VALUE;
104
end;
105

106
// returns the pointer to the symbol named SymbolName
107
// if it is exported from the DLL Module
108
// nil is returned if the symbol is not available
109

110
function GetModuleSymbol(Module: TModuleHandle; SymbolName: PChar): Pointer;
111
begin
112
  Result := nil;
113
  if Module <> INVALID_MODULEHANDLE_VALUE then
114
    Result := GetProcAddress(Module, SymbolName );
115
end;
116

117
// returns the pointer to the symbol named SymbolName
118
// if it is exported from the DLL Module
119
// nil is returned if the symbol is not available.
120
// as an extra the boolean variable Accu is updated
121
// by anding in the success of the function.
122
// This is very handy for rendering a global result
123
// when accessing a long list of symbols.
124

125
function GetModuleSymbolEx(Module: TModuleHandle; SymbolName: PChar; var Accu: Boolean): Pointer;
126
begin
127
  Result := nil;
128
  if Module <> INVALID_MODULEHANDLE_VALUE then
129
    Result := GetProcAddress(Module, SymbolName );
130
  Accu := Accu and (Result <> nil);
131
end;
132

133
// get the value of variables exported from a DLL Module
134
// Delphi cannot access variables in a DLL directly, so
135
// this function allows to copy the data from the DLL.
136
// Beware! You are accessing the DLL memory image directly.
137
// Be sure to access a variable not a function and be sure
138
// to read the correct amount of data.
139

140
function ReadModuleData(Module: TModuleHandle; SymbolName: PChar; var Buffer; Size: Cardinal): Boolean;
141
var
142
  Sym: Pointer;
143
begin
144
  Result := True;
145
  Sym := GetModuleSymbolEx(Module, SymbolName, Result);
146
  if Result then
147
    Move(Sym^, Buffer, Size);
148
end;
149

150
// set the value of variables exported from a DLL Module
151
// Delphi cannot access variables in a DLL directly, so
152
// this function allows to copy the data to the DLL!
153
// BEWARE! You are accessing the DLL memory image directly.
154
// Be sure to access a variable not a function and be sure
155
// to write the correct amount of data.
156
// The changes are not persistent. They get lost when the
157
// DLL is unloaded.
158

159
function WriteModuleData(Module: TModuleHandle; SymbolName: PChar; var Buffer; Size: Cardinal): Boolean;
160
var
161
  Sym: Pointer;
162
begin
163
  Result := True;
164
  Sym := GetModuleSymbolEx(Module, SymbolName, Result);
165
  if Result then
166
    Move(Buffer, Sym^, Size);
167
end;
168

169
{$ENDIF}
170

171
{$IFDEF Unix}
172
uses
173
{$IFDEF UNIX}
174
  Types,
175
  Libc;
176
{$else}
177
  dl,
178
  Types,
179
  Baseunix,
180
  Unix;
181
{$endif}
182
type
183
  // Handle to a loaded .so
184
  TModuleHandle = Pointer;
185

186
const
187
  // Value designating an unassigned TModuleHandle od a failed loading
188
  INVALID_MODULEHANDLE_VALUE = TModuleHandle(nil);
189

190
function LoadModule(var Module: TModuleHandle; FileName: PChar): Boolean;
191
function LoadModuleEx(var Module: TModuleHandle; FileName: PChar; Flags: Cardinal): Boolean;
192
procedure UnloadModule(var Module: TModuleHandle);
193
function GetModuleSymbol(Module: TModuleHandle; SymbolName: PChar): Pointer;
194
function GetModuleSymbolEx(Module: TModuleHandle; SymbolName: PChar; var Accu: Boolean): Pointer;
195
function ReadModuleData(Module: TModuleHandle; SymbolName: PChar; var Buffer; Size: Cardinal): Boolean;
196
function WriteModuleData(Module: TModuleHandle; SymbolName: PChar; var Buffer; Size: Cardinal): Boolean;
197

198
implementation
199

200
// load the .so file FileName
201
// the rules for FileName are those of dlopen()
202
// Returns: True = success, False = failure to load
203
// Assigns: the handle of the loaded .so to Module
204
// Warning: if Module has any other value than INVALID_MODULEHANDLE_VALUE
205
// on entry the function will do nothing but returning success.
206

207
function LoadModule(var Module: TModuleHandle; FileName: PChar): Boolean;
208
begin
209
  if Module = INVALID_MODULEHANDLE_VALUE then
210
    Module := dlopen( FileName, RTLD_NOW);
211
  Result := Module <> INVALID_MODULEHANDLE_VALUE;
212
end;
213

214
// load the .so file FileName
215
// dlopen() with flags is used to get better control of the loading
216
// for the allowed values for flags see "man dlopen".
217

218
function LoadModuleEx(var Module: TModuleHandle; FileName: PChar; Flags: Cardinal): Boolean;
219
begin
220
  if Module = INVALID_MODULEHANDLE_VALUE then
221
    Module := dlopen( FileName, Flags);
222
  Result := Module <> INVALID_MODULEHANDLE_VALUE;
223
end;
224

225
// unload a .so loaded with LoadModule or LoadModuleEx
226
// The procedure will not try to unload a handle with
227
// value INVALID_MODULEHANDLE_VALUE and assigns this value
228
// to Module after unload.
229

230
procedure UnloadModule(var Module: TModuleHandle);
231
begin
232
  if Module <> INVALID_MODULEHANDLE_VALUE then
233
    dlclose(Module);
234
  Module := INVALID_MODULEHANDLE_VALUE;
235
end;
236

237
// returns the pointer to the symbol named SymbolName
238
// if it is exported from the .so Module
239
// nil is returned if the symbol is not available
240

241
function GetModuleSymbol(Module: TModuleHandle; SymbolName: PChar): Pointer;
242
begin
243
  Result := nil;
244
  if Module <> INVALID_MODULEHANDLE_VALUE then
245
    Result := dlsym(Module, SymbolName );
246
end;
247

248
// returns the pointer to the symbol named SymbolName
249
// if it is exported from the .so Module
250
// nil is returned if the symbol is not available.
251
// as an extra the boolean variable Accu is updated
252
// by anding in the success of the function.
253
// This is very handy for rendering a global result
254
// when accessing a long list of symbols.
255

256
function GetModuleSymbolEx(Module: TModuleHandle; SymbolName: PChar; var Accu: Boolean): Pointer;
257
begin
258
  Result := nil;
259
  if Module <> INVALID_MODULEHANDLE_VALUE then
260
    Result := dlsym(Module, SymbolName );
261
  Accu := Accu and (Result <> nil);
262
end;
263

264
// get the value of variables exported from a .so Module
265
// Delphi cannot access variables in a .so directly, so
266
// this function allows to copy the data from the .so.
267
// Beware! You are accessing the .so memory image directly.
268
// Be sure to access a variable not a function and be sure
269
// to read the correct amount of data.
270

271
function ReadModuleData(Module: TModuleHandle; SymbolName: PChar; var Buffer; Size: Cardinal): Boolean;
272
var
273
  Sym: Pointer;
274
begin
275
  Result := True;
276
  Sym := GetModuleSymbolEx(Module, SymbolName, Result);
277
  if Result then
278
    Move(Sym^, Buffer, Size);
279
end;
280

281
// set the value of variables exported from a .so Module
282
// Delphi cannot access variables in a .so directly, so
283
// this function allows to copy the data to the .so!
284
// BEWARE! You are accessing the .so memory image directly.
285
// Be sure to access a variable not a function and be sure
286
// to write the correct amount of data.
287
// The changes are not persistent. They get lost when the
288
// .so is unloaded.
289

290
function WriteModuleData(Module: TModuleHandle; SymbolName: PChar; var Buffer; Size: Cardinal): Boolean;
291
var
292
  Sym: Pointer;
293
begin
294
  Result := True;
295
  Sym := GetModuleSymbolEx(Module, SymbolName, Result);
296
  if Result then
297
    Move(Buffer, Sym^, Size);
298
end;
299
{$ENDIF}
300

301
{$IFDEF __MACH__} // Mach definitions go here
302
{$ENDIF}
303

304
end.
305