I have an app that has returned an error report. The app is written in Delphi 2006 and hangs during startup. The MadExcept main thread stack is shown below. I suspect there is no default printer but I can't replicate the fault here.
Anyone seen this problem?
Initialization part of unit WWPrintToPrinterOrPDFRoutines
initialization
PagesRangeStartPage := 1 ;
PagesRangeEndPage := 999 ;
PrintRange := prAll ;
PrintCopies := 1 ;
PrintCollate := false ;
InitialPrintPaperName := 'A4' ;
if (Printer.Printers.Count = 0) then // <--------- this causes the hang
begin
InitialPrintOrientation := Printers.poPortrait ;
end
else
begin
InitialPrintOrientation := GetDefaultPrinterOrientation ;
InitialPrintPaperName := GetDefaultPrinterPaperName ;
end ;
CurrentPreviewPage := 1 ;
NDRMemoryStream := TMemoryStream.Create ;
or disassembled:
WWPrintToPrinterOrPDFRoutines.pas.682: PagesRangeStartPage := 1 ;
007C4404 C705EC8B81000100 mov [$00818bec],$00000001
WWPrintToPrinterOrPDFRoutines.pas.683: PagesRangeEndPage := 999 ;
007C440E C705F08B8100E703 mov [$00818bf0],$000003e7
WWPrintToPrinterOrPDFRoutines.pas.684: PrintRange := prAll ;
007C4418 C605F48B810001 mov byte ptr [$00818bf4],$01
WWPrintToPrinterOrPDFRoutines.pas.685: PrintCopies := 1 ;
007C441F C705F88B81000100 mov [$00818bf8],$00000001
WWPrintToPrinterOrPDFRoutines.pas.686: PrintCollate := false ;
007C4429 C605FC8B810000 mov byte ptr [$00818bfc],$00
WWPrintToPrinterOrPDFRoutines.pas.687: InitialPrintPaperName := 'A4' ;
007C4430 B8288C8100 mov eax,$00818c28
007C4435 BAC0447C00 mov edx,$007c44c0
007C443A E82D1AC4FF call #LStrAsg
WWPrintToPrinterOrPDFRoutines.pas.689: if (Printer.Printers.Count = 0) then
007C443F E8B0BCCDFF call Printer
007C4444 E89FB7CDFF call TPrinter.GetPrinters <----- HANG OCCURS HERE
I don't think there is anything wrong with your program or anything you could change to make this not hang. Something is wrong on the OS level with that system.
That NdrClientCall2 function is part of the Remote Procedure Call Network Data Representation Engine which is used for making RPC and DCOM calls.
NtConnectPort is a function to connect a port object (that's a fundamental kernel object, like e.g. a mutex or a file handle). Ports are used by windows at the lowest level for LPCs.
A call to NtConnectPort will block until the server called NtCompleteConnectPort (there is no timeout handling for calls to NtConnectPort).
So your problem is that winspool.drv tries to establish an LPC connection to another process on the same machine (my guess would be spoolsv.exe, the printer spooler service, but it's impossible to tell from the information provided) and this other process has created a port (NtCreatePort) but has either not called NtListenPort on it, or when NtListenPort returns does not call NtAcceptConnectPort and NtCompleteConnectPort on it. Which prevents the call to NtConnectPort in your process from every returning.
So the real problem is outside of your process, in whatever process the other side of the port belongs to.
Related
In old Delphi applications which use the old and deprecated but still used BDE database engine with Paradox database files residing on a Windows 10 computer that's updated to the 1803 "Spring Creators Update" version, but the client computers using any older version of Windows like Windows 10 1709 or Windows 7, opening a Paradox table sometimes fails with a "No more files" error, idapi32.dll error code DBIERR_OSENMFILE. This raises a EDBEngineError exception in DBTables.pas / TTable.GetHandle(), which is called by TTable.CreateHandle, called by TBDEDataSet.OpenCursor().
The error seems to be caused by some file-sharing related changes in the Windows 10 1803 update. Removing the 1803 update from the file-sharing Windows 10 computer, or updating all the client computers to Windows 10 + 1803 seems to make the error go away.
People have speculated that the changes have something to do with the SMB protocol, maybe Windows Defender and/or other security related issues. Here's a Google Plus discussion
https://plus.google.com/106831056534874810288/posts/F4nsoTz2pDi
How could the "No more files" error be worked around by some reasonably easily doable changes in the Delphi application, while allowing the file-sharing client and server computers to keep using heterogeneous Windows versions?
Please try to refrain from answering or commenting self-evident things like "the sky is blue" or "BDE is old and deprecated". Keeping BDE is a decision that cannot be changed, certainly not as a "bug fix".
As an emergency fix, we have resorted to simply re-trying DbiOpenTable, when it returns the DBIERR_OSENMFILE error code. I posted an answer with source code to the idapi32.dll hack. So far it seems that if the first DbiOpenTable says "No more files", the second try succeeds, and the application works without noticing anything.
WARNING: what follows is a hack. A kludge. Band-aid, glue, duct tape and chewing gum. BDE is old. You are completely on your own if you use BDE and/or if you try this hack. I accept no responsibility over its use. If it works for you, good for you. If it ruins your business, bad for you.
Since the Paradox tables still mostly worked and the error seemed to be slightly randomly triggered, and since someone suspected Windows Defender having something to do with it, I thought maybe it just needs some kicking around. If DbiOpenTable() suddenly starts sometimes failing over a certain combination of SMB client/server versions, because "No more files" ... then why not just try the file operation again. I put an "if it returns a DBIERR_OSENMFILE error, then Sleep() and try again" logic around the DbiOpenTable function, and guess what - it seemed to work.
Hacking around the BDE's "features" is familiar to anyone who has to maintain BDE based applications. So I made a patching hook around idapi32.dll's DbiOpenTable function, starting from an old routine written by Reinaldo Yañez originally to fix the "insufficient disk space" error with BDE when the free disk space is at a 4 GB boundary. See https://cc.embarcadero.com/Item/21475
To use this, add Fix1803 in a uses clause, and call PatchBDE somewhere before starting to open Paradox tables. Maybe call UnPatchBDE when you're done, though I don't think that's necessary.
But remember, you're on your own, and this is highly experimental code.
unit Fix1803;
// * KLUDGE WARNING *
// Patch (hack) idapi32.dll DbiOpenTable() to try harder, to work with Windows 10 1803 "Spring Creators Update".
//
// The patching routine is an extension of code originally written by Reinaldo Yañez.
// see https://cc.embarcadero.com/Item/21475
//
// Some original Spanish comments are left in place.
interface
procedure PatchBDE;
procedure UnPatchBDE;
implementation
uses
Windows, Db, DbTables, BDE, SysUtils;
// ------------------------------------------- DbiOpenTable hook
var DbiOpenTable_address_plus_9 : Pointer;
function Actual_DbiOpenTable_CallStub(hDb: hDBIDb; pszTableName: PChar; pszDriverType: PChar; pszIndexName: PChar; pszIndexTagName: PChar; iIndexId: Word; eOpenMode: DBIOpenMode; eShareMode: DBIShareMode; exltMode: XLTMode; bUniDirectional: Bool; pOptParams: Pointer; var hCursor: hDBICur): DBIResult stdcall; assembler;
asm
// these two instructions are implicitly contained in the start of the function
// push ebp
// mov ebp, esp
add esp, $fffffee8
jmp dword ptr [DbiOpenTable_address_plus_9]
end;
function LogHook_DbiOpenTable (hDb: hDBIDb; pszTableName: PChar; pszDriverType: PChar; pszIndexName: PChar; pszIndexTagName: PChar; iIndexId: Word; eOpenMode: DBIOpenMode; eShareMode: DBIShareMode; exltMode: XLTMode; bUniDirectional: Bool; pOptParams: Pointer; var hCursor: hDBICur): DBIResult stdcall;
var
i : Integer;
begin
Result := Actual_DbiOpenTable_CallStub(hDb, pszTableName, pszDriverType, pszIndexName, pszIndexTagName, iIndexId, eOpenMode, eShareMode, exltMode, bUniDirectional, pOptParams, hCursor);
// if we got the "No more files" error, try again... and again.
i := 1;
while (Result = DBIERR_OSENMFILE) and (i < 10) do
begin
Windows.Sleep(i);
Result := Actual_DbiOpenTable_CallStub(hDb, pszTableName, pszDriverType, pszIndexName, pszIndexTagName, iIndexId, eOpenMode, eShareMode, exltMode, bUniDirectional, pOptParams, hCursor);
Inc(i);
end;
end;
// ------------------------------------------- Patching routines
const // The size of the jump instruction written over the start of the original routine is 5 bytes
NUM_BYTES_OVERWRITTEN_BY_THE_PATCH = 5;
type
TRYPatch = record
OrgAddr: Pointer;
OrgBytes: array[0..NUM_BYTES_OVERWRITTEN_BY_THE_PATCH-1] of Byte;
end;
procedure TRYPatch_Clear(var ARYPatch : TRYPatch);
begin
FillChar(ARYPatch, SizeOf(TRYPatch), 0);
end;
function RedirectFunction(OldPtr, NewPtr, CallOrigStub : Pointer; var OriginalRoutineAddressPlusN: Pointer; NumBytesInCompleteInstructionsOverwritten : Integer): TRYPatch;
type
PPtr=^pointer;
PPPtr=^PPtr;
TByteArray=array[0..maxint-1] of byte;
PByteArray=^TByteArray;
function SameBytes(Ptr1, Ptr2 : Pointer; NumBytes : Integer) : Boolean;
var
i : Integer;
begin
Result := true;
i := 0;
while (Result) and (i < NumBytes) do
begin
Result := Result and ((PByteArray(Ptr1)^[i] = PByteArray(Ptr2)^[i]));
Inc(i);
end;
end;
var
PatchingAddress : Pointer;
OldProtect,
Protect : DWORD;
p: PByteArray;
i : Integer;
begin
PatchingAddress := OldPtr;
if PWord(PatchingAddress)^ = $25FF then
begin {Es un JMP DWORD PTR [XXXXXXX](=> Esta utilizando Packages)}
p := PatchingAddress;
PatchingAddress := (PPPtr(#p[2])^)^; // PatchingAddress now points to the start of the actual original routine
end;
// Safety check (as if this thing was "safe"). The given replacement routine must start with the same bytes as the replaced routine.
// Otherwise something is wrong, maybe a different version of idapi32.dll or something.
if (CallOrigStub <> nil) and not SameBytes(PatchingAddress, CallOrigStub, NumBytesInCompleteInstructionsOverwritten) then
raise Exception.Create('Will not redirect function, original call stub doesn''t match.');
// Change memory access protection settings, so we can change the contents
VirtualProtect(PatchingAddress, NUM_BYTES_OVERWRITTEN_BY_THE_PATCH, PAGE_READWRITE, #OldProtect);
// Save the old contents of the first N bytes of the routine we're hooking
Result.OrgAddr := PatchingAddress; // Save the address of the code we're patching (which might not be the same as the original OldPtr given as parameter)
for i := 0 to NUM_BYTES_OVERWRITTEN_BY_THE_PATCH-1 do
result.OrgBytes[i] := PByte(Integer(PatchingAddress) + i)^;
// Replace the first bytes of the original function with a relative jump to the new replacement hook function
// First write the instruction opcode, $E9 : JMP rel32
PByte(PatchingAddress)^:= $E9;
// Then write the instruction's operand: the relative address of the new function
PInteger(Integer(PatchingAddress)+1)^ := Integer(NewPtr) - Integer(PatchingAddress) - 5;
// Address to jump to, for the replacement routine's jump instruction
OriginalRoutineAddressPlusN := Pointer(Integer(PatchingAddress) + NumBytesInCompleteInstructionsOverwritten);
// Restore the access protection settings
VirtualProtect(PatchingAddress, NUM_BYTES_OVERWRITTEN_BY_THE_PATCH, OldProtect, #Protect);
FlushInstructionCache(GetCurrentProcess, PatchingAddress, NUM_BYTES_OVERWRITTEN_BY_THE_PATCH);
end;
procedure RestorePatch(RestorePatch: TRYPatch);
var
OldProtect,
Protect : DWORD;
OldPtr: Pointer;
i : Integer;
begin
OldPtr := RestorePatch.OrgAddr;
VirtualProtect(OldPtr, NUM_BYTES_OVERWRITTEN_BY_THE_PATCH, PAGE_READWRITE, #OldProtect);
for i := 0 to NUM_BYTES_OVERWRITTEN_BY_THE_PATCH-1 do
PByte(Integer(OldPtr) + i)^ := RestorePatch.OrgBytes[i];
VirtualProtect(OldPtr, NUM_BYTES_OVERWRITTEN_BY_THE_PATCH, OldProtect, #Protect);
FlushInstructionCache(GetCurrentProcess, OldPtr, NUM_BYTES_OVERWRITTEN_BY_THE_PATCH);
end;
var
idapi32_handle: HMODULE;
Patch_DbiOpenTable : TRYPatch;
procedure PatchBDE;
begin
if idapi32_handle <> 0 then Exit; // already_patched
idapi32_handle := LoadLibrary('idapi32');
if idapi32_handle <> 0 then
begin
Patch_DbiOpenTable := RedirectFunction(GetProcAddress(idapi32_handle, 'DbiOpenTable'), #LogHook_DbiOpenTable, #Actual_DbiOpenTable_CallStub, DbiOpenTable_address_plus_9, 9);
end;
end;
procedure UnPatchBDE;
begin
if idapi32_handle <> 0 then
begin
{Leave everything as before, just in case...}
if Patch_DbiOpenTable.OrgAddr <> nil then
RestorePatch(Patch_DbiOpenTable);
FreeLibrary(idapi32_handle);
idapi32_handle := 0;
end;
end;
initialization
idapi32_handle := 0;
TRYPatch_Clear(Patch_DbiOpenTable);
end.
VMWare, Virtual Box, etc to virtualize an Windows 7. If, as you say, W7 work flawlessly that would solve the problem.
I'm developing a program in Delphi 2010 that has to save the logs that are stored in a Tmemo. I'm trying to create a log file for everyday in which I append the logs from a memo.After I append the text I clear the content of the memo. So in the location of my app i want to create a folder named "loguri-mover_ftp" in which i want to store the log file. EX: log_mover-ftp_2-16-2015.txt
The code I use for this is:
If DirectoryExists(ExtractFilePath(Application.ExeName) + 'loguri-mover_ftp') then
begin
TFile.AppendAllText(ExtractFilePath(Application.ExeName) + 'loguri-mover_ftp\log_mover-ftp_' + datetostr(now) + '.txt',memo_loguri.lines.text, TEncoding.UTF8);
Memo_loguri.lines.text:='';
end
else
begin
CreateDir(ExtractFilePath(Application.ExeName) + 'loguri-mover_ftp');
TFile.AppendAllText(ExtractFilePath(Application.ExeName) + 'loguri-mover_ftp\log_mover-ftp_' + datetostr(now) + '.txt',memo_loguri.lines.text, TEncoding.UTF8);
Memo_loguri.lines.text:='';
end;
Because I'm interested in the stability of my application I've enabled the MadExcept debugger inside my app. After 2 hours 12 minutes i get the following error:
exception class : EDirectoryNotFoundException
exception message : The specified path was not found.
compiled with : Delphi 2010
program up time : 2 hours 12 minutes
madExcept version : 4.0.7
callstack crc : $bed2c7c0, $c58f696b, $05cb237f
count : 5
exception number : 1
disassembling:
[...]
005ce40a push eax
005ce40b call -$13ee30 ($48f5e0) ; SysUtils.TEncoding.GetUTF8
005ce410 mov ecx, eax
005ce412 pop eax
005ce413 pop edx
005ce414 > call -$1144ad ($4b9f6c) ; IOUtils.TFile.AppendAllText
005ce419 775 mov eax, [ebp+8]
005ce41c mov eax, [eax+$2a0]
005ce422 xor edx, edx
005ce424 mov ecx, [eax]
005ce426 call dword ptr [ecx+$2c]
[...]
What am I doing wrong?
The exception is raised by the call to AppendAllText. If you follow the source for that function you will find a call to InternalCheckFilePathParam, the implementation of which looks like this:
class procedure TFile.InternalCheckFilePathParam(const Path: string;
const FileExistsCheck: Boolean);
begin
if (Length(Path) >= MAX_PATH - TFile.FCMinFileNameLen) and
(not TPath.IsExtendedPrefixed(Path)) then
raise EPathTooLongException.CreateRes(#SPathTooLong);
if not TPath.HasPathValidColon(Path) then
raise ENotSupportedException.CreateRes(#SPathFormatNotSupported);
if Trim(Path) = '' then // DO NOT LOCALIZE
raise EArgumentException.CreateRes(#SInvalidCharsInPath);
if not TPath.HasValidPathChars(Path, False) then
raise EArgumentException.CreateRes(#SInvalidCharsInPath);
if not TDirectory.Exists(TPath.DoGetDirectoryName(TPath.DoGetFullPath(Path))) then
raise EDirectoryNotFoundException.CreateRes(#SPathNotFound);
if FileExistsCheck and (not Exists(Path)) then
raise EFileNotFoundException.CreateRes(#SFileNotFound);
end;
Now, Path is the first argument that you passed to AppendAllText. Since EDirectoryNotFoundException is being raised, we can conclude that the directory containing Path does not exist.
Of course, this seems odd give that you check for its existence and then create it. I think the mystery can be solved by looking at what datetostr(now) returns. You imagine that the date separator used is -. But what if the date separator is /? In that case the / will be interpreted as a path delimiter.
The solution is to specify the date separator explicitly by using the DateToStr overload that accepts a TFormatSettings parameter.
I also cannot ignore the duplication in your code. Please don't ever repeat magic strings the way you do. The code should look like this:
LogFileDir := TPath.Combine(ExtractFilePath(Application.ExeName), 'loguri-mover_ftp');
if not DirectoryExists(LogFileDir) then
ForceDirectories(LogFileDir);
DateStr := DateToStr(Now, ...); // you supply an appropriate TFormatSettings
LogFilePath := TPath.Combine(LogFileDir, log_mover-ftp_' + DateStr + '.txt');
TFile.AppendAllText(LogFilePath, memo_loguri.lines.text, TEncoding.UTF8);
I have a small piece of code that checks if a computer is alive by pinging it. We use to have a room with 40 computer and I wanna check remotely through my program which on is alive.
Therefore I wrote a little ping function using indy
function TMainForm.Ping(const AHost : string) : Boolean;
var
MyIdIcmpClient : TIdIcmpClient;
begin
Result := True;
MyIdIcmpClient := TIdIcmpClient.Create(nil);
MyIdIcmpClient.ReceiveTimeout := 200;
MyIdIcmpClient.Host := AHost;
try
MyIdIcmpClient.Ping;
Application.ProcessMessages;
except
Result := False;
MyIdIcmpClient.Free;
Exit;
end;
if MyIdIcmpClient.ReplyStatus.ReplyStatusType <> rsEcho Then result := False;
MyIdIcmpClient.Free;
end;
So I've developped that at home on my wifi network and everthing just work fine.
When I get back to work I tested and I get an error saying
Socket Errod # 10040 Message too long
At work we have fixed IPs and all the computer and I are in the same subnet.
I tried to disconnect from the fixed IP and connect to the wifi which of course is DHCP and not in the same subnet, and it is just working fine.
I have tried searching the internet for this error and how to solve it but didn't find much info.
Of course I have tried to change the default buffer size to a larger value but it didn't change anything I still get the error on the fixed IP within same subnet.
Moreover, I don't know if this can help finding a solution, but my code treats exceptions, but in that case it takes about 3-4 seconds to raise the error whereas the Timeout is set to 200 milliseconds. And I cannot wait that long over each ping.
By the way I use delphi 2010 and I think it is indy 10. I also have tested on XE2 but same error.
Any idea
----- EDIT -----
This question is answered, now I try to have this running in multithread and I have asked another question for that
Delphi (XE2) Indy (10) Multithread Ping
Set the PacketSize property to 24:
function TMainForm.Ping(const AHost : string) : Boolean;
var
MyIdIcmpClient : TIdIcmpClient;
begin
Result := True;
MyIdIcmpClient := TIdIcmpClient.Create(self);
MyIdIcmpClient.ReceiveTimeout := 200;
MyIdIcmpClient.Host := AHost;
MyIdIcmpClient.PacketSize := 24;
MyIdIcmpClient.Protocol := 1;
MyIdIcmpClient.IPVersion := Id_IPv4;
try
MyIdIcmpClient.Ping;
// Application.ProcessMessages; // There's no need to call this!
except
Result := False;
Exit;
end;
if MyIdIcmpClient.ReplyStatus.ReplyStatusType <> rsEcho Then result := False;
MyIdIcmpClient.Free;
end;
For XE5 and Indy10 this is still a problem, even with different Packet Size.
To answer the more cryptical fix:
ABuffer := MyIdIcmpClient1.Host + StringOfChar(' ', 255);
This is a "magic" fix to get around the fact that there is a bug in the Indy10 component (if I have understood Remy Lebeau right).
My speculation is that this has some connection with the size of the receive buffer. To test my theory I can use any character and don't need to include the host address at all. Only use as many character you need for the receive buffer. I use this small code (C++ Builder XE5) to do a Ping with great success (all other values at their defaults):
AnsiString Proxy = StringOfChar('X',IcmpClient->PacketSize);
IcmpClient->Host = Host_Edit->Text;
IcmpClient->Ping(Proxy);
As you can see I create a string of the same length as the PacketSize property. What you fill it with is insignificant.
Maybe this can be of help to #RemyLebeau when he work on the fix.
use this code
ABuffer := MyIdIcmpClient1.Host + StringOfChar(' ', 255);
MyIdIcmpClient.Ping(ABuffer);
I asked a similar question about implicit interface variables not so long ago.
The source of this question was a bug in my code due to me not being aware of the existence of an implicit interface variable created by the compiler. This variable was finalized when the procedure that owned it finished. This in turn caused a bug due to the lifetime of the variable being longer than I had anticipated.
Now, I have a simple project to illustrate some interesting behaviour from the compiler:
program ImplicitInterfaceLocals;
{$APPTYPE CONSOLE}
uses
Classes;
function Create: IInterface;
begin
Result := TInterfacedObject.Create;
end;
procedure StoreToLocal;
var
I: IInterface;
begin
I := Create;
end;
procedure StoreViaPointerToLocal;
var
I: IInterface;
P: ^IInterface;
begin
P := #I;
P^ := Create;
end;
begin
StoreToLocal;
StoreViaPointerToLocal;
end.
StoreToLocal is compiled just as you would imagine. The local variable I, the function's result, is passed as an implicit var parameter to Create. The tidy up for StoreToLocal results in a single call to IntfClear. No surprises there.
However, StoreViaPointerToLocal is treated differently. The compiler creates an implicit local variable which it passes to Create. When Create returns, the assignment to P^ is performed. This leaves the routine with two local variables holding references to the interface. The tidy up for StoreViaPointerToLocal results in two calls to IntfClear.
The compiled code for StoreViaPointerToLocal is like this:
ImplicitInterfaceLocals.dpr.24: begin
00435C50 55 push ebp
00435C51 8BEC mov ebp,esp
00435C53 6A00 push $00
00435C55 6A00 push $00
00435C57 6A00 push $00
00435C59 33C0 xor eax,eax
00435C5B 55 push ebp
00435C5C 689E5C4300 push $00435c9e
00435C61 64FF30 push dword ptr fs:[eax]
00435C64 648920 mov fs:[eax],esp
ImplicitInterfaceLocals.dpr.25: P := #I;
00435C67 8D45FC lea eax,[ebp-$04]
00435C6A 8945F8 mov [ebp-$08],eax
ImplicitInterfaceLocals.dpr.26: P^ := Create;
00435C6D 8D45F4 lea eax,[ebp-$0c]
00435C70 E873FFFFFF call Create
00435C75 8B55F4 mov edx,[ebp-$0c]
00435C78 8B45F8 mov eax,[ebp-$08]
00435C7B E81032FDFF call #IntfCopy
ImplicitInterfaceLocals.dpr.27: end;
00435C80 33C0 xor eax,eax
00435C82 5A pop edx
00435C83 59 pop ecx
00435C84 59 pop ecx
00435C85 648910 mov fs:[eax],edx
00435C88 68A55C4300 push $00435ca5
00435C8D 8D45F4 lea eax,[ebp-$0c]
00435C90 E8E331FDFF call #IntfClear
00435C95 8D45FC lea eax,[ebp-$04]
00435C98 E8DB31FDFF call #IntfClear
00435C9D C3 ret
I can guess as to why the compiler is doing this. When it can prove that assigning to the result variable will not raise an exception (i.e. if the variable is a local) then it uses the result variable directly. Otherwise it uses an implicit local and copies the interface once the function has returned thus ensuring that we don't leak the reference in case of an exception.
But I cannot find any statement of this in the documentation. It matters because interface lifetime is important and as a programmer you need to be able to influence it on occasion.
So, does anybody know if there is any documentation of this behaviour? If not does anyone have any more knowledge of it? How are instance fields handled, I have not checked that yet. Of course I could try it all out for myself but I'm looking for a more formal statement and always prefer to avoid relying on implementation detail worked out by trial and error.
Update 1
To answer Remy's question, it mattered to me when I needed to finalize the object behind the interface before carrying out another finalization.
begin
AcquirePythonGIL;
try
PyObject := CreatePythonObject;
try
//do stuff with PyObject
finally
Finalize(PyObject);
end;
finally
ReleasePythonGIL;
end;
end;
As written like this it is fine. But in the real code I had a second implicit local which was finalized after the GIL was released and that bombed. I solved the problem by extracting the code inside the Acquire/Release GIL into a separate method and thus narrowed the scope of the interface variable.
If there is any documentation of this behavior, it will probably be in the area of compiler production of temporary variables to hold intermediate results when passing function results as parameters. Consider this code:
procedure UseInterface(foo: IInterface);
begin
end;
procedure Test()
begin
UseInterface(Create());
end;
The compiler has to create an implicit temp variable to hold the result of Create as it is passed into UseInterface, to make sure that the interface has a lifetime >= the lifetime of the UseInterface call. That implicit temp variable will be disposed at the end of the procedure that owns it, in this case at the end of the Test() procedure.
It's possible that your pointer assignment case may fall into the same bucket as passing intermediate interface values as function parameters, since the compiler can't "see" where the value is going.
I recall there have been a few bugs in this area over the years. Long ago (D3? D4?), the compiler didn't reference count the intermediate value at all. It worked most of the time, but got into trouble in parameter alias situations. Once that was addressed there was a follow up regarding const params, I believe. There was always a desire to move disposal of the intermediate value interface up to as soon as possible after the statement in which it was needed, but I don't think that ever got implemented in the Win32 optimizer because the compiler just wasn't set up for handling disposal at statement or block granularity.
You can not guarantee that compiler will not decide to create a temporal invisible variable.
And even if you do, the turned off optimization (or even stack frames?) may mess up your perfectly checked code.
And even if you manage to review your code under all possible combinations of project options - compiling your code under something like Lazarus or even new Delphi version will bring hell back.
A best bet would be to use "internal variables can not outlive routine" rule. We usually do not know, if compiler would create some internal variables or not, but we do know, that any such variables (if created) would be finalized when routine exists.
Therefore, if you have code like this:
// 1. Some code which may (or may not) create invisible variables
// 2. Some code which requires release of reference-counted data
E.g.:
Lib := LoadLibrary(Lib, 'xyz');
try
// Create interface
P := GetProcAddress(Lib, 'xyz');
I := P;
// Work with interface
finally
// Something that requires all interfaces to be released
FreeLibrary(Lib); // <- May be not OK
end;
Then you should just wrap "Work with interface" block into subroutine:
procedure Work(const Lib: HModule);
begin
// Create interface
P := GetProcAddress(Lib, 'xyz');
I := P;
// Work with interface
end; // <- Releases hidden variables (if any exist)
Lib := LoadLibrary(Lib, 'xyz');
try
Work(Lib);
finally
// Something that requires all interfaces to be released
FreeLibrary(Lib); // <- OK!
end;
It is a simple, but effective rule.
I have an app written in Delphi 2006 that regularly reads from a disk file located elsewhere on a network (100Mb ethernet). Occasionally the read over the network takes a very long time (like 20 secs) and the app freezes, as the read is done from an idle handler in the main thread.
OK, I could put the read operation into it's own thread, but what I would like to know is whether it is possible to specify a timeout for a file operation, so that you can give up and go and do something else, or report the fact that the read has snagged a bit earlier than 20 seconds later.
function ReadWithTimeout (var Buffer ;
N : integer ;
Timeout : integer) : boolean ;
begin
Result := false
try
SetReadTimeout (Timeout) ; // <==========================???
FileStream.Read (Buffer, N) ;
Result := true ;
except
...
end ;
end ;
Open the file for asynchronous access by including the File_Flag_Overlapped flag when you call CreateFile. Pass in a TOverlapped record when you call ReadFile, and if the read doesn't complete immediately, the function will return early. You can control how long you wait for the read to complete by calling WaitForSingleObject on the event you store in the TOverlapped structure. You can even use MsgWaitForMultipleObjects to wait; then you can be notified as soon as the read completes or a message arrives, whichever comes first, so your program doesn't need to hang at all. After you finish processing messages, you can check again whether the I/O is complete with GetOverlappedResult, resume waiting, or give up on the I/O by calling CancelIo. Make sure you read the documentation for all those functions carefully; asynchronous I/O isn't trivial.
After you've moved the read operation to a thread, you could store the value returned by timeGetTime before reading:
isReading := true;
try
startedAt := timeGetTime;
FileStream.Read (Buffer, N);
...
finally
isReading := false;
end;
and check in the idle handler if it's taken too long.
eg:
function ticksElapsed( FromTicks, ToTicks : cardinal ) : cardinal;
begin
if FromTicks < ToTicks
then Result := ToTicks - FromTicks
else Result := ( high(cardinal) - FromTicks ) + ToTicks; // There was a wraparound
end;
...
if isReading and ( ticksElapsed( startedAt, timeGetTime ) > 10 * 1000 ) // Taken too long? ~10s
then // Do something