Strange crash with WTSOpenServer on Windows 7 (Only in Delphi 2009/2010) - delphi

I am troubleshooting a problem with existing code that always worked fine (it's the Terminal Server unit from the Jedi Windows Security Library).
After some investigation the problem part has been brought down to a call to WTSOpenServer:
while true do
begin
hServer := WTSOpenServer(PChar('server'));
WTSCloseServer(hServer);
hServer := 0;
end;
After a random (but small) number or runs we get a total app crash which makes it hard to debug.
Here are the things I already tried:
WTSOpenServer does not write to the pServername parameter (like CreateProcessW) (in fact I checked the disassembly and it makes a copy)
The code runs fine when passing nil as parameter (and thus work with the localmachine).
When using a remote server, localhost or even dummy as pServerName the result is always crash (On Vista and higher even an invalid servername returns a valid handle as per documentation).
Tested with both Delphi 2009 and 2010
The same code runs fine in Visual Studio (c++).
Checked the disassembly in Visual Studio and made the call the WTSOpenServer in asm from Delphi (and change the Handle type to a pointer like in C):
hModule := LoadLibrary('wtsapi32.dll');
if hModule = 0 then
Exit;
WTSOpenServer := GetProcAddress(hModule, 'WTSOpenServerW');
if WTSOpenServer = nil then
Exit;
while true do
begin
asm
push dword ptr pServerName;
call dword ptr WTSOpenServer;
mov [hServer], eax;
end;
hServer := nil;
end;
Leave out the call to WTSCloseServer
Test the code on both x64 and x86 version of Windows 7
Use External Debugger instead of Delphi one (seems to run fine in that case so my guess is that it's some kind of timing/thread/deadlock issue)
Added AddVectoredExceptionHandler then I see a EXCEPTION_ACCESS_VIOLATION but the stacks seems to be corrupted, EIP is 1 so cannot determine where it happens.
At this point I don't know how to further troubleshoot this or find an explanation.

Try run your application with FastMM in FullDebugMode. It looks more like a bug in your/3rd party-lib code - possible memory overwrite/buffer overflow (moslty like sth. GetMem too small for UnicodeString/String alike operations, and it 'works' but will sooner or later crash/AV).
I've had several similar situations when migrating big app to D2009, and in most cases it was due to assumption Char=1 byte. Sometimes very strange things happened, but always FullDebugMode helped. Exception was CreateProcessW, but it's know/documented behaviour.
With FullDebugMode if app overwrite memory, then when you free it, FastMM gives you exception where it was allocated, so easly you can track down this bug. It adds some bytes at begining and end of allocation, so will know if it was overwritten.
I'm not able to reproduce it with new/empty VCL project, you can try it your self (this loop running for about 5 min):
uses JwaWtsApi32;
procedure TForm7.FormCreate(Sender: TObject);
var
hServer: DWORD;
begin
while true do
begin
hServer := WTSOpenServer(PChar('server'));
WTSCloseServer(hServer);
hServer := 0;
end;
end;

Related

Reporting memory leaks on shutdown with a console application

I've created a console application and set ReportMemoryLeaksOnShutdown := True.
I've created a TStringList but did not free it.
When the program finishes executing, I see the memory leak for a brief second but then the console closes.
I've tried adding a ReadLn; to the end, but it only shows a blank console window when I do that, which makes sense.
I need to find a way to pause executing after the memory leak report, but before complete program shutdown.
I'm using Delphi 10 Seattle.
program Project1;
{$APPTYPE CONSOLE}
uses
System.Classes,
System.SysUtils;
var
s : TStringList;
begin
try
ReportMemoryLeaksOnShutdown := True;
s := TStringList.Create;
//ReadLn doesn't work here, which makes sense.
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
//I need to be able to pause the program somewhere after the end statement here.
end.
The easiest is to simply run the application in a previously opened command window.
If you insist on seeing the memory leak report while running in the IDE, do as follows:
Locate the ShowMessage procedure in GetMem.inc (line 4856 in Delphi 10 Seattle)
Place a breakpoint on the end; of that procedure.
Alternatively, as Sertac Akyuz commented, put a break point on the end. of the system unit.
You can also redirect the memory leak report to a file. Download the full version of FastMM from
https://sourceforge.net/projects/fastmm/
or better, thanks to Arioch 'The, from here:
https://github.com/pleriche/FastMM4
and set the needed options in FastMM4Options.inc
var
SaveExitProcessProc: procedure;
s: TStringList;
procedure MyExitProcessProc;
begin
ExitProcessProc := SaveExitProcessProc;
{$I-}
ReadLn;
{$I+}
end;
begin
SaveExitProcessProc := ExitProcessProc;
ExitProcessProc := MyExitProcessProc;
ReportMemoryLeaksOnShutdown := True;
s := TStringList.Create;
end.
That is a bug in recent Delphi versions. I just checked it in that recent free Delphi 10.1 Starter and it behaves as you describe - but as it provides no RTL sources I can not check the exact reason.
In Delphi XE2 it behaves as expected: creates the task-modal dialog and waits for you to react, just like described by Sertak.
In Delphi 10.1 the leak is indeed reported to the console window, but the program is not stopped to wait for user attention. That is poor solution, for both this reason and for the possible use of console programs in scripting (CMD or PS scripts would not "understand" this message and might confuse it with legitimate output and fail execution of further stages programs.
I think you have to open regression-type bug report over Delphi 10.0 - but I do not think they would fix it until 10.2 release.
I also switched your application from Delphi-forked memory manager to the original one, and then the erroneous behavior was reverted: the program displayed the message box and waited until I dismiss it before exiting into IDE.
Currently i suggest you to use the mentioned original memory manager rather than Delphi fork of it.
program Project1;
{$APPTYPE CONSOLE}
uses
FastMM4,
System.Classes,
System.SysUtils;
...
The original memory manager resides at http://github.com/pleriche/FastMM4
You can use Git client in your Delphi or a standalone one to keep yourself updated, or you can download the code once and stop updating, up to you.
The relevant quotes of its code are:
{$ifdef LogErrorsToFile}
{Set the message footer}
LMsgPtr := AppendStringToBuffer(LeakMessageFooter, LMsgPtr, Length(LeakMessageFooter));
{Append the message to the memory errors file}
AppendEventLog(#LLeakMessage[0], UIntPtr(LMsgPtr) - UIntPtr(#LLeakMessage[1]));
{$else}
{Set the message footer}
AppendStringToBuffer(LeakMessageFooter, LMsgPtr, Length(LeakMessageFooter));
{$endif}
{$ifdef UseOutputDebugString}
OutputDebugStringA(LLeakMessage);
{$endif}
{$ifndef NoMessageBoxes}
{Show the message}
AppendStringToModuleName(LeakMessageTitle, LMessageTitleBuffer);
ShowMessageBox(LLeakMessage, LMessageTitleBuffer);
{$endif}
end;
end;
{$endif}
end;
and
{Shows a message box if the program is not showing one already.}
procedure ShowMessageBox(AText, ACaption: PAnsiChar);
begin
if (not ShowingMessageBox) and (not SuppressMessageBoxes) then
begin
ShowingMessageBox := True;
MessageBoxA(0, AText, ACaption,
MB_OK or MB_ICONERROR or MB_TASKMODAL or MB_DEFAULT_DESKTOP_ONLY);
ShowingMessageBox := False;
end;
end;
This code depends upon being run on desktop Windows, so maybe Embarcadero tried to "fix" it to make it cross-platform. However the way they did it broken it on Windows console....
Also consider using adding other forms of logging - into the file and/or into the Windows Debug Strings. They would not be so attention-catching as the modal window, but would at least help you save the information, if you would know where to look for it.
This is certainly a hack, don't use in production :)
ReportMemoryLeaksOnShutdown:= True;
IsConsole:= False;
TStringList.Create;
However, it causes the leak message (and some other messages) to be displayed in a message box (where all text can be copied by pressing Ctrl+C).
(Tested with Delphi 10.2, please report any side effects we wouldn't like)
Set a breakpoint on "end." in system.pas.
However this solution is not completely ideal, because exit procedures/unit finalizations will still execute after this "end." statement.
This can be "checked" by F7/debugging/stepping into the "end." statement, it will lead to some assembler function and once the assembler function is exited by stepping over assembler instructions with F8 it will return to a function called "FinalizeUnits" in system.pas, where this function recursively calls itself to clean up the finalize sections of units I suppose.
So as long as you don't have to pause after the cleaning up of the finalization sections of units, this solution is not so bad.
However, cleaning up of units/finalization sections follows a certain order, it's likely that your own units's finalization section will be executed, before the memory manager is shutdown in the "end." statement.
Otherwise a different solution will have to be used.
To get into system.pas add it temporarely to a uses clausule or so, and choose open file, later removed it to prevent compile errors like:
"[dcc32 Error] TestProgram.dpr(8): E2004 Identifier redeclared: 'System'"

Access Violation - how do I track down the cause?

I'm getting an access violation when I close a form in my application. It seems to happen only after I have access a database a couple of times, but that doesn't seem to make sense.
I have traced through and put outputdebugstring messages in all the related OnDestroy() methods, but the AV appears to be outside of my code.
This is the text of the message:
Access violation at address 00405F7C in module
'MySoopaApplication.exe'. Read of address 00000008.
How do I find where in the application 00405F7C is?
What tools are available in Delphi 10.1 Berlin to help me with this?
Edit: added a bit more info ... when clicking "Break" the IDE always takes me to this piece of code in GETMEM.INC:
#SmallPoolWasFull:
{Insert this as the first partially free pool for the block size}
mov ecx, TSmallBlockType[ebx].NextPartiallyFreePool
Further edit: well, I found the culprit, though I can't honestly say that the debug tools got me there - they just seemed to indicate it wasn't in my code.
I had used code from the net that I used to find the Windows logged in user - this is it:
function GetThisComputerName: string;
var
CompName: PChar;
maxlen: cardinal;
begin
maxlen := MAX_COMPUTERNAME_LENGTH +1;
GetMem(CompName, maxlen);
try
GetComputerName(CompName, maxlen);
Result := CompName;
finally
FreeMem(CompName);
end;
end;
once I had replaced the code with a simple result := '12345' the AVs stopped. I have no changed it to this code:
function GetThisComputerName: string;
var
nSize: DWord;
CompName: PChar;
begin
nSize := 1024;
GetMem(CompName, nSize);
try
GetComputerName(CompName, nSize);
Result := CompName;
finally
FreeMem(CompName);
end;
end;
which seems to work and, as a bonus, doesn't cause AVs.
Thanks for your help, much appreciated.
Under Tools|Options in the IDE go to Embarcadero Debuggers | Language Exceptions and make sure Notify on Language Exceptions is checked. Also under Project Options | Compiling, make sure Debugging | Use debug DCUs is checked.
Allow the exception to happen, then go to View | Debug Windows | Call stack and you should be able to see exactly where it occurred. The fact that it occurs after db access is probably because that causes some object to be created which generates the AV when it is destroyed. Possibly because it is being Free()ed twice.
If that doesn't solve it, you may may need an exception-logging tool like madExcept mentioned by DavidH.
Read of address 00000008.
The fact that this address is a low number is suggestive of it being the address of a member of an object (because they are typically at low offsets from the base address of the object).
How do I find where in the application 00405F7C is?
With your app running, in the IDE go to Search | Go to Address. This should find it if the exception is in your application and not in some related module like a .DLL it is using. The menu item is enabled once the application is running in the IDE and stopped at a breakpoint. Also there is a compiler command line switch to find an error by address.
Others have explained how to diagnose an AV.
Regarding the code itself, there are issues with it:
Most importantly, you are not allocating enough memory for the buffer. GetMem() operates on bytes but GetComputetName() operates on characters, and in this case SizeOf (Char) is 2 bytes. So you are actually allocating half the number of bytes that you are reporting to GetComputerName(), so if it writes more than you allocate then it will corrupt heap memory. The corruption went away when you over-allocated the buffer. So take SizeOf(Char) into account when allocating:
function GetThisComputerName: string;
var
CompName: PChar;
maxlen: cardinal;
begin
maxlen := MAX_COMPUTERNAME_LENGTH +1;
GetMem(CompName, maxlen * SizeOf(Char)); // <-- here
try
GetComputerName(CompName, maxlen);
Result := CompName;
finally
FreeMem(CompName);
end;
end;
In addition to that:
you are ignoring errors from GetComputerName(), so you are not guaranteeing that CompName is even valid to pass to Result in the first place.
You should use SetString(Result, CompName, nSize) instead of Result := CompName, since GetComputerName() outputs the actual CompName length. There is no need to waste processing time having the RTL calculate the length to copy when you already know the length. And since you don't check for errors, you can't rely on CompName being null terminated anyway if GetComputerName() fails.
You should get rid of GetMem() altogether and just use a static array on the stack instead:
function GetThisComputerName: string;
var
CompName: array[0..MAX_COMPUTERNAME_LENGTH] of Char;
nSize: DWORD;
begin
nSize := Length(CompName);
if GetComputerName(CompName, nSize) then
SetString(Result, CompName, nSize)
else
Result := '';
end;

Difference between calling 64-bit API function in Debug and Release mode

I have a problem converting a 32-bit to 64-bit code using the lsaapi.pas unit
with a small Unicode PChar to PAnsiChar correction.
The following code will work in 32-bit mode but not in 64-bit.
Running the procedure (not in 64-bit Debug mode!), getting the error message
invalid parameter by calling LsaQueryInformationPolicy()
Any ideas, what's wrong ?
Why is there a different behavior running this code in the 64-bit debug and non-debug mode ?
Maybe a record alignment problem in 64-bit ?
Here is the code:
uses
lsaapi;
function GetDomainName: string;
var
Buffer: Pointer;
Status: NTStatus;
PolicyHandle: LSA_HANDLE;
ComputerName: TLsaUnicodeStr;
Attributes: TLsaObjectAttributes;
PolicyAccountDomainInfo: PPolicyAccountDomainInfo;
begin
ComputerName := TLsaUnicodeStr.CreateFromStr('');
try
FillChar(Attributes, SizeOf(Attributes), 0);
Status := LsaOpenPolicy(ComputerName.Value, Attributes,
POLICY_VIEW_LOCAL_INFORMATION, PolicyHandle);
if Status <> STATUS_SUCCESS then
raise Exception.Create('LsaOpenPolicy Failed: ' +
SysErrorMessage(LsaNtStatusToWinError(Status)));
try
Status := LsaQueryInformationPolicy(PolicyHandle,
PolicyPrimaryDomainInformation, Buffer);
if Status <> STATUS_SUCCESS then
raise Exception.Create('LsaQueryInformationPolicy Failed: ' +
SysErrorMessage(LsaNtStatusToWinError(Status)));
try
PolicyAccountDomainInfo := Buffer;
Result := PolicyAccountDomainInfo.DomainName.Buffer;
finally
LsaFreeMemory(Buffer)
end;
finally
LsaClose(PolicyHandle)
end;
finally
ComputerName.Free;
end;
end;
All the records in that lsaapi unit are declared to be packed. The Windows API header files do not use packed structs. Fix it by removing all the packed modifiers. If you make that change your function succeeds in both 32 and 64 bit targets.
For what it is worth, your code is actually failing on the call to LsaOpenPolicy. With packed records SizeOf(Attributes) returns 40. The correct size, is 48, and that's the value you get when you remove the packed modifier.
The easiest way to debug this kind of thing is to have a copy of Visual Studio installed so that you can compare equivalent C++ code.
I presume that the incorrect record declarations is the primary problem with that unit. There may very be others, but that's the one that sticks out like a sore thumb.
As other answers already indicated your records have an incorrect size, probably due to the packed statement (structs in winapi are usually not packed but aligned).
My advice is to use the Jedi Windows ApiLib (JwaNtSecApi in this case) as it has generally the best and time proven conversions.
Your error is most probably occurring both at debug and at run-time, but swallowed at run-time. I've had that occur a few times both in the x86 and x64 world in various development environments.
So:
Make sure the right one gets loaded into your process space.
Make sure the alignment and packing is right, as there have been other cases where this matters in the 64-bit world
If you get it to work, please notify Colin that you get a new version of his unit.
At first I thought this is because you cannot call 32-bit DLLs from 64-bit processes (unlike the 16/32-bit case where you had thunking between 16-bit and 32-bit and vice versa, there is no such thunking in the 32/64-bit case).
Then I found out there are two versions of the advapi32.dll: a 32-bit one and a 64-bit one.

Application freezes on call to SetLength

This question might or might not solve my problem - but I hope to learn how Delphi/Windows can behave in a way which can cause this.
I have an application which uses a 3rd party component to load an Outlook .msg file.
In some cases (specific mails) the application freezes when calling SetLength (inside of the component, I have the source code).
This happens sometimes when setLength is called inside of a procedure which loads the properties from the file (stream). It happens the exact same place on the same mail - and can be reproduced every time.
Obviously the component does a lot of stuff and it is probably a sideeffect of some of this. However, the mails contains confidential data which I cannot send to the developer of the 3rd party component, so I cannot send it to him to debug it.
The program is running under windows XP on a domain.
The curious thing is that it only happens when the user running the program is not set to be administrator on the local machine.
ms := TMemoryStream.Create;
try
WriteStorageToStream(SubStorage, ms);
ApplyValue(ms, ms.Size)
finally
ms.Free;
end;
procedure ApplyValue(Stream: TStream; brLen: Integer);
var
s: AnsiString;
begin
SetLength(s, brLen); // this freezes it all. brLen=3512
FillChar(s[1], brLen, #0);
Stream.Read(s[1], brLen);
Value := s;
end;
What WriteStorageToStream does exactly is unknown to me, but since we are not manipulating the stream and brLen has an integer value, I assume it's irrelevant.
I'd say it was simple memory overwrite, causing a failure of the memory manager when the SetLength is called which then tries to use the memory management structures. The problem is in WriteStorageToStream(SubStorage, ms);
To find it, use the FastMM debug version with the memory overwrite detection options turned on.
There's absolutely no reason SetLength would freeze on a AnsiString that's only 3512 characters long. How are you sure that it's freezing there and not somewhere earlier (like in WriteStorageToSteam)? Presumably you're stepping through this in the debugger. Does the CPU spike to 100% on that process thread when it's frozen? The fact that it freezes only on certain emails indicates to me that something in the contents of those emails is causing the freeze. The call to SetLength has nothing to do with the contents; it only cares about the length.

Delphi Loadlibrary returns 0 (LastErrorcde=3221225616) What does this mean?

I need to use a 3rd party dll in our main app. When I staticly link to the provided DLL it works ok and I can the DLLs exported functions.
But we don't want our main app dependend on this dll on startup so I tried to dynamicly load the DLL when I need it :
DLLHandle := LoadLibrary('3rdparty.dll');
ret := GetLastError();
if DLLHandle = 0 then
begin
err := SysErrorMessage(ret);
Writeln(err);
end //...
but did doesnt work : The LoadLibrary function returns 0 and the LastErrorcode is 3221225616. Because I don't know what I'm doing wrong I tried the same (on the same pc) coded in c and it works : but what doesn't it work with delphi ? :
I call the same LoadLibrary function on the same dll!
When I monitor with ProcMon I see that the 3rdparty dll gets loaded and that also the dependand dlls of the 3rdparty dll gets loaded. : So windows certainly finds the DLL.
But somewhere it the loading process it fails :
When I try to load the DLL with LoadLibraryEX with DONT_RESOLVE_DLL_REFERENCES or LOAD_LIBRARY_AS_DATAFILE it also works (but I can't offcourse call the needed functions...)
I'm out of ideas : hope you guys can help me further...
thx in adv.
Kristof
Does this work?
var
SavedCW: word;
...
SavedCW := Get8087CW;
Set8087CW(SavedCW or $7);
DLLHandle := LoadLibrary('3rdparty.dll');
Set8087CW(SavedCW);
if DLLHandle = 0 then
begin
ret := GetLastError();
err := SysErrorMessage(ret);
Writeln(err);
end //...
Some discussion:
The error code, 3221225616, seems, when asking Google, to be the result of an invalid floating point operation. Now, this seems very technical; indeed, what does loading a library have to do with floating point computations? The floating point control word (CW) is a bitfield where the bits specify how the processor should handle floating-point errors; it is actually rather common that unexpected floating point errors can be dealt with by changing one of these bits to 1 (which by the way is the default state). For an other example, see this question of mine, in which I get a totally unexpected division by zero error, which is dealt with by setting the "div by zero" bit of the control word to 1.
3221225616 = STATUS_FLOAT_INVALID_OPERATION. My wild guess is that the FPU CW is different in your Delphi and C apps, and that your DLL's initialization is sensitive to this.
Possibly related: http://discuss.joelonsoftware.com/default.asp?joel.3.88583.15
Try using SafeLoadLibrary() in the Delphi RTL instead of the Win32 LoadLibrary. This function preserves the FP control word before calling LoadLibrary, and sets it back to what Delphi wants after the LoadLibrary returns.
I think that you should report to 3rdparty.dll's developers about a bug in their DLL.
I know this is an old thread but I just came across the same problem with a DLL written in VB.
This solution works for both x86 and x64
var ret:cardinal;
em:TArithmeticExceptionMask;
begin
result:= 1;
If Lib <> 0 Then exit; // already loaded
em:=GetExceptionmask;
SetExceptionmask(em+[exInvalidOp,exZeroDivide,exOverflow, exUnderflow]);
Lib := LoadLibrary(DLLname);
SetExceptionmask(em);
ret := GetLastError;
if ret<>0 then
raise exception.create(SysErrorMessage(ret));

Resources