From 55ce2e1379bdb5e05268a01ea589c809990a62e1 Mon Sep 17 00:00:00 2001 From: Idan Miara Date: Thu, 4 Feb 2021 18:14:13 +0200 Subject: [PATCH] PythonEngine.pas - Move TDynamicDLL to DynamicDll.pas * DynamicDll.pas - make GetDllPath virtual to allow override in TPythonInterface * PythonEngine.pas - GetDllPath override with a special behavior for the PythonDLL (IsPythonVersionRegistered) --- Packages/Delphi/Delphi 10.3-/Python_D.dpk | 1 + Source/DynamicDll.pas | 358 ++++++++++++++++++++++ Source/PythonEngine.pas | 287 ++--------------- 3 files changed, 377 insertions(+), 269 deletions(-) create mode 100644 Source/DynamicDll.pas diff --git a/Packages/Delphi/Delphi 10.3-/Python_D.dpk b/Packages/Delphi/Delphi 10.3-/Python_D.dpk index f28c000f..7ac2e7f5 100644 --- a/Packages/Delphi/Delphi 10.3-/Python_D.dpk +++ b/Packages/Delphi/Delphi 10.3-/Python_D.dpk @@ -52,6 +52,7 @@ requires vcl; contains + DynamicDll in '..\..\..\Source\DynamicDll.pas', MethodCallBack in '..\..\..\Source\MethodCallBack.pas', PythonEngine in '..\..\..\Source\PythonEngine.pas', WrapDelphi in '..\..\..\Source\WrapDelphi.pas', diff --git a/Source/DynamicDll.pas b/Source/DynamicDll.pas new file mode 100644 index 00000000..f5462c3e --- /dev/null +++ b/Source/DynamicDll.pas @@ -0,0 +1,358 @@ +(**************************************************************************) +(* *) +(* Module: Unit 'DynamicDLL' 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 DELPHI2010_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, + WideStrings, + MethodCallBack; + +type + EDLLImportError = class(Exception) + public + WrongFunc : AnsiString; + ErrorCode : Integer; + end; + +//------------------------------------------------------- +//-- -- +//-- Base class: TDynamicDll -- +//-- -- +//------------------------------------------------------- + +type + TDynamicDll = class(TComponent) + protected + 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; virtual; + + 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 + +(*******************************************************) +(** **) +(** class TDynamicDll **) +(** **) +(*******************************************************) + +procedure TDynamicDll.DoOpenDll(const aDllName : string); +begin + if not IsHandleValid then + begin + FDllName := aDllName; + {$IFDEF MSWINDOWS} + FDLLHandle := SafeLoadLibrary( + {$IFDEF FPC} + PAnsiChar(AnsiString(GetDllPath+DllName)) + {$ELSE} + GetDllPath+DllName + {$ENDIF}); + {$ELSE} + //Linux: need here RTLD_GLOBAL, so Python can do "import ctypes" + FDLLHandle := THandle(dlopen(PAnsiChar(AnsiString(GetDllPath+DllName)), + RTLD_LAZY+RTLD_GLOBAL)); + {$ENDIF} + end; +end; + +function TDynamicDll.GetDllPath : string; +begin + Result := DllPath; + + 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]); + {$ELSE} + 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 ); + {$ELSE} + 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; + {$IF not Defined(FPC) and not Defined(MSWINDOWS)} + S : string; + {$IFEND} +begin + {$IF Defined(FPC) or Defined(MSWINDOWS)} + Result := GetProcAddress( FDLLHandle, PAnsiChar(funcname) ); + {$ELSE} + S := string(funcname); + Result := GetProcAddress( FDLLHandle, PWideChar(S) ); + {$IFEND} + 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); +{$ELSE} + 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); + Halt( 1 ); +{$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/Source/PythonEngine.pas b/Source/PythonEngine.pas index e6cb87eb..5b69fb42 100644 --- a/Source/PythonEngine.pas +++ b/Source/PythonEngine.pas @@ -90,7 +90,8 @@ interface SysUtils, SyncObjs, Variants, - MethodCallBack; + MethodCallBack, + DynamicDll; {$IF not Defined(FPC) and (CompilerVersion >= 23)} const @@ -906,11 +907,6 @@ TPythonVersionProp = record // Components' exceptions EDLLLoadError = class(Exception); - EDLLImportError = class(Exception) - public - WrongFunc : AnsiString; - ErrorCode : Integer; - end; // Python's exceptions EPythonError = class(Exception) @@ -1120,70 +1116,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; //------------------------------------------------------- //-- -- @@ -1218,6 +1150,7 @@ TPythonInterface=class(TDynamicDll) function GetQuitMessage : string; override; procedure CheckPython; function GetUnicodeTypeSuffix : string; + function GetDllPath : string; override; public // define Python flags. See file pyDebug.h @@ -2900,42 +2833,36 @@ procedure TPythonInputOutput.UpdateCurrentThreadLine; FLinesPerThread.Strings[ GetCurrentThreadSlotIdx ] := string(FLine_Buffer); end; + (*******************************************************) (** **) -(** class TDynamicDll **) +(** class TPythonInterface **) (** **) (*******************************************************) -procedure TDynamicDll.DoOpenDll(const aDllName : string); +constructor TPythonInterface.Create(AOwner: TComponent); +var + i : Integer; begin - if not IsHandleValid then - begin - FDllName := aDllName; - {$IFDEF MSWINDOWS} - FDLLHandle := SafeLoadLibrary( - {$IFDEF FPC} - PAnsiChar(AnsiString(GetDllPath+DllName)) - {$ELSE} - GetDllPath+DllName - {$ENDIF}); - {$ELSE} - //Linux: need here RTLD_GLOBAL, so Python can do "import ctypes" - FDLLHandle := THandle(dlopen(PAnsiChar(AnsiString(GetDllPath+DllName)), - RTLD_LAZY+RTLD_GLOBAL)); - {$ENDIF} - end; + inherited; + FInitialized := False; + i := COMPILED_FOR_PYTHON_VERSION_INDEX; + DllName := PYTHON_KNOWN_VERSIONS[i].DllName; + FAPIVersion := PYTHON_KNOWN_VERSIONS[i].APIVersion; + FRegVersion := PYTHON_KNOWN_VERSIONS[i].RegVersion; + FAutoUnload := True; end; -function TDynamicDll.GetDllPath : string; +function TPythonInterface.GetDllPath: string; {$IFDEF MSWINDOWS} var AllUserInstall: Boolean; {$ENDIF} begin - Result := DllPath; + Result := FDllPath; {$IFDEF MSWINDOWS} - if DLLPath = '' then begin + if Result = '' then begin IsPythonVersionRegistered(RegVersion, Result, AllUserInstall); end; {$ENDIF} @@ -2946,184 +2873,6 @@ function TDynamicDll.GetDllPath : string; 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]); - {$ELSE} - 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 ); - {$ELSE} - 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; - {$IF not Defined(FPC) and not Defined(MSWINDOWS)} - S : string; - {$IFEND} -begin - {$IF Defined(FPC) or Defined(MSWINDOWS)} - Result := GetProcAddress( FDLLHandle, PAnsiChar(funcname) ); - {$ELSE} - S := string(funcname); - Result := GetProcAddress( FDLLHandle, PWideChar(S) ); - {$IFEND} - 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); -{$ELSE} - 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); - Halt( 1 ); -{$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; - - -(*******************************************************) -(** **) -(** class TPythonInterface **) -(** **) -(*******************************************************) - -constructor TPythonInterface.Create(AOwner: TComponent); -var - i : Integer; -begin - inherited; - FInitialized := False; - i := COMPILED_FOR_PYTHON_VERSION_INDEX; - DllName := PYTHON_KNOWN_VERSIONS[i].DllName; - FAPIVersion := PYTHON_KNOWN_VERSIONS[i].APIVersion; - FRegVersion := PYTHON_KNOWN_VERSIONS[i].RegVersion; - FAutoUnload := True; -end; - procedure TPythonInterface.AfterLoad; begin inherited;