Reset Python4Delphi engine? - delphi

I use D7 with Python4Delphi. After users have imported much of py-files, Python have all these modules cached. I need a way to reset Py engine. So that Py "forgets" all user-imported modules, and I have "clean" Python, w/out restarting the app.
How to do it?

There is a demo showing you how to unload/reload python using P4D at https://github.com/pyscripter/python4delphi/tree/master/PythonForDelphi/Demos/Demo34. The key method that (re)creates the python components and (re)loads different versions of python is shown below:
procedure TForm1.CreatePythonComponents;
begin
if cbPyVersions.ItemIndex <0 then begin
ShowMessage('No Python version is selected');
Exit;
end;
// Destroy P4D components
FreeAndNil(PythonEngine1);
FreeAndNil(PythonType1);
FreeAndNil(PythonModule1);
{ TPythonEngine }
PythonEngine1 := TPythonEngine.Create(Self);
PyVersions[cbPyVersions.ItemIndex].AssignTo(PythonEngine1);
PythonEngine1.IO := PythonGUIInputOutput1;
{ TPythonModule }
PythonModule1 := TPythonModule.Create(Self);
PythonModule1.Name := 'PythonModule1';
PythonModule1.Engine := PythonEngine1;
PythonModule1.ModuleName := 'spam';
with PythonModule1.Errors.Add do begin
Name := 'PointError';
ErrorType := etClass;
end;
with PythonModule1.Errors.Add do begin
Name := 'EBadPoint';
ErrorType := etClass;
ParentClass.Name := 'PointError';
end;
{ TPythonType }
PythonType1 := TPythonType.Create(Self);
PythonType1.Name := 'PythonType1';
PythonType1.Engine := PythonEngine1;
PythonType1.OnInitialization := PythonType1Initialization;
PythonType1.TypeName := 'Point';
PythonType1.Prefix := 'Create';
PythonType1.Services.Basic := [bsRepr,bsStr,bsGetAttrO,bsSetAttrO];
PythonType1.TypeFlags :=
[tpfHaveGetCharBuffer,tpfHaveSequenceIn,tpfHaveInplaceOps,
tpfHaveRichCompare,tpfHaveWeakRefs,tpfHaveIter,tpfHaveClass,tpfBaseType];
PythonType1.Module := PythonModule1;
PythonEngine1.LoadDll;
end;
The demo uses the unit PythonVersions to discover installed python versions.

It should be sufficient to destroy and re-create the TPythonEngine object:
OriginalOwner := GetPythonEngine.Owner;
GetPythonEngine.Free;
TPythonEngine.Create(OriginalOwner);
Destroying it calls Py_Finalize, which frees all memory allocated by the Python DLL.
Or, if you're just using the Python API without the VCL wrappers, you can probably just call Py_NewInterpreter on your TPythonInterface object to get a fresh execution environment without necessarily discarding everything done before.

Related

RemObjects leaks detected after calling manually created service instance

