Skip to content

Commit adbf167

Browse files
author
Idan Miara
committed
DynamicDll.pas - TDynamicDll + GetDllFileName = DllPath + DllName + CreateInstance, CreateInstanceAndLoad - creates an instance of the dll + MapDll (abstract virtual), CallMapDll - CallMapDll will be called in AfterLoad + LoadDll - now a function instead of procedure, returns validity. + DoOpenDll - use default dllname if empty string is passed; fix for loading dlls in subdirs (previous method would fail depending on its depended DLLs) + Import now accepts UnicodeStrings + Import2 for handling STDCall on 32bit + DllPath now writes via a function SetDllPath + DllFullFileName added a property that returns the full path of the dll
PythonEngine.pas - TPythonInterface + AfterLoad - split functionality between TPythonInterface.MapDll and TDynamicDll.CallMapDll + GetDllPath - add the special behavior for the PythonDLL (IsPythonVersionRegistered) which has nothing to do in TDynamicDll + MapDll - added functionality from TPythonInterface.GetDllPath; Import now accepts UnicodeString and not AnsiString
1 parent 6bc07df commit adbf167

File tree

2 files changed

+114
-63
lines changed

2 files changed

+114
-63
lines changed

‎PythonForDelphi/Components/Sources/Core/DynamicDll.pas

Lines changed: 79 additions & 27 deletions
Original file line numberDiff line numberDiff line change
@@ -107,11 +107,13 @@ EDLLImportError = class(Exception)
107107

108108
type
109109
TDynamicDll = class(TComponent)
110-
private
110+
protected
111111
function IsAPIVersionStored: Boolean;
112112
function IsDllNameStored: Boolean;
113113
function IsRegVersionStored: Boolean;
114-
procedure SetDllName(const Value: String);
114+
procedure SetDllName(const Value: String); virtual;
115+
procedure SetDllPath(const Value: String); virtual;
116+
function GetDllFullFileName: String;
115117
protected
116118
FDllName : String;
117119
FDllPath : String;
@@ -127,14 +129,17 @@ TDynamicDll = class(TComponent)
127129
FOnAfterLoad : TNotifyEvent;
128130
FOnBeforeUnload : TNotifyEvent;
129131

130-
function Import(const funcname: AnsiString; canFail : Boolean = True): Pointer;
132+
procedure CallMapDll; virtual;
133+
function Import(const funcname: String; canFail: Boolean = True): Pointer;
134+
function Import2(funcname: String; args: integer=-1; canFail: Boolean = True): Pointer;
131135
procedure Loaded; override;
132136
procedure BeforeLoad; virtual;
133137
procedure AfterLoad; virtual;
134138
procedure BeforeUnload; virtual;
135139
function GetQuitMessage : String; virtual;
136140
procedure DoOpenDll(const aDllName : String); virtual;
137-
function GetDllPath : String;
141+
function GetDllPath : String; virtual;
142+
procedure MapDll; virtual; abstract;
138143

139144
public
140145
// Constructors & Destructors
@@ -144,16 +149,19 @@ TDynamicDll = class(TComponent)
144149
// Public methods
145150
procedure OpenDll(const aDllName : String);
146151
function IsHandleValid : Boolean;
147-
procedure LoadDll;
152+
function LoadDll: Boolean;
148153
procedure UnloadDll;
149154
procedure Quit;
155+
class function CreateInstance(DllPath: String = ''; DllName: String = ''): TDynamicDll;
156+
class function CreateInstanceAndLoad(DllPath: String = ''; DllName: String = ''): TDynamicDll;
150157

