Reputation: 7340
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:
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
At this point I don't know how to further troubleshoot this or find an explanation.
Upvotes: 2
Views: 1244
Reputation: 1285
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;
Upvotes: 1