I have the following code which creates an instance of an RemObjects service and makes a call to a .net server
class function TLabelPrintingServiceProxy.GetInstance: ILabelPrintingManager;
var
LRoRemoteService: TRoRemoteService;
begin
LRoRemoteService := TRoRemoteService.Create(nil);
LRoRemoteService.Message := TROSOAPMessage.Create();
LRoRemoteService.Channel := TROIndyHTTPChannel.Create(nil);
LRoRemoteService.Channel.TargetUri := TROUri.Create(ILabelPrintingIntf.LabelPrintingManager_EndPointURI);
Result := (LRoRemoteService as ILabelPrintingManager);
end;
call to the .net service is performed like this:
try
Result := BinaryArray.Create;
LLabelPrintingManager := TLabelPrintingServiceProxy.GetInstance();
Result.Add(LLabelPrintingManager.GetVSSLabelImage(APrintJob));
finally
TLabelPrintingServiceProxy.ReleaseLabelPrintingServiceProxyInstance(LLabelPrintingManager);
end;
After the call is made the LLabelPrintingManager interface should be released automatically by RemObjects, but it isn't and leaks the objects used.
I've tried on the ReleaseLabelPrintingServiceProxyInstance (code bellow) to release manually all the objects from the service instance, but it's still leaking
class procedure TLabelPrintingServiceProxy.ReleaseLabelPrintingServiceProxyInstance(aILabelPrintingManagerIntf: ILabelPrintingManager);
var
lProxy: TRoProxy;
begin
lProxy := TROProxy(aILabelPrintingManagerIntf);
TROIndyHTTPChannel(lProxy.__TransportChannel).TargetUri.Free;
// TROIndyHTTPChannel(lProxy.__TransportChannel).Free; this is generating an AV
TRoMessage(lProxy.__Message).free;
TRoRemoteService(aILabelPrintingManagerIntf).Free;
I'm missing something?
After discussing with guys from RemObjects, here is the solution:
class function TLabelPrintingServiceProxy.GetRemoteServiceInstance: TRoRemoteService;
var
LRoRemoteService: TRoRemoteService;
begin
Result := TRoRemoteService.Create(nil);
Result.Message := TROSOAPMessage.Create();
Result.Channel := TROIndyHTTPChannel.Create(nil);
Result.Channel.TargetUri := TROUri.Create(ILabelPrintingIntf.LabelPrintingManager_EndPointURI);
end;
call
try
LLabelPrintingRemoteService := TLabelPrintingServiceProxy.GetRemoteServiceInstance();
(LLabelPrintingRemoteService as ILabelPrintingManager).PrintVSSJob(printJob);
finally
TLabelPrintingServiceProxy.ReleaseLabelPrintingServiceProxyInstance(LLabelPrintingRemoteService);
end;
and releasing the objects
try
LLabelPrintingRemoteService := TLabelPrintingServiceProxy.GetRemoteServiceInstance();
(LLabelPrintingRemoteService as ILabelPrintingManager).PrintVSSJob(printJob);
finally
TLabelPrintingServiceProxy.ReleaseLabelPrintingServiceProxyInstance(LLabelPrintingRemoteService);
end;

TDirectoryWatch not firing first time

I have a small application that is used to process some files made in another program.
I use an older component by Angus Johnson called TDirectoryWatch
On my FormCreate I have the following code
DirectoryWatch := TDirectoryWatch.Create(self);
DirectoryWatch.OnChange := FileAction;
DirectoryWatch.Directory := Folders.Path(dirInput);
DirectoryWatch.Active := True;
If the program is started and there is put a new file in the directory everything fires and runs OK.
But if there is a file in the directory when the program is started nothing happens even if I make a call to FileAction(nil);
FileAction is the name of the procedure that handles the files
I have a call to FileAction from a popupmenu and that handles the files in the directory
So my question is: how to make sure that existing files are handled at program start?
Or is there a better way to handle this problem.
Added code for FileAction
procedure TfrmMain.FileAction(Sender: TObject);
var
MailFile: string;
MailInfo: TMailInfo;
ListAttachments: TstringList;
i: integer;
MailBody: string;
begin
for MailFile in TDirectory.GetFiles(Folders.Path(dirInput), CheckType) do
begin
if FileExists(MailFile) then
begin
MailInfo := TMailInfo.Create(MailFile);
try
if FileProcessing = False then
begin
Logfile.Event('Behandler fil: ' + MailFile);
FileProcessing := True;
MailBody := '';
Settings.Load;
MailInfo.Load;
Settings.Mail.Signature := '';
Settings.Mail.Subject := MailInfo.Subject;
ListAttachments := TStringList.Create;
ListAttachments.Clear;
for i := 1 to MaxEntries do
begin
if (MailInfo.Attachment[i] <> '') and (FileExists(MailInfo.Attachment[i])) then
ListAttachments.Add(MailInfo.Attachment[i]);
end;
for i := 1 to MaxEntries do
begin
MailBody := MailBody + MailInfo.MailBody[i];
end;
try
if MailBody <> '' then
begin
if MailInfo.SenderBcc then
Mailing.Send(MailInfo.SenderMail, MailInfo.Recipient, MailInfo.SenderMail, MailInfo.Subject, MailBody, ListAttachments, True)
else
Mailing.Send(MailInfo.SenderMail, MailInfo.Recipient, MailInfo.Subject, MailBody, ListAttachments, True);
end;
finally
ListAttachments.Free;
end;
FileProcessing := False;
DeleteFile(MailFile);
end;
finally
MailInfo.Free;
end;
end;
end;
end;
The component doesn't notify about changes when your program starts up because at the time your program starts, there haven't been any changes yet.
Your policy appears to be that at the time your program starts up, all existing files are to be considered "new" or "newly changed," so your approach of manually calling the change-notification handler is correct.
The only thing the component does when it detects a change is to call the change-notification handler. If you explicitly call that function, and yet you still observe that "nothing happens," then there are more deep-seated problems in your program that you need to debug; it's not an issue with the component or with the basic approach described here.

