From 6bc07dfd0d22531f776bd2f748b0a985239249ac Mon Sep 17 00:00:00 2001 From: Idan Miara Date: Thu, 6 Dec 2018 12:29:12 +0200 Subject: [PATCH 1/2] PythonEngine.pas - separate TDynamicDll into a new file - DynamicDll.pas (without other modifications) --- .../Components/Sources/Core/DynamicDll.pas | 371 ++++++++++++++++++ .../Components/Sources/Core/PythonEngine.pas | 278 +------------ 2 files changed, 377 insertions(+), 272 deletions(-) create mode 100644 PythonForDelphi/Components/Sources/Core/DynamicDll.pas diff --git a/PythonForDelphi/Components/Sources/Core/DynamicDll.pas b/PythonForDelphi/Components/Sources/Core/DynamicDll.pas new file mode 100644 index 00000000..92df69f0 --- /dev/null +++ b/PythonForDelphi/Components/Sources/Core/DynamicDll.pas @@ -0,0 +1,371 @@ +(**************************************************************************) +(* *) +(* Module: Unit 'PythonEngine' Copyright (c) 1997 *) +(* *) +(* Version: 3.0 Dr. Dietmar Budelsky *) +(* Sub-Version: 0.33 dbudelsky@web.de *) +(* Germany *) +(* *) +(* Morgan Martinet *) +(* 4723 rue Brebeuf *) +(* H2J 3L2 MONTREAL (QC) *) +(* CANADA *) +(* e-mail: p4d@mmm-experts.com *) +(* *) +(* look at the project page at: http://python4Delphi.googlecode.com/ *) +(**************************************************************************) +(* Functionality: Delphi Components that provide an interface to the *) +(* Python language (see python.txt for more infos on *) +(* Python itself). *) +(* *) +(**************************************************************************) +(* Contributors: *) +(* Grzegorz Makarewicz (mak@mikroplan.com.pl) *) +(* Andrew Robinson (andy@hps1.demon.co.uk) *) +(* Mark Watts(mark_watts@hotmail.com) *) +(* Olivier Deckmyn (olivier.deckmyn@mail.dotcom.fr) *) +(* Sigve Tjora (public@tjora.no) *) +(* Mark Derricutt (mark@talios.com) *) +(* Igor E. Poteryaev (jah@mail.ru) *) +(* Yuri Filimonov (fil65@mail.ru) *) +(* Stefan Hoffmeister (Stefan.Hoffmeister@Econos.de) *) +(* Michiel du Toit (micdutoit@hsbfn.com) - Lazarus Port *) +(* Chris Nicolai (nicolaitanes@gmail.com) *) +(* Kiriakos Vlahos (pyscripter@gmail.com) *) +(* Andrey Gruzdev (andrey.gruzdev@gmail.com) *) +(**************************************************************************) +(* This source code is distributed with no WARRANTY, for no reason or use.*) +(* Everyone is allowed to use and change this code free for his own tasks *) +(* and projects, as long as this header and its copyright text is intact. *) +(* For changed versions of this code, which are public distributed the *) +(* following additional conditions have to be fullfilled: *) +(* 1) The header has to contain a comment on the change and the author of *) +(* it. *) +(* 2) A copy of the changed source has to be sent to the above E-Mail *) +(* address or my then valid address, if this is possible to the *) +(* author. *) +(* The second condition has the target to maintain an up to date central *) +(* version of the component. If this condition is not acceptable for *) +(* confidential or legal reasons, everyone is free to derive a component *) +(* or to generate a diff file to my or other original sources. *) +(* Dr. Dietmar Budelsky, 1997-11-17 *) +(**************************************************************************) + +{$I Definition.Inc} + +unit DynamicDll; + +{ TODO -oMMM : implement tp_as_buffer slot } +{ TODO -oMMM : implement Attribute descriptor and subclassing stuff } + +{$IFNDEF FPC} + {$IFNDEF DELPHI7_OR_HIGHER} + Error! Delphi 7 or higher is required! + {$ENDIF} +{$ENDIF} + +interface + +uses + Types, +{$IFDEF MSWINDOWS} + Windows, +{$ELSE} +{$IFDEF FPC} + dynlibs, +{$ELSE} +{$IFDEF LINUX} + Libc, +{$ENDIF} +{$ENDIF} +{$ENDIF} + Classes, + SysUtils, + SyncObjs, + Variants, +{$IFDEF DELPHI2005_OR_HIGHER} +{$IFNDEF UNICODE} + WideStrings, +{$ENDIF} +{$ELSE} + TinyWideStrings, +{$ENDIF} + MethodCallBack; + +type + EDLLImportError = class(Exception) + public + WrongFunc : String; + ErrorCode : Integer; + end; + +//------------------------------------------------------- +//-- -- +//-- Base class: TDynamicDll -- +//-- -- +//------------------------------------------------------- + +type + TDynamicDll = class(TComponent) + private + function IsAPIVersionStored: Boolean; + function IsDllNameStored: Boolean; + function IsRegVersionStored: Boolean; + procedure SetDllName(const Value: String); + protected + FDllName : String; + FDllPath : String; + FAPIVersion : Integer; + FRegVersion : String; + FAutoLoad : Boolean; + FAutoUnload : Boolean; + FFatalMsgDlg : Boolean; + FFatalAbort : Boolean; + FDLLHandle : THandle; + FUseLastKnownVersion: Boolean; + FOnBeforeLoad : TNotifyEvent; + FOnAfterLoad : TNotifyEvent; + FOnBeforeUnload : TNotifyEvent; + + function Import(const funcname: AnsiString; canFail : Boolean = True): Pointer; + procedure Loaded; override; + procedure BeforeLoad; virtual; + procedure AfterLoad; virtual; + procedure BeforeUnload; virtual; + function GetQuitMessage : String; virtual; + procedure DoOpenDll(const aDllName : String); virtual; + function GetDllPath : String; + + public + // Constructors & Destructors + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + + // Public methods + procedure OpenDll(const aDllName : String); + function IsHandleValid : Boolean; + procedure LoadDll; + procedure UnloadDll; + procedure Quit; + + // Public properties + published + property AutoLoad : Boolean read FAutoLoad write FAutoLoad default True; + property AutoUnload : Boolean read FAutoUnload write FAutoUnload default True; + property DllName : String read FDllName write SetDllName stored IsDllNameStored; + property DllPath : String read FDllPath write FDllPath; + property APIVersion : Integer read FAPIVersion write FAPIVersion stored IsAPIVersionStored; + property RegVersion : String read FRegVersion write FRegVersion stored IsRegVersionStored; + property FatalAbort : Boolean read FFatalAbort write FFatalAbort default True; + property FatalMsgDlg : Boolean read FFatalMsgDlg write FFatalMsgDlg default True; + property UseLastKnownVersion: Boolean read FUseLastKnownVersion write FUseLastKnownVersion default True; + property OnAfterLoad : TNotifyEvent read FOnAfterLoad write FOnAfterLoad; + property OnBeforeLoad : TNotifyEvent read FOnBeforeLoad write FOnBeforeLoad; + property OnBeforeUnload : TNotifyEvent read FOnBeforeUnload write FOnBeforeUnload; + end; + + +implementation + +uses PythonEngine; + +(*******************************************************) +(** **) +(** class TDynamicDll **) +(** **) +(*******************************************************) + +procedure TDynamicDll.DoOpenDll(const aDllName : String); +begin + if not IsHandleValid then + begin + FDllName := aDllName; + FDLLHandle := SafeLoadLibrary( + {$IFDEF FPC} + PAnsiChar(AnsiString(GetDllPath+DllName)) + {$ELSE} + GetDllPath+DllName + {$ENDIF} + ); + end; +end; + +function TDynamicDll.GetDllPath : String; +{$IFDEF MSWINDOWS} +var + AllUserInstall: Boolean; +{$ENDIF} +begin + Result := DllPath; + + {$IFDEF MSWINDOWS} + if DLLPath = '' then begin + IsPythonVersionRegistered(RegVersion, Result, AllUserInstall); + end; + {$ENDIF} + + if Result <> '' then + begin + Result := IncludeTrailingPathDelimiter(Result); + end; +end; + +procedure TDynamicDll.OpenDll(const aDllName : String); +var + s : String; +begin + UnloadDll; + + BeforeLoad; + + FDLLHandle := 0; + + DoOpenDll(aDllName); + + if not IsHandleValid then begin +{$IFDEF MSWINDOWS} + s := Format('Error %d: Could not open Dll "%s"',[GetLastError, DllName]); +{$ENDIF} +{$IFDEF LINUX} + s := Format('Error: Could not open Dll "%s"',[DllName]); +{$ENDIF} + if FatalMsgDlg then +{$IFDEF MSWINDOWS} + MessageBox( GetActiveWindow, PChar(s), 'Error', MB_TASKMODAL or MB_ICONSTOP ); +{$ENDIF} +{$IFDEF LINUX} + WriteLn(ErrOutput, s); +{$ENDIF} + + if FatalAbort then + Quit; + end else + AfterLoad; +end; + +constructor TDynamicDll.Create(AOwner: TComponent); +begin + inherited; + FFatalMsgDlg := True; + FFatalAbort := True; + FAutoLoad := True; + FUseLastKnownVersion := True; +end; + +destructor TDynamicDll.Destroy; +begin + if AutoUnload then + UnloadDll; + inherited; +end; + +function TDynamicDll.Import(const funcname: AnsiString; canFail : Boolean = True): Pointer; +var + E : EDllImportError; +begin + Result := GetProcAddress( FDLLHandle, PAnsiChar(funcname) ); + if (Result = nil) and canFail then begin + {$IFDEF MSWINDOWS} + E := EDllImportError.CreateFmt('Error %d: could not map symbol "%s"', [GetLastError, funcname]); + E.ErrorCode := GetLastError; + {$ELSE} + E := EDllImportError.CreateFmt('Error: could not map symbol "%s"', [funcname]); + {$ENDIF} + E.WrongFunc := funcname; + raise E; + end; +end; + +procedure TDynamicDll.Loaded; +begin + inherited; + if AutoLoad and not (csDesigning in ComponentState) then + LoadDll; +end; + +function TDynamicDll.IsHandleValid : Boolean; +begin +{$IFDEF MSWINDOWS} + Result := (FDLLHandle >= 32); +{$ENDIF} +{$IFDEF LINUX} + Result := FDLLHandle <> 0; +{$ENDIF} +end; + +procedure TDynamicDll.LoadDll; +begin + OpenDll( DllName ); +end; + +procedure TDynamicDll.UnloadDll; +begin + if IsHandleValid then begin + BeforeUnload; + FreeLibrary(FDLLHandle); + FDLLHandle := 0; + end; +end; + +procedure TDynamicDll.BeforeLoad; +begin + if Assigned( FOnBeforeLoad ) then + FOnBeforeLoad( Self ); +end; + +procedure TDynamicDll.AfterLoad; +begin + if Assigned( FOnAfterLoad ) then + FOnAfterLoad( Self ); +end; + +procedure TDynamicDll.BeforeUnload; +begin + if Assigned( FOnBeforeUnload ) then + FOnBeforeUnload( Self ); +end; + +function TDynamicDll.GetQuitMessage : String; +begin + Result := Format( 'Dll %s could not be loaded. We must quit.', [DllName]); +end; + +procedure TDynamicDll.Quit; +begin + if not( csDesigning in ComponentState ) then begin +{$IFDEF MSWINDOWS} + MessageBox( GetActiveWindow, PChar(GetQuitMessage), 'Error', MB_TASKMODAL or MB_ICONSTOP ); + ExitProcess( 1 ); +{$ELSE} + WriteLn(ErrOutput, GetQuitMessage); +{$IFDEF FPC} + Halt( 1 ); +{$ELSE} + __exit(1); +{$ENDIF} +{$ENDIF} + end; +end; + +function TDynamicDll.IsAPIVersionStored: Boolean; +begin + Result := not UseLastKnownVersion; +end; + +function TDynamicDll.IsDllNameStored: Boolean; +begin + Result := not UseLastKnownVersion; +end; + +function TDynamicDll.IsRegVersionStored: Boolean; +begin + Result := not UseLastKnownVersion; +end; + +procedure TDynamicDll.SetDllName(const Value: String); +begin + FDllName := Value; +end; + +end. + diff --git a/PythonForDelphi/Components/Sources/Core/PythonEngine.pas b/PythonForDelphi/Components/Sources/Core/PythonEngine.pas index 10b84f42..d56f3549 100644 --- a/PythonForDelphi/Components/Sources/Core/PythonEngine.pas +++ b/PythonForDelphi/Components/Sources/Core/PythonEngine.pas @@ -90,6 +90,7 @@ interface {$ELSE} TinyWideStrings, {$ENDIF} + DynamicDll, MethodCallBack; //####################################################### @@ -1266,11 +1267,6 @@ interface // Components' exceptions EDLLLoadError = class(Exception); - EDLLImportError = class(Exception) - public - WrongFunc : AnsiString; - ErrorCode : Integer; - end; // Python's exceptions EPythonError = class(Exception) @@ -1483,70 +1479,6 @@ TPythonInputOutput = class(TComponent) property RawOutput: Boolean read FRawOutput write FRawOutput; end; -//------------------------------------------------------- -//-- -- -//-- Base class: TDynamicDll -- -//-- -- -//------------------------------------------------------- - -type - TDynamicDll = class(TComponent) - private - function IsAPIVersionStored: Boolean; - function IsDllNameStored: Boolean; - function IsRegVersionStored: Boolean; - procedure SetDllName(const Value: String); - protected - FDllName : String; - FDllPath : String; - FAPIVersion : Integer; - FRegVersion : String; - FAutoLoad : Boolean; - FAutoUnload : Boolean; - FFatalMsgDlg : Boolean; - FFatalAbort : Boolean; - FDLLHandle : THandle; - FUseLastKnownVersion: Boolean; - FOnBeforeLoad : TNotifyEvent; - FOnAfterLoad : TNotifyEvent; - FOnBeforeUnload : TNotifyEvent; - - function Import(const funcname: AnsiString; canFail : Boolean = True): Pointer; - procedure Loaded; override; - procedure BeforeLoad; virtual; - procedure AfterLoad; virtual; - procedure BeforeUnload; virtual; - function GetQuitMessage : String; virtual; - procedure DoOpenDll(const aDllName : String); virtual; - function GetDllPath : String; - - public - // Constructors & Destructors - constructor Create(AOwner: TComponent); override; - destructor Destroy; override; - - // Public methods - procedure OpenDll(const aDllName : String); - function IsHandleValid : Boolean; - procedure LoadDll; - procedure UnloadDll; - procedure Quit; - - // Public properties - published - property AutoLoad : Boolean read FAutoLoad write FAutoLoad default True; - property AutoUnload : Boolean read FAutoUnload write FAutoUnload default True; - property DllName : String read FDllName write SetDllName stored IsDllNameStored; - property DllPath : String read FDllPath write FDllPath; - property APIVersion : Integer read FAPIVersion write FAPIVersion stored IsAPIVersionStored; - property RegVersion : String read FRegVersion write FRegVersion stored IsRegVersionStored; - property FatalAbort : Boolean read FFatalAbort write FFatalAbort default True; - property FatalMsgDlg : Boolean read FFatalMsgDlg write FFatalMsgDlg default True; - property UseLastKnownVersion: Boolean read FUseLastKnownVersion write FUseLastKnownVersion default True; - property OnAfterLoad : TNotifyEvent read FOnAfterLoad write FOnAfterLoad; - property OnBeforeLoad : TNotifyEvent read FOnBeforeLoad write FOnBeforeLoad; - property OnBeforeUnload : TNotifyEvent read FOnBeforeUnload write FOnBeforeUnload; - end; //------------------------------------------------------- //-- -- @@ -3342,204 +3274,6 @@ procedure TPythonInputOutput.UpdateCurrentThreadLine; FLinesPerThread.Strings[ GetCurrentThreadSlotIdx ] := FLine_Buffer; end; -(*******************************************************) -(** **) -(** class TDynamicDll **) -(** **) -(*******************************************************) - -procedure TDynamicDll.DoOpenDll(const aDllName : String); -begin - if not IsHandleValid then - begin - FDllName := aDllName; - FDLLHandle := SafeLoadLibrary( - {$IFDEF FPC} - PAnsiChar(AnsiString(GetDllPath+DllName)) - {$ELSE} - GetDllPath+DllName - {$ENDIF} - ); - end; -end; - -function TDynamicDll.GetDllPath : String; -{$IFDEF MSWINDOWS} -var - AllUserInstall: Boolean; -{$ENDIF} -begin - Result := DllPath; - - {$IFDEF MSWINDOWS} - if DLLPath = '' then begin - IsPythonVersionRegistered(RegVersion, Result, AllUserInstall); - end; - {$ENDIF} - - if Result <> '' then - begin - Result := IncludeTrailingPathDelimiter(Result); - end; -end; - -procedure TDynamicDll.OpenDll(const aDllName : String); -var - s : String; -begin - UnloadDll; - - BeforeLoad; - - FDLLHandle := 0; - - DoOpenDll(aDllName); - - if not IsHandleValid then begin -{$IFDEF MSWINDOWS} - s := Format('Error %d: Could not open Dll "%s"',[GetLastError, DllName]); -{$ENDIF} -{$IFDEF LINUX} - s := Format('Error: Could not open Dll "%s"',[DllName]); -{$ENDIF} - if FatalMsgDlg then -{$IFDEF MSWINDOWS} - MessageBox( GetActiveWindow, PChar(s), 'Error', MB_TASKMODAL or MB_ICONSTOP ); -{$ENDIF} -{$IFDEF LINUX} - WriteLn(ErrOutput, s); -{$ENDIF} - - if FatalAbort then - Quit; - end else - AfterLoad; -end; - -constructor TDynamicDll.Create(AOwner: TComponent); -begin - inherited; - FFatalMsgDlg := True; - FFatalAbort := True; - FAutoLoad := True; - FUseLastKnownVersion := True; -end; - -destructor TDynamicDll.Destroy; -begin - if AutoUnload then - UnloadDll; - inherited; -end; - -function TDynamicDll.Import(const funcname: AnsiString; canFail : Boolean = True): Pointer; -var - E : EDllImportError; -begin - Result := GetProcAddress( FDLLHandle, PAnsiChar(funcname) ); - if (Result = nil) and canFail then begin - {$IFDEF MSWINDOWS} - E := EDllImportError.CreateFmt('Error %d: could not map symbol "%s"', [GetLastError, funcname]); - E.ErrorCode := GetLastError; - {$ELSE} - E := EDllImportError.CreateFmt('Error: could not map symbol "%s"', [funcname]); - {$ENDIF} - E.WrongFunc := funcname; - raise E; - end; -end; - -procedure TDynamicDll.Loaded; -begin - inherited; - if AutoLoad and not (csDesigning in ComponentState) then - LoadDll; -end; - -function TDynamicDll.IsHandleValid : Boolean; -begin -{$IFDEF MSWINDOWS} - Result := (FDLLHandle >= 32); -{$ENDIF} -{$IFDEF LINUX} - Result := FDLLHandle <> 0; -{$ENDIF} -end; - -procedure TDynamicDll.LoadDll; -begin - OpenDll( DllName ); -end; - -procedure TDynamicDll.UnloadDll; -begin - if IsHandleValid then begin - BeforeUnload; - FreeLibrary(FDLLHandle); - FDLLHandle := 0; - end; -end; - -procedure TDynamicDll.BeforeLoad; -begin - if Assigned( FOnBeforeLoad ) then - FOnBeforeLoad( Self ); -end; - -procedure TDynamicDll.AfterLoad; -begin - if Assigned( FOnAfterLoad ) then - FOnAfterLoad( Self ); -end; - -procedure TDynamicDll.BeforeUnload; -begin - if Assigned( FOnBeforeUnload ) then - FOnBeforeUnload( Self ); -end; - -function TDynamicDll.GetQuitMessage : String; -begin - Result := Format( 'Dll %s could not be loaded. We must quit.', [DllName]); -end; - -procedure TDynamicDll.Quit; -begin - if not( csDesigning in ComponentState ) then begin -{$IFDEF MSWINDOWS} - MessageBox( GetActiveWindow, PChar(GetQuitMessage), 'Error', MB_TASKMODAL or MB_ICONSTOP ); - ExitProcess( 1 ); -{$ELSE} - WriteLn(ErrOutput, GetQuitMessage); -{$IFDEF FPC} - Halt( 1 ); -{$ELSE} - __exit(1); -{$ENDIF} -{$ENDIF} - end; -end; - -function TDynamicDll.IsAPIVersionStored: Boolean; -begin - Result := not UseLastKnownVersion; -end; - -function TDynamicDll.IsDllNameStored: Boolean; -begin - Result := not UseLastKnownVersion; -end; - -function TDynamicDll.IsRegVersionStored: Boolean; -begin - Result := not UseLastKnownVersion; -end; - -procedure TDynamicDll.SetDllName(const Value: String); -begin - FDllName := Value; -end; - (*******************************************************) (** **) @@ -5305,12 +5039,12 @@ function TPythonEngine.Run_CommandAsObjectWithDict(const command : AnsiString; m procedure TPythonEngine.ExecStrings( strings : TStrings ); begin - Py_XDecRef( Run_CommandAsObject( CleanString( EncodeString(strings.Text) ), file_input ) ); + Py_XDecRef( Run_CommandAsObject( CleanString( EncodeString(strings.Text) ), file_input ) ); end; function TPythonEngine.EvalStrings( strings : TStrings ) : PPyObject; begin - Result := Run_CommandAsObject( CleanString( EncodeString(strings.Text) ), eval_input ); + Result := Run_CommandAsObject( CleanString( EncodeString(strings.Text) ), eval_input ); end; procedure TPythonEngine.ExecString(const command : AnsiString; locals, globals : PPyObject ); @@ -5320,7 +5054,7 @@ procedure TPythonEngine.ExecString(const command : AnsiString; locals, globals : procedure TPythonEngine.ExecStrings( strings : TStrings; locals, globals : PPyObject ); begin - Py_XDecRef( Run_CommandAsObjectWithDict( CleanString( EncodeString(strings.Text) ), file_input, locals, globals ) ); + Py_XDecRef( Run_CommandAsObjectWithDict( CleanString( EncodeString(strings.Text) ), file_input, locals, globals ) ); end; function TPythonEngine.EvalString( const command : AnsiString; locals, globals : PPyObject ) : PPyObject; @@ -5330,12 +5064,12 @@ function TPythonEngine.EvalString( const command : AnsiString; locals, globals : function TPythonEngine.EvalStrings( strings : TStrings; locals, globals : PPyObject ) : PPyObject; begin - Result := Run_CommandAsObjectWithDict( CleanString( EncodeString(strings.Text) ), eval_input, locals, globals ); + Result := Run_CommandAsObjectWithDict( CleanString( EncodeString(strings.Text) ), eval_input, locals, globals ); end; function TPythonEngine.EvalStringsAsStr( strings : TStrings ) : String; begin - Result := Run_CommandAsString( CleanString( EncodeString(strings.Text) ), eval_input ); + Result := Run_CommandAsString( CleanString( EncodeString(strings.Text) ), eval_input ); end; function TPythonEngine.CheckEvalSyntax( const str : AnsiString ) : Boolean; From adbf1671ac7821f4965dc30ad5da577fe301e45f Mon Sep 17 00:00:00 2001 From: Idan Miara Date: Thu, 6 Dec 2018 12:57:49 +0200 Subject: [PATCH 2/2] 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 --- .../Components/Sources/Core/DynamicDll.pas | 106 +++++++++++++----- .../Components/Sources/Core/PythonEngine.pas | 71 ++++++------ 2 files changed, 114 insertions(+), 63 deletions(-) diff --git a/PythonForDelphi/Components/Sources/Core/DynamicDll.pas b/PythonForDelphi/Components/Sources/Core/DynamicDll.pas index 92df69f0..2f28a5ff 100644 --- a/PythonForDelphi/Components/Sources/Core/DynamicDll.pas +++ b/PythonForDelphi/Components/Sources/Core/DynamicDll.pas @@ -107,11 +107,13 @@ EDLLImportError = class(Exception) type TDynamicDll = class(TComponent) - private + protected function IsAPIVersionStored: Boolean; function IsDllNameStored: Boolean; function IsRegVersionStored: Boolean; - procedure SetDllName(const Value: String); + procedure SetDllName(const Value: String); virtual; + procedure SetDllPath(const Value: String); virtual; + function GetDllFullFileName: String; protected FDllName : String; FDllPath : String; @@ -127,14 +129,17 @@ TDynamicDll = class(TComponent) FOnAfterLoad : TNotifyEvent; FOnBeforeUnload : TNotifyEvent; - function Import(const funcname: AnsiString; canFail : Boolean = True): Pointer; + procedure CallMapDll; virtual; + function Import(const funcname: String; canFail: Boolean = True): Pointer; + function Import2(funcname: String; args: integer=-1; canFail: Boolean = True): Pointer; procedure Loaded; override; procedure BeforeLoad; virtual; procedure AfterLoad; virtual; procedure BeforeUnload; virtual; function GetQuitMessage : String; virtual; procedure DoOpenDll(const aDllName : String); virtual; - function GetDllPath : String; + function GetDllPath : String; virtual; + procedure MapDll; virtual; abstract; public // Constructors & Destructors @@ -144,16 +149,19 @@ TDynamicDll = class(TComponent) // Public methods procedure OpenDll(const aDllName : String); function IsHandleValid : Boolean; - procedure LoadDll; + function LoadDll: Boolean; procedure UnloadDll; procedure Quit; + class function CreateInstance(DllPath: String = ''; DllName: String = ''): TDynamicDll; + class function CreateInstanceAndLoad(DllPath: String = ''; DllName: String = ''): TDynamicDll; // Public properties published property AutoLoad : Boolean read FAutoLoad write FAutoLoad default True; property AutoUnload : Boolean read FAutoUnload write FAutoUnload default True; property DllName : String read FDllName write SetDllName stored IsDllNameStored; - property DllPath : String read FDllPath write FDllPath; + property DllPath : String read FDllPath write SetDllPath; + property DllFullFileName : String read GetDllFullFileName; property APIVersion : Integer read FAPIVersion write FAPIVersion stored IsAPIVersionStored; property RegVersion : String read FRegVersion write FRegVersion stored IsRegVersionStored; property FatalAbort : Boolean read FFatalAbort write FFatalAbort default True; @@ -164,11 +172,8 @@ TDynamicDll = class(TComponent) property OnBeforeUnload : TNotifyEvent read FOnBeforeUnload write FOnBeforeUnload; end; - implementation -uses PythonEngine; - (*******************************************************) (** **) (** class TDynamicDll **) @@ -179,10 +184,12 @@ procedure TDynamicDll.DoOpenDll(const aDllName : String); begin if not IsHandleValid then begin - FDllName := aDllName; + if aDllName<>'' then + FDllName := aDllName; + SetDllDirectory(PChar(GetDllPath)); FDLLHandle := SafeLoadLibrary( {$IFDEF FPC} - PAnsiChar(AnsiString(GetDllPath+DllName)) + PAnsiChar(AnsiString(DllName)) {$ELSE} GetDllPath+DllName {$ENDIF} @@ -190,24 +197,16 @@ procedure TDynamicDll.DoOpenDll(const aDllName : String); end; end; +function TDynamicDll.GetDllFullFileName: String; +begin + Result := DllPath + DllName; +end; + function TDynamicDll.GetDllPath : String; -{$IFDEF MSWINDOWS} -var - AllUserInstall: Boolean; -{$ENDIF} begin Result := DllPath; - - {$IFDEF MSWINDOWS} - if DLLPath = '' then begin - IsPythonVersionRegistered(RegVersion, Result, AllUserInstall); - end; - {$ENDIF} - if Result <> '' then - begin Result := IncludeTrailingPathDelimiter(Result); - end; end; procedure TDynamicDll.OpenDll(const aDllName : String); @@ -250,6 +249,7 @@ constructor TDynamicDll.Create(AOwner: TComponent); FFatalAbort := True; FAutoLoad := True; FUseLastKnownVersion := True; + FDLLHandle := 0; end; destructor TDynamicDll.Destroy; @@ -259,11 +259,11 @@ destructor TDynamicDll.Destroy; inherited; end; -function TDynamicDll.Import(const funcname: AnsiString; canFail : Boolean = True): Pointer; +function TDynamicDll.Import(const funcname: String; canFail: Boolean): Pointer; var E : EDllImportError; begin - Result := GetProcAddress( FDLLHandle, PAnsiChar(funcname) ); + Result := GetProcAddress( FDLLHandle, PChar(funcname) ); if (Result = nil) and canFail then begin {$IFDEF MSWINDOWS} 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 end; end; +function TDynamicDll.Import2(funcname: String; args: integer; canFail: Boolean): Pointer; +begin + {$IFDEF WIN32} + // using STDCall name decoration + // copy paste the function names from dependency walker to notepad and search for the function name there. + if args>=0 then + funcname := '_'+funcname+'@'+IntToStr(args); + {$ENDIF} + Result := Import(funcname, canFail); +end; + procedure TDynamicDll.Loaded; begin inherited; @@ -293,9 +304,10 @@ function TDynamicDll.IsHandleValid : Boolean; {$ENDIF} end; -procedure TDynamicDll.LoadDll; +function TDynamicDll.LoadDll: Boolean; begin OpenDll( DllName ); + Result := IsHandleValid; end; procedure TDynamicDll.UnloadDll; @@ -317,6 +329,7 @@ procedure TDynamicDll.AfterLoad; begin if Assigned( FOnAfterLoad ) then FOnAfterLoad( Self ); + CallMapDll; end; procedure TDynamicDll.BeforeUnload; @@ -367,5 +380,44 @@ procedure TDynamicDll.SetDllName(const Value: String); FDllName := Value; end; +procedure TDynamicDll.SetDllPath(const Value: String); +begin + FDllPath := Value; +end; + +procedure TDynamicDll.CallMapDll; +begin + try + MapDll; + except + on E: Exception do begin + if FatalMsgDlg then +{$IFDEF MSWINDOWS} + MessageBox( GetActiveWindow, PChar(E.Message), 'Error', MB_TASKMODAL or MB_ICONSTOP ); +{$ELSE} + WriteLn( ErrOutput, E.Message ); +{$ENDIF} + if FatalAbort then Quit; + end; + end; +end; + +class function TDynamicDll.CreateInstance(DllPath, DllName: String): TDynamicDll; +begin + Result := Create(nil); + if DllPath<>'' then + Result.DllPath := DllPath; + if DllName<>'' then + Result.DllName := DllName; +end; + +class function TDynamicDll.CreateInstanceAndLoad(DllPath, DllName: String): TDynamicDll; +begin + Result := CreateInstance(DllPath, DllName); + Result.LoadDll; + if not Result.IsHandleValid then + FreeAndNil(Result); +end; + end. diff --git a/PythonForDelphi/Components/Sources/Core/PythonEngine.pas b/PythonForDelphi/Components/Sources/Core/PythonEngine.pas index d56f3549..f7333e85 100644 --- a/PythonForDelphi/Components/Sources/Core/PythonEngine.pas +++ b/PythonForDelphi/Components/Sources/Core/PythonEngine.pas @@ -1510,7 +1510,7 @@ TPythonInterface=class(TDynamicDll) FBuiltInModuleName: String; function GetInitialized: Boolean; - procedure AfterLoad; override; + function GetDllPath : String; override; function GetQuitMessage : String; override; procedure CheckPython; function GetUnicodeTypeSuffix : String; @@ -2051,7 +2051,7 @@ TPythonInterface=class(TDynamicDll) constructor Create(AOwner: TComponent); override; // Public methods - procedure MapDll; + procedure MapDll; override; // Public properties property Initialized : Boolean read GetInitialized; @@ -3293,32 +3293,22 @@ constructor TPythonInterface.Create(AOwner: TComponent); FAutoUnload := True; end; -procedure TPythonInterface.AfterLoad; -begin - inherited; - FIsPython3000 := Pos('PYTHON3', UpperCase(DLLName)) > 0; - FMajorVersion := StrToInt(DLLName[7 {$IFDEF LINUX}+3{$ENDIF}]); - FMinorVersion := StrToInt(DLLName[8{$IFDEF LINUX}+4{$ENDIF}]); - - - if FIsPython3000 then - FBuiltInModuleName := 'builtins' - else - FBuiltInModuleName := '__builtin__'; - - try - MapDll; - except - on E: Exception do begin - if FatalMsgDlg then +function TPythonInterface.GetDllPath: String; {$IFDEF MSWINDOWS} - MessageBox( GetActiveWindow, PChar(E.Message), 'Error', MB_TASKMODAL or MB_ICONSTOP ); -{$ELSE} - WriteLn( ErrOutput, E.Message ); +var + AllUserInstall: Boolean; {$ENDIF} - if FatalAbort then Quit; - end; +begin + Result := DllPath; + + {$IFDEF MSWINDOWS} + if DLLPath = '' then begin + IsPythonVersionRegistered(RegVersion, Result, AllUserInstall); end; + {$ENDIF} + + if Result <> '' then + Result := IncludeTrailingPathDelimiter(Result); end; function TPythonInterface.GetQuitMessage : String; @@ -3352,6 +3342,15 @@ function TPythonInterface.GetUnicodeTypeSuffix : String; procedure TPythonInterface.MapDll; begin + FIsPython3000 := Pos('PYTHON3', UpperCase(DLLName)) > 0; + FMajorVersion := StrToInt(DLLName[7 {$IFDEF LINUX}+3{$ENDIF}]); + FMinorVersion := StrToInt(DLLName[8{$IFDEF LINUX}+4{$ENDIF}]); + + if FIsPython3000 then + FBuiltInModuleName := 'builtins' + else + FBuiltInModuleName := '__builtin__'; + Py_DebugFlag := Import('Py_DebugFlag'); Py_VerboseFlag := Import('Py_VerboseFlag'); Py_InteractiveFlag := Import('Py_InteractiveFlag'); @@ -3760,12 +3759,12 @@ procedure TPythonInterface.MapDll; PyType_GenericAlloc :=Import('PyType_GenericAlloc'); PyType_GenericNew :=Import('PyType_GenericNew'); PyType_Ready :=Import('PyType_Ready'); - PyUnicode_FromWideChar :=Import(AnsiString(Format('PyUnicode%s_FromWideChar',[GetUnicodeTypeSuffix]))); - PyUnicode_AsWideChar :=Import(AnsiString(Format('PyUnicode%s_AsWideChar',[GetUnicodeTypeSuffix]))); - PyUnicode_Decode :=Import(AnsiString(Format('PyUnicode%s_Decode',[GetUnicodeTypeSuffix]))); - PyUnicode_AsEncodedString :=Import(AnsiString(Format('PyUnicode%s_AsEncodedString',[GetUnicodeTypeSuffix]))); - PyUnicode_FromOrdinal :=Import(AnsiString(Format('PyUnicode%s_FromOrdinal',[GetUnicodeTypeSuffix]))); - PyUnicode_GetSize :=Import(AnsiString(Format('PyUnicode%s_GetSize',[GetUnicodeTypeSuffix]))); + PyUnicode_FromWideChar :=Import(Format('PyUnicode%s_FromWideChar',[GetUnicodeTypeSuffix])); + PyUnicode_AsWideChar :=Import(Format('PyUnicode%s_AsWideChar',[GetUnicodeTypeSuffix])); + PyUnicode_Decode :=Import(Format('PyUnicode%s_Decode',[GetUnicodeTypeSuffix])); + PyUnicode_AsEncodedString :=Import(Format('PyUnicode%s_AsEncodedString',[GetUnicodeTypeSuffix])); + PyUnicode_FromOrdinal :=Import(Format('PyUnicode%s_FromOrdinal',[GetUnicodeTypeSuffix])); + PyUnicode_GetSize :=Import(Format('PyUnicode%s_GetSize',[GetUnicodeTypeSuffix])); PyWeakref_GetObject :=Import('PyWeakref_GetObject'); PyWeakref_NewProxy :=Import('PyWeakref_NewProxy'); PyWeakref_NewRef :=Import('PyWeakref_NewRef'); @@ -5039,12 +5038,12 @@ function TPythonEngine.Run_CommandAsObjectWithDict(const command : AnsiString; m procedure TPythonEngine.ExecStrings( strings : TStrings ); begin - Py_XDecRef( Run_CommandAsObject( CleanString( EncodeString(strings.Text) ), file_input ) ); + Py_XDecRef( Run_CommandAsObject( CleanString( EncodeString(strings.Text) ), file_input ) ); end; function TPythonEngine.EvalStrings( strings : TStrings ) : PPyObject; begin - Result := Run_CommandAsObject( CleanString( EncodeString(strings.Text) ), eval_input ); + Result := Run_CommandAsObject( CleanString( EncodeString(strings.Text) ), eval_input ); end; procedure TPythonEngine.ExecString(const command : AnsiString; locals, globals : PPyObject ); @@ -5054,7 +5053,7 @@ procedure TPythonEngine.ExecString(const command : AnsiString; locals, globals : procedure TPythonEngine.ExecStrings( strings : TStrings; locals, globals : PPyObject ); begin - Py_XDecRef( Run_CommandAsObjectWithDict( CleanString( EncodeString(strings.Text) ), file_input, locals, globals ) ); + Py_XDecRef( Run_CommandAsObjectWithDict( CleanString( EncodeString(strings.Text) ), file_input, locals, globals ) ); end; function TPythonEngine.EvalString( const command : AnsiString; locals, globals : PPyObject ) : PPyObject; @@ -5064,12 +5063,12 @@ function TPythonEngine.EvalString( const command : AnsiString; locals, globals : function TPythonEngine.EvalStrings( strings : TStrings; locals, globals : PPyObject ) : PPyObject; begin - Result := Run_CommandAsObjectWithDict( CleanString( EncodeString(strings.Text) ), eval_input, locals, globals ); + Result := Run_CommandAsObjectWithDict( CleanString( EncodeString(strings.Text) ), eval_input, locals, globals ); end; function TPythonEngine.EvalStringsAsStr( strings : TStrings ) : String; begin - Result := Run_CommandAsString( CleanString( EncodeString(strings.Text) ), eval_input ); + Result := Run_CommandAsString( CleanString( EncodeString(strings.Text) ), eval_input ); end; function TPythonEngine.CheckEvalSyntax( const str : AnsiString ) : Boolean;