151158
// Public properties
152159
published
153160
property AutoLoad : Boolean read FAutoLoad write FAutoLoad default True;
154161
property AutoUnload : Boolean read FAutoUnload write FAutoUnload default True;
155162
property DllName : String read FDllName write SetDllName stored IsDllNameStored;
156-
property DllPath : String read FDllPath write FDllPath;
163+
property DllPath : String read FDllPath write SetDllPath;
164+
property DllFullFileName : String read GetDllFullFileName;
157165
property APIVersion : Integer read FAPIVersion write FAPIVersion stored IsAPIVersionStored;
158166
property RegVersion : String read FRegVersion write FRegVersion stored IsRegVersionStored;
159167
property FatalAbort : Boolean read FFatalAbort write FFatalAbort default True;
@@ -164,11 +172,8 @@ TDynamicDll = class(TComponent)
164172
property OnBeforeUnload : TNotifyEvent read FOnBeforeUnload write FOnBeforeUnload;
165173
end;
166174

167-
168175
implementation
169176

170-
uses PythonEngine;
171-
172177
(*******************************************************)
173178
(** **)
174179
(** class TDynamicDll **)
@@ -179,35 +184,29 @@ procedure TDynamicDll.DoOpenDll(const aDllName : String);
179184
begin
180185
if not IsHandleValid then
181186
begin
182-
FDllName := aDllName;
187+
if aDllName<>'' then
188+
FDllName := aDllName;
189+
SetDllDirectory(PChar(GetDllPath));
183190
FDLLHandle := SafeLoadLibrary(
184191
{$IFDEF FPC}
185-
PAnsiChar(AnsiString(GetDllPath+DllName))
192+
PAnsiChar(AnsiString(DllName))
186193
{$ELSE}
187194
GetDllPath+DllName
188195
{$ENDIF}
189196
);
190197
end;
191198
end;
192199

200+
function TDynamicDll.GetDllFullFileName: String;
201+
begin
202+
Result := DllPath + DllName;
203+
end;
204+
193205
function TDynamicDll.GetDllPath : String;
194-
{$IFDEF MSWINDOWS}
195-
var
196-
AllUserInstall: Boolean;
197-
{$ENDIF}
198206
begin
199207
Result := DllPath;
200-
201-
{$IFDEF MSWINDOWS}
202-
if DLLPath = '' then begin
203-
IsPythonVersionRegistered(RegVersion, Result, AllUserInstall);
204-
end;
205-
{$ENDIF}
206-
207208
if Result <> '' then
208-
begin
209209
Result := IncludeTrailingPathDelimiter(Result);
210-
end;
211210
end;
212211

213212
procedure TDynamicDll.OpenDll(const aDllName : String);
@@ -250,6 +249,7 @@ constructor TDynamicDll.Create(AOwner: TComponent);
250249
FFatalAbort := True;
251250
FAutoLoad := True;
252251
FUseLastKnownVersion := True;
252+
FDLLHandle := 0;
253253
end;
254254

255255
destructor TDynamicDll.Destroy;
@@ -259,11 +259,11 @@ destructor TDynamicDll.Destroy;
259259
inherited;
260260
end;
261261

262-
function TDynamicDll.Import(const funcname: AnsiString; canFail : Boolean = True): Pointer;
262+
function TDynamicDll.Import(const funcname: String; canFail: Boolean): Pointer;
263263
var
264264
E : EDllImportError;
265265
begin
266-
Result := GetProcAddress( FDLLHandle, PAnsiChar(funcname) );
266+
Result := GetProcAddress( FDLLHandle, PChar(funcname) );
267267
if (Result = nil) and canFail then begin
268268
{$IFDEF MSWINDOWS}
269269
E := EDllImportError.CreateFmt('Error %d: could not map symbol "%s"', [GetLastError, funcname]);
@@ -276,6 +276,17 @@ function TDynamicDll.Import(const funcname: AnsiString; canFail : Boolean = True
276276
end;
277277
end;
278278

279+
function TDynamicDll.Import2(funcname: String; args: integer; canFail: Boolean): Pointer;
280+
begin
281+
{$IFDEF WIN32}
282+
// using STDCall name decoration
283+
// copy paste the function names from dependency walker to notepad and search for the function name there.
284+
if args>=0 then
285+
funcname := '_'+funcname+'@'+IntToStr(args);
286+
{$ENDIF}
287+
Result := Import(funcname, canFail);
288+
end;
289+
279290
procedure TDynamicDll.Loaded;
280291
begin
281292
inherited;
@@ -293,9 +304,10 @@ function TDynamicDll.IsHandleValid : Boolean;
293304
{$ENDIF}
294305
end;
295306

296-
procedure TDynamicDll.LoadDll;
307+
function TDynamicDll.LoadDll: Boolean;
297308
begin
298309
OpenDll( DllName );
310+
Result := IsHandleValid;
299311
end;
300312

301313
procedure TDynamicDll.UnloadDll;
@@ -317,6 +329,7 @@ procedure TDynamicDll.AfterLoad;
317329
begin
318330
if Assigned( FOnAfterLoad ) then
319331
FOnAfterLoad( Self );
332+
CallMapDll;
320333
end;
321334

322335
procedure TDynamicDll.BeforeUnload;
@@ -367,5 +380,44 @@ procedure TDynamicDll.SetDllName(const Value: String);
367380
FDllName := Value;
368381
end;
369382

383+
procedure TDynamicDll.SetDllPath(const Value: String);
384+
begin
385+
FDllPath := Value;
386+
end;
387+
388+
procedure TDynamicDll.CallMapDll;
389+
begin
390+
try
391+
MapDll;
392+
except
393+
on E: Exception do begin
394+
if FatalMsgDlg then
395+
{$IFDEF MSWINDOWS}
396+
MessageBox( GetActiveWindow, PChar(E.Message), 'Error', MB_TASKMODAL or MB_ICONSTOP );
397+
{$ELSE}
398+
WriteLn( ErrOutput, E.Message );
399+
{$ENDIF}
400+
if FatalAbort then Quit;
401+
end;
402+
end;
403+
end;
404+
405+
class function TDynamicDll.CreateInstance(DllPath, DllName: String): TDynamicDll;
406+
begin
407+
Result := Create(nil);
408+
if DllPath<>'' then
409+
Result.DllPath := DllPath;
410+
if DllName<>'' then
411+
Result.DllName := DllName;
412+
end;
413+
414+
class function TDynamicDll.CreateInstanceAndLoad(DllPath, DllName: String): TDynamicDll;
415+
begin
416+
Result := CreateInstance(DllPath, DllName);
417+
Result.LoadDll;
418+
if not Result.IsHandleValid then
419+
FreeAndNil(Result);
420+
end;
421+
370422
end.
371423

‎PythonForDelphi/Components/Sources/Core/PythonEngine.pas

Lines changed: 35 additions & 36 deletions
Original file line numberDiff line numberDiff line change
@@ -1510,7 +1510,7 @@ TPythonInterface=class(TDynamicDll)
15101510
FBuiltInModuleName: String;
15111511
function GetInitialized: Boolean;
15121512

1513-
procedure AfterLoad; override;
1513+
function GetDllPath : String; override;
15141514
function GetQuitMessage : String; override;
15151515
procedure CheckPython;
15161516
function GetUnicodeTypeSuffix : String;
@@ -2051,7 +2051,7 @@ TPythonInterface=class(TDynamicDll)
20512051
constructor Create(AOwner: TComponent); override;
20522052

20532053
// Public methods
2054-
procedure MapDll;
2054+
procedure MapDll; override;
20552055

20562056
// Public properties
20572057
property Initialized : Boolean read GetInitialized;
@@ -3293,32 +3293,22 @@ constructor TPythonInterface.Create(AOwner: TComponent);
32933293
FAutoUnload := True;
32943294
end;
32953295

3296-
procedure TPythonInterface.AfterLoad;
3297-
begin
3298-
inherited;
3299-
FIsPython3000 := Pos('PYTHON3', UpperCase(DLLName)) > 0;
3300-
FMajorVersion := StrToInt(DLLName[7 {$IFDEF LINUX}+3{$ENDIF}]);
3301-
FMinorVersion := StrToInt(DLLName[8{$IFDEF LINUX}+4{$ENDIF}]);
3302-
3303-
3304-
if FIsPython3000 then
3305-
FBuiltInModuleName := 'builtins'
3306-
else
3307-
FBuiltInModuleName := '__builtin__';
3308-
3309-
try
3310-
MapDll;
3311-
except
3312-
on E: Exception do begin
3313-
if FatalMsgDlg then
3296+
function TPythonInterface.GetDllPath: String;
33143297
{$IFDEF MSWINDOWS}
3315-
MessageBox( GetActiveWindow, PChar(E.Message), 'Error', MB_TASKMODAL or MB_ICONSTOP );
3316-
{$ELSE}
3317-
WriteLn( ErrOutput, E.Message );
3298+
var
3299+
AllUserInstall: Boolean;
33183300
{$ENDIF}
3319-
if FatalAbort then Quit;
3320-
end;
3301+
begin
3302+
Result := DllPath;
3303+
3304+
{$IFDEF MSWINDOWS}
3305+
if DLLPath = '' then begin
3306+
IsPythonVersionRegistered(RegVersion, Result, AllUserInstall);
33213307
end;
3308+
{$ENDIF}
3309+
3310+
if Result <> '' then
3311+
Result := IncludeTrailingPathDelimiter(Result);
33223312
end;
33233313

33243314
function TPythonInterface.GetQuitMessage : String;
@@ -3352,6 +3342,15 @@ function TPythonInterface.GetUnicodeTypeSuffix : String;
33523342

33533343
procedure TPythonInterface.MapDll;
33543344
begin
3345+
FIsPython3000 := Pos('PYTHON3', UpperCase(DLLName)) > 0;
3346+
FMajorVersion := StrToInt(DLLName[7 {$IFDEF LINUX}+3{$ENDIF}]);
3347+
FMinorVersion := StrToInt(DLLName[8{$IFDEF LINUX}+4{$ENDIF}]);
3348+
3349+
if FIsPython3000 then
3350+
FBuiltInModuleName := 'builtins'
3351+
else
3352+
FBuiltInModuleName := '__builtin__';
3353+
33553354
Py_DebugFlag := Import('Py_DebugFlag');
33563355
Py_VerboseFlag := Import('Py_VerboseFlag');
33573356
Py_InteractiveFlag := Import('Py_InteractiveFlag');
@@ -3760,12 +3759,12 @@ procedure TPythonInterface.MapDll;
37603759
PyType_GenericAlloc :=Import('PyType_GenericAlloc');
37613760
PyType_GenericNew :=Import('PyType_GenericNew');
37623761
PyType_Ready :=Import('PyType_Ready');
3763-
PyUnicode_FromWideChar :=Import(AnsiString(Format('PyUnicode%s_FromWideChar',[GetUnicodeTypeSuffix])));
3764-
PyUnicode_AsWideChar :=Import(AnsiString(Format('PyUnicode%s_AsWideChar',[GetUnicodeTypeSuffix])));
3765-
PyUnicode_Decode :=Import(AnsiString(Format('PyUnicode%s_Decode',[GetUnicodeTypeSuffix])));
3766-
PyUnicode_AsEncodedString :=Import(AnsiString(Format('PyUnicode%s_AsEncodedString',[GetUnicodeTypeSuffix])));
3767-
PyUnicode_FromOrdinal :=Import(AnsiString(Format('PyUnicode%s_FromOrdinal',[GetUnicodeTypeSuffix])));
3768-
PyUnicode_GetSize :=Import(AnsiString(Format('PyUnicode%s_GetSize',[GetUnicodeTypeSuffix])));
3762+
PyUnicode_FromWideChar :=Import(Format('PyUnicode%s_FromWideChar',[GetUnicodeTypeSuffix]));
3763+
PyUnicode_AsWideChar :=Import(Format('PyUnicode%s_AsWideChar',[GetUnicodeTypeSuffix]));
3764+
PyUnicode_Decode :=Import(Format('PyUnicode%s_Decode',[GetUnicodeTypeSuffix]));
3765+
PyUnicode_AsEncodedString :=Import(Format('PyUnicode%s_AsEncodedString',[GetUnicodeTypeSuffix]));
3766+
PyUnicode_FromOrdinal :=Import(Format('PyUnicode%s_FromOrdinal',[GetUnicodeTypeSuffix]));
3767+
PyUnicode_GetSize :=Import(Format('PyUnicode%s_GetSize',[GetUnicodeTypeSuffix]));
37693768
PyWeakref_GetObject :=Import('PyWeakref_GetObject');
37703769
PyWeakref_NewProxy :=Import('PyWeakref_NewProxy');
37713770
PyWeakref_NewRef :=Import('PyWeakref_NewRef');
@@ -5039,12 +5038,12 @@ function TPythonEngine.Run_CommandAsObjectWithDict(const command : AnsiString; m
50395038

50405039
procedure TPythonEngine.ExecStrings( strings : TStrings );
50415040
begin
5042-
Py_XDecRef( Run_CommandAsObject( CleanString( EncodeString(strings.Text) ), file_input ) );
5041+
Py_XDecRef( Run_CommandAsObject( CleanString( EncodeString(strings.Text) ), file_input ) );
50435042
end;
50445043

50455044
function TPythonEngine.EvalStrings( strings : TStrings ) : PPyObject;
50465045
begin
5047-
Result := Run_CommandAsObject( CleanString( EncodeString(strings.Text) ), eval_input );
5046+
Result := Run_CommandAsObject( CleanString( EncodeString(strings.Text) ), eval_input );
50485047
end;
50495048

50505049
procedure TPythonEngine.ExecString(const command : AnsiString; locals, globals : PPyObject );
@@ -5054,7 +5053,7 @@ procedure TPythonEngine.ExecString(const command : AnsiString; locals, globals :
50545053

50555054
procedure TPythonEngine.ExecStrings( strings : TStrings; locals, globals : PPyObject );
50565055
begin
5057-
Py_XDecRef( Run_CommandAsObjectWithDict( CleanString( EncodeString(strings.Text) ), file_input, locals, globals ) );
5056+
Py_XDecRef( Run_CommandAsObjectWithDict( CleanString( EncodeString(strings.Text) ), file_input, locals, globals ) );
50585057
end;
50595058

50605059
function TPythonEngine.EvalString( const command : AnsiString; locals, globals : PPyObject ) : PPyObject;
@@ -5064,12 +5063,12 @@ function TPythonEngine.EvalString( const command : AnsiString; locals, globals :
50645063

50655064
function TPythonEngine.EvalStrings( strings : TStrings; locals, globals : PPyObject ) : PPyObject;
50665065
begin
5067-
Result := Run_CommandAsObjectWithDict( CleanString( EncodeString(strings.Text) ), eval_input, locals, globals );
5066+
Result := Run_CommandAsObjectWithDict( CleanString( EncodeString(strings.Text) ), eval_input, locals, globals );
50685067
end;
50695068

50705069
function TPythonEngine.EvalStringsAsStr( strings : TStrings ) : String;
50715070
begin
5072-
Result := Run_CommandAsString( CleanString( EncodeString(strings.Text) ), eval_input );
5071+
Result := Run_CommandAsString( CleanString( EncodeString(strings.Text) ), eval_input );
50735072
end;
50745073

50755074
function TPythonEngine.CheckEvalSyntax( const str : AnsiString ) : Boolean;

0 commit comments

Comments
 (0)