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.
Related
I have the following issue.
I'm using Glut openGL for drawing certain elements in my application written in Delphi. The library file I'm using is called glut32.dll (placed where the EXE file is standing)
Now I decided to compile my app in 64-bit as other libraries it is using are going to be updated only for 64-bit. All fine, but the one thing that stops me is the glut32.dll (it is 32-bit). As the Glut project is not supported for many years already I found the freeglut alternative which claim to be replacement for the original Glut: https://freeglut.sourceforge.net/, and downloaded the freeglut.dll from here: www.transmissionzero.co.uk/software/freeglut-devel/ for MSVC.
As I looked at the .h header files it seems more or less the same as my code translation is in the *.pas files.
So I tried to just load the freeglut.dll instead of glut32.dll (dll is set to the correct dll name in the function below)
procedure LoadGlut(const dll: String);
begin
FreeGlut;
hDLL := LoadLibrary(PChar(dll));
if hDLL = 0 then raise Exception.Create('Could not load Glut from ' + dll);
#glutInit := GetProcAddress(hDLL, 'glutInit');
#glutInitDisplayMode := GetProcAddress(hDLL, 'glutInitDisplayMode');
#glutCreateWindow := GetProcAddress(hDLL, 'glutCreateWindow');
#glutCreateSubWindow := GetProcAddress(hDLL, 'glutCreateSubWindow');
#glutDestroyWindow := GetProcAddress(hDLL, 'glutDestroyWindow');
#glutPostRedisplay := GetProcAddress(hDLL, 'glutPostRedisplay');
...
It is loading with no errors and so on, also the procedures in it, but when the application start and reach a point to use one of these functions it just stop the debugger with no error message (like pressing Ctrl+F2).
procedure DrawArrow(P1, P2: TRPoint; Color: TRGBAColor);
var
R : Real;
begin
DrawLine(P1, P2, Color);
glColor4fv(#Color[0]);
glPushMatrix;
SetZAxis(P2, P1);
R := VectorModulus(VectorDifference(P1,P2));
glTranslated(0, 0, R);
SetSymbolScale;
glTranslated(0, 0, -ARROW_L);
glutSolidCone(ARROW_W/2, ARROW_L, SOLID_SLICES, SOLID_STACKS);
glPopMatrix;
glPopMatrix;
end;
The debugger shut itself at glutSolidCone(ARROW_W/2, ARROW_L, SOLID_SLICES, SOLID_STACKS); This function is defined in freeglut as well.
EDIT: If I call other simple function like glutInitDisplayMode it doesn't stop, so it seems that the library is correctly loaded. But it still keeps shutting down at glutSolidCone or other drawing functions.
I don't have much experience of using these header files and dll that comes with it, but my Delphi code should be a good translation in this case? Or not? I don't know how to debug this.
What is the way to adapt my code in order to fit freeglut in it. It should be something small I think as most of the things should be the same.
Thank you for the help
It seems that just replacing glut32.dll with freeglut.dll won't do the job properly as I guess functions inside differs a bit (or simply renaming freeglut.dll --> glut32.dll also fails). However I found a workaround published by NVIDIA: NVIDIA Cg Toolkit
It is not supported since 2013, but when installed it brings the dll version of glut32 both for 32-bit and 64-bit development. Quickly try it and it seems to work and cover what I have as definition in Glut.pas.
So if you need 64-bit version and replacement of glut32.dll it can be downloaded from there.
Meanwhile if somebody convert the freeglut headers (.h) to Delphi code it would be great as at the end the Freeglut projecy is still maintained, up-to-date and add some more useful functions in addition to the original Glut. This conversion is still beyond my knowledge.
Nowhere in the Windows documentation do I see a reference to a size limit to the resources one can add using UpdateResource, but it seems I have stumbled upon one - and it's tiny!
I was developing a Windows Ribbon app and wanted to programmatically build and attach the resource. Linking the resource using a $R directive worked just dandy, but I kept getting memory junk when attaching the very same thing from code.
I have managed to reduce it to a simple example using a string resource:
Handle := BeginUpdateResource(PChar(DestFileName), True);
try
AddResource(Handle, 'STRING', 'ManyXs', StrUtils.DupeString('X', 1000));
finally
EndUpdateResource(Handle, False);
end;
And AddResource is defined as:
procedure TForm2.AddResource(Handle: NativeUInt; ResType, ResName, Value: string);
begin
if not UpdateResource(Handle, PChar(ResType), PChar(ResName), 1033,
PChar(Value), Value.Length * SizeOf(Char)) then
RaiseLastOSError;
end;
Please ignore my hard-coded language for the moment.
When I inspect the resource subsequent to calling this, I see a thousand Xs. Fabulous.
I can change the resource to 1990 Xs and it's fine. The moment it goes to 1991, I get nonsense written to the DLL. The size of the resource is correctly indicated as 3982 (1991 * 2 because it's Unicode), but the contents is just a dump of stuff from memory.
I can view larger resources with my resource editor, and the IDE routinely inserts larger resources (Delphi forms, for example), so I'm definitely missing something.
I've tried the following, despite not thinking any of them would make a difference (they didn't):
Using just large memory buffers instead of strings
Using the Ansi version of the UpdateResource function
Many different resource types - what I really need to get working, is UIFILE
Looking for other functions in the API (I found none)
Combinations of 1, 2 and 3
Any ideas?
Update:
Inspired by the comments and Jolyon's answer, tried a few more things.
First, I tried in Delphi XE7 and XE5 as well (original was in XE6). I don't have XE2 installed anymore, so i cannot confirm what Sertak has said. I'll find out if someone else in my office still has it installed.
Second, here is the memory buffer version:
procedure TForm2.AddResource(Handle: NativeUInt; const ResType, ResName, Value: string);
var
Buffer: Pointer;
BuffLen: Integer;
begin
BuffLen := Value.Length * SizeOf(Char);
GetMem(Buffer, BuffLen);
try
StrPCopy(PChar(Buffer), Value);
if not UpdateResource(Handle, PChar(ResType), PChar(ResName), 1033,
Buffer, BuffLen) then
RaiseLastOSError;
finally
FreeMem(Buffer);
end;
end;
I actually had a previous version of this code where I dumped the contents of that pointer into a file before the call to UpdateResource and the file saved correctly but the resource still saved junk. Then I did this version, which doesn't involve strings at all:
procedure TForm2.AddResource(Handle: NativeUInt; const ResType, ResName: string;
C: AnsiChar; Len: Integer );
var
Buffer: Pointer;
BuffLen: Integer;
begin
BuffLen := Len;
GetMem(Buffer, BuffLen);
try
FillMemory(Buffer, Len, Byte(C));
if not UpdateResource(Handle, PChar(ResType), PChar(ResName), 1033,
Buffer, BuffLen) then
RaiseLastOSError;
finally
FreeMem(Buffer);
end;
end;
With this version I still have the same problem when I use 3882 Xs. Of course, I'm now using single-byte characters, that's why it's double. But I have the exact same issue.
I did notice a difference between the versions in the output of TDUMP though. For versions 1 (strings) and 2 (string copied to buffer), my resource size is suddenly indicated as FFFFFF90 when I use 1991 characters. With version 3 (no strings), the size is the actual hex value of whatever size I used.
The fact that you are getting "junk" data but data of the right size leads me to suspect the PChar() casting of the string value yielding an incorrect address. This normally should not be a problem, but I wonder if the issue is some strange behaviour as the result of passing the result of a function directly into a parameter of a method ? A behaviour which for some strange reason is only triggered when the string involved reaches a certain size, perhaps indicating some edge-case optimization behaviour.
This might also explain difficulties in reproducing the problem if it is some combination of optimization (and/or other compiler settings) in some specific version of Delphi.
I would suggest to try eliminating this possibility by creating your new resource string in an explicit variable and passing that to the AddResource() method. I would also suggest that you be explicit in your parameter semantics and since the string involved is not modified, nor intended to be modified, in the AddResource() method, declare it as a formally const parameter.
You do mention having tried an alternative approach using "memory buffers". If the above suggestions do not resolve the problem, perhaps it would be helpful to post a minimal example that reproduces the problem using those, to eliminate any possible influence on things by the rather more exotic "string" type.
I am trying to work around a known ugly performance limitation in System.Classes.pas, which has a 1980s era constant buffer limit ($F000) that looks like this:
function TStream.CopyFrom(const Source: TStream; Count: Int64): Int64;
const
MaxBufSize = $F000;
....
This is causing major performance penalties in our Delphi application. In delphi XE2 through XE5, we were able to modify this and use one of the following approaches:
I could modify the Delphi sources, and then, by invoking dcc32.exe from a batch file, rebuild the System.Classes.dcu file in the Delphi library folder. I realize this is ugly and I didn't like doing this, but I don't like this ugly performance issue in the RTL either, and our users can not live with the performance headaches it causes.
I could try to put a modified system.classes.pas file somewhere in my project search path.
Neither of the above approaches is working for me in Delphi XE6, now, thanks probably to some internal compiler changes. The error I get in a minimal command line application that includes System.Contnrs in its uses clause, is this:
[dcc32 Fatal Error] System.Classes.pas(19600): F2051 Unit System.Contnrs was compiled with a different version of System.Classes.TComponent
The sample program to reproduce this problem (assuming you have modified System.Classes.pas and changed the MaxBufSize constant), is shown here:
program consoletestproject;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.Contnrs,
System.SysUtils;
var
List:System.Contnrs.TObjectList;
begin
WriteLn('Hello world');
end.
Again, this problem reproduces easily in Delphi XE6, but is not a problem in XE5, or earlier.
What is the recommended practice when you absolutely MUST work around a fundamental RTL or VCL limitation using a modified copy of System.Classes.pas or System.SysUtils.pas or some other very low level unit? (Yes, I know you should NOT do this if you don't have to, don't bother with a lecture.)
Are there a magic set of command line parameters you can use via "dcc32.exe" on the command line, to produce a modified DCU that will link properly with the application example above?
As a secondary question, are there .dcu files for which no source exists that will break when one tries to do this, in which case the answer to all of the above is, "you can't fix this, and if there's a bug in the RTL, you're out of luck"?
One possible workaround is to include "$(BDS)\source\rtl\common" in your project search path (or library path), forcing each broken (needing recompile) DCU to rebuild EACH time, but this seems ugly and wrong.
You can overcome this limitation using a detour, try this sample which uses the Delphi Detours Library
First define the signature of the method to hook
var
Trampoline_TStreamCopyFrom : function (Self : TStream;const Source: TStream; Count: Int64): Int64 = nil;
then implement the detour
function Detour_TStreamCopyFrom(Self : TStream;const Source: TStream; Count: Int64): Int64;
const
MaxBufSize = 1024*1024; //use 1 mb now :)
var
BufSize, N: Integer;
Buffer: TBytes;
begin
if Count <= 0 then
begin
Source.Position := 0;
Count := Source.Size;
end;
Result := Count;
if Count > MaxBufSize then BufSize := MaxBufSize else BufSize := Count;
SetLength(Buffer, BufSize);
try
while Count <> 0 do
begin
if Count > BufSize then N := BufSize else N := Count;
Source.ReadBuffer(Buffer, N);
Self.WriteBuffer(Buffer, N);
Dec(Count, N);
end;
finally
SetLength(Buffer, 0);
end;
end;
Finally replace the original function by the trampoline (you can use this code in the initialization part of some unit)
Trampoline_TStreamCopyFrom := InterceptCreate(#TStream.CopyFrom, #Detour_TStreamCopyFrom);
And to release the hook you can use
if Assigned(Trampoline_TStreamCopyFrom) then
InterceptRemove(#Trampoline_TStreamCopyFrom);
Update 1: The suggestion below does not work for the Classes unit in XE6. The basic technique is sound and does solve similar problems. But for XE6, at least the Classes unit, it is not immediately obvious how to re-compile it.
This appears to be a fault introduced in XE6 because this technique is meant to work and is officially endorsed by Embarcadero: http://blog.marcocantu.com/blog/2014_august_buffer_overflow_bitmap.html
Update 2:
In XE7, this problem no longer exists. It would appear that whatever was broken in XE6 has been fixed.
You need the compiler options to match those used when the unit was compiled by Embarcadero. That's the reason why your implementation section only change fails when it seems like it ought to succeed.
Start a default project and use CTRL + O + O to generate these options. I get
{$A8,B-,C+,D+,E-,F-,G+,H+,I+,J-,K-,L+,M-,N-,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1}
when I do this in XE6.
Put that at the top of your copy of the unit and you should be good to go. You can probably get away with a cut-down subset of these, depending on your host project options. In my code I find that:
{$R-,T-,H+,X+}
suffices.
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));
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;