Programmatically adding columns to a TdxDBGrid (Expressquantumgrid by Devexpress)

With a customer I'm stuck developing for this very old version (2.1) of ExpressQuantumGrid by DevExpress. In Delphi 4. I can't find any documentation about it.
Basically I just need to create a bunch of TdxDBGridMaskColumn and "insert" them into the grid (TdxDBGrid) at runtime. From the code completion pop-up I can't figure out how.
Thanks!
We have an old app that uses Delphi 5 and DevExpress v3, the code might not be identical but should get you started.
A function that can create a column of any type (TdxDBDateColumn for example):
function CreateColumn(const aField: string; aColClass: TdxDBTreeListColumnClass): TdxDBTreeListColumn;
var
begin
Result := dxGrid.CreateColumn(aColClass);
Result.Name := dxGrid.Name + aField;
TdxDBGridColumn(Result).DisableFilter := True;
TdxDBGridColumn(Result).DisableGrouping := True;
TdxDBGridColumn(Result).Alignment := taRightJustify;
TdxDBGridColumn(Result).FieldName := aField;
TdxDBGridColumn(Result).Caption := aField;
TdxDBGridColumn(Result).Width := 70;
end;
Then you can call this function like so:
NewColumn := CreateColumn('Username', TdxDBGridColumn);

How can my program tell if Delphi is running?

I've heard that some custom component authors use an RTL routine that checks to see if Delphi is running in order to set up shareware restrictions. Does anyone know what this routine is? Checking obvious names like "DelphiRunning" or "IsDelphiRunning" doesn't turn up anything useful.
There are 2 different ideas here:
- Delphi is up and running
- The application is running under the debugger
The common way to test if Delphi is running is to check the presence of known IDE Windows which have a specific classname like TAppBuilder or TPropertyInspector.
Those 2 works in all version of Delphi IIRC.
If you want to know if your application is running under the debugger, i.e. launched normally from the IDE with "Run" (F9) or attached to the debugger while already running, you just have to test the DebugHook global variable.
Note that "Detach from program" does not remove the DebugHook value, but "Attach to process" sets it.
function IsDelphiRunning: Boolean;
begin
Result := (FindWindow('TAppBuilder', nil) > 0) and
(FindWindow('TPropertyInspector', 'Object Inspector') > 0);
end;
function IsOrWasUnderDebugger: Boolean;
begin
Result := DebugHook <> 0;
end;
If the goal is to restrict the use of a trial version of your component to when the application is being developped, both have flaws:
- Hidden windows with the proper Classname/Title can be included in the application
- DebugHook can be manually set in the code
You can use DebugHook <> 0 from your component code. DebugHook is a global variable (IIRC, it's in the Systems unit) that's set by the Delphi/RAD Studio IDE, and couldn't be set from anywhere else.
There are other techniques (FindWindow() for TAppBuilder, for instance), but DebugHook takes all of the work out of it.
This is a code snippet from www.delphitricks.com/source-code/misc/check_if_delphi_is_running.html.
function WindowExists(AppWindowName, AppClassName: string): Boolean;
var
hwd: LongWord;
begin
hwd := 0;
hwd := FindWindow(PChar(AppWindowName), PChar(AppClassName));
Result := False;
if not (Hwd = 0) then {window was found if not nil}
Result := True;
end;
function DelphiLoaded: Boolean;
begin
DelphiLoaded := False;
if WindowExists('TPropertyInspector', 'Object Inspector') then
if WindowExists('TMenuBuilder', 'Menu Designer') then
if WindowExists('TAppBuilder', '(AnyName)') then
if WindowExists('TApplication', 'Delphi') then
if WindowExists('TAlignPalette', 'Align') then
DelphiLoaded := True;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if DelphiLoaded then
begin
ShowMessage('Delphi is running');
end;
end;
function DelphiIsRunning: Boolean;
begin
Result := DebugHook <> 0;
end;

How to make Delphi DUnit test fail when TSQLConnection.Connected = true

When using Delphi IDE, it will silently change SQLConnection.Connected to "true" when populating field or table lists in various properties.
Since I don't want to release with Connected = true, I need my dunit test to fail when TSQLConnection.Connected is left true in dfm.
GExperts has a "Set Component Properties" expert that we configure to close database connections on every compile. Since doing that, we have not had the problem.
You could write your own descendant of TSQLConnection that does not store its Connected property:
TdzAdoConnection = class(TADOConnection)
published
property Connected stored false;
end;
and use that component rather than TSqlConnection.
(The above is for TAdoConnection, but TSQLConnection should also work fine.)
I solve this in another way. I wrote a little utility that loads a DFM file, and looks for properties that should not be present. Including the database.connected = true values.
This can be modified to work with any appropriate properties. I have put the core of the code here too.
To make this really useful, you should use this utility in your build script (I use FinalBuilder). My script starts by looping on .dfm files, stripping any of these properties, and then it compiles and runs the unit tests. If they pass, then it continutes to build the main application. To me, this is a better way than having a unit test fail, as you can start off from a guaranteed known good point.
nState := 0;
bFound := False;
for nFileLoop := 0 to memoFile.Lines.Count - 1 do
begin
szLine := memoFile.Lines[nFileLoop];
case nState of //
0:
begin
if(0 <> Pos('TADOConnection', szLine)) then
begin
szSeeking := 'Connected';
nState := 1;
end
else if(0 <> Pos('TADOTable', szLine)) then
begin
szSeeking := 'Active';
nState := 1;
end
else if(0 <> Pos('TADOQuery', szLine)) then
begin
szSeeking := 'Active';
nState := 1;
end
else if(0 <> Pos('TDBISAMTable', szLine)) then
begin
szSeeking := 'Active';
nState := 1;
end
else if(0 <> Pos('TDBISAMDatabase', szLine)) then
begin
szSeeking := 'Connected';
nState := 1;
end
else if(0 <> Pos('TDBISAMSession', szLine)) then
begin
szSeeking := 'Active';
nState := 1;
end
else if(0 <> Pos('TDBISAMQuery', szLine)) then
begin
szSeeking := 'Active';
nState := 1;
end;
end;
1 :
begin
bFound := True;
if(0 <> Pos('end', szLine)) then
begin
nState := 0;
end
else if(0 <> Pos(szSeeking, szLine)) then
begin
nPos := Pos('=', szLine);
if nPos > 0 then
begin
memoFile.Lines[nFileLoop] := Copy(szLine, 1, nPos) + ' False';
end;
end;
end;
end; // case
end;
OpenCTF - Component Test Framework for Delphi might be interesting, it automatically creates unit tests for specified properties of all components in all forms / datamodules. It is Open source and easy to use.
"Getting Started" document: http://www.habarisoft.com/download/OpenCTFGettingStarted.pdf
The OpenCTF component test framework
helps to build automatic tests for all
(visual and non-visual) VCL components
in a Delphi application. It is based
on the DUnit framework.
Some usage examples:
detect missing or wrong property values - e.g. Buttons without assigned Actions, DataSources without associated DataSet
detect unassigned event handlers - e.g. missing OnExecute event
check that all DataSets can be opened
check the tab order
find invisible components (e.g. invisible TabSheets which better should be hidden at runtime)
OpenCTF http://www.mikejustin.com/images/OpenCTF.gif
Another approach to this problem is to implement a pre-commit hook into your SCM. I use TortoiseSVN, and I've done similar things to prevent things from sneaking in. For example, we have a "skins" library that tries to add about a dozen skin units to any form that you open in the IDE. (We've got a registry patch that "fixes" this behavior, but it gets "un-done" every once in a while, if a developer re-installs components). So I've got a "banned strings list" in a .ini file that is in a SVN pre-commit hook.
In our environment, all production code is built on a dedicated "build machine", so if code doesn't get checked-in, it doesn't make it into the build. Problem solved.

Resources