The following GetProcAddress code fails when compiled under Delphi XE6 x64. It runs fine when compiled under Delphi x86. Could you help to comment what is done wrong ?
program Project11;
{$APPTYPE CONSOLE}
{$R *.res}
uses
SysUtils;
var
Library_OpenGL: LongWord;
function LoadLibrary(lpFileName: pAnsiChar): LongWord; stdcall; external 'kernel32.dll' name 'LoadLibraryA';
function GetProcAddress(hModule: LongWord; lpProcName: pAnsiChar): Pointer; stdcall; external 'kernel32.dll' name 'GetProcAddress';
begin
try
Library_OpenGL := LoadLibrary('opengl32.dll');
Assert(GetProcAddress(Library_OpenGL, 'glEnable') <> nil, 'GetProcAddress(Library_OpenGL, ''glEnable'') = nil');
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
ReadLn;
end.
Your translations are wrong. A module handle is pointer sized which explains why your erroneous translations worked on 32 bit but not 64 bit.
To correct, add the Windows unit to your uses clause, remove your declarations of LoadLibrary() and GetProcAddress(), and declare Library_OpenGL as HMODULE (which is 8 bytes in x64):
program Project11;
{$APPTYPE CONSOLE}
{$R *.res}
uses
SysUtils, Windows;
var
Library_OpenGL: HMODULE;
begin
try
Library_OpenGL := LoadLibrary('opengl32.dll');
Assert(GetProcAddress(Library_OpenGL, 'glEnable') <> nil, 'GetProcAddress(Library_OpenGL, ''glEnable'') = nil');
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
ReadLn;
end.
As an added benefit you now call the native Unicode LoadLibraryW directly rather than going via the LoadLibraryA adapter with its conversation from ANSI to the system native UTF-16.
Related
I create a ShellLink Shortcut from a 64-bit program:
program ShellLinkShortcutHashTest;
{$APPTYPE CONSOLE}
{$R *.res}
uses
Winapi.Windows,
JclShell,
Winapi.ActiveX,
IdHashMessageDigest,
System.Classes, System.SysUtils;
const
ShortcutFile = 'R:\myshortcut.lnk';
ShortcutTarget = 'C:\Windows\System32\notepad.exe';
function GetHashFromFile(const AFileToHash: string): string;
var
IdMD5: TIdHashMessageDigest5;
FS: TFileStream;
begin
IdMD5 := TIdHashMessageDigest5.Create;
FS := TFileStream.Create(AFileToHash, fmOpenRead or fmShareDenyWrite);
try
Result := IdMD5.HashStreamAsHex(FS);
finally
FS.Free;
IdMD5.Free;
end;
end;
function SaveShortcutShellLink(const AFile: string): string;
var
SL: JclShell.TShellLink;
HR: Integer;
begin
Result := 'error';
SL.Target := ShortcutTarget;
SL.Description := 'My description';
HR := JclShell.ShellLinkCreate(SL, AFile);
if HR = Winapi.Windows.S_OK then
Result := 'OK - this is the shortcut file hash: ' + GetHashFromFile(AFile)
else
Result := 'Error: ' + IntToStr(HR);
end;
begin
try
Winapi.ActiveX.OleInitialize(nil);
try
Writeln(SaveShortcutShellLink(ShortcutFile));
finally
Winapi.ActiveX.OleUninitialize;
end;
Readln;
except
on E: Exception do
begin
Writeln(E.ClassName, ': ', E.Message);
Readln;
end;
end;
end.
The MD5 file hash from the shortcut file is: 4113F96CD9D6D94EB1B93D03B9604FFA.
I then build a 32-bit version of the SAME program. But the hash of the shortcut file created with the 32 bit program is different: 6512AB03F39307D9F7E3FC129140117A.
I have tested the MD5 hash of the shortcut file also with other external tools not related to Delphi. They also confirm the 64/32-bit difference.
Does this mean that shortcuts are binary-different if they have been created from a 64-bit program or from a 32-bit program? What is the difference? Could this be a security problem?
You're falling victim to the WOW64 filesystem redirector.
When your 64-bit application attempts to access :
C:\Windows\System32\notepad.exe
everything is normal you get a shortcut to the 64-bit notepad application in System32. When you attempt to access the same path from a 32-bit application, however, the redirector silently substitutes the WOW64 path in its place, to :
C:\Windows\SysWOW64\notepad.exe
and your application instead creates a shortcut to the 32-bit notepad application in SysWOW64. So these hash differently because they are shortcuts to two different programs.
The filesystem redirector is well documented and understood. While that doesn't preclude it having some security vulnerabilities, the redirector itself, and its documented behaviours, should not generally be considered a security risk.
I'm loading package at runtime via LoadPackage(). Let's say after load I want to check the version of the package to ensure it's the newest. How can I do that?
A package is just a special type of dll, So you can use the GetFileVersion function defined in the SysUtils unit, this function returns the most significant 32 bits of the version number. so does not include the release and/or build numbers.
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils;
Var
FileVersion : Cardinal;
begin
try
FileVersion:=GetFileVersion('C:\Bar\Foo.bpl');
Writeln(Format('%d.%d',[FileVersion shr 16, FileVersion and $FFFF]));
Readln;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.
If you want retrieve the full version number (with release and build numbers included) you can use the GetFileVersionInfoSize, VerQueryValue and GetFileVersionInfo WinApi functions.
function GetFileVersionStr(const AFileName: string): string;
var
FileName: string;
LinfoSize: DWORD;
lpdwHandle: DWORD;
lpData: Pointer;
lplpBuffer: PVSFixedFileInfo;
puLen: DWORD;
begin
Result := '';
FileName := AFileName;
UniqueString(FileName);
LinfoSize := GetFileVersionInfoSize(PChar(FileName), lpdwHandle);
if LinfoSize <> 0 then
begin
GetMem(lpData, LinfoSize);
try
if GetFileVersionInfo(PChar(FileName), lpdwHandle, LinfoSize, lpData) then
if VerQueryValue(lpData, '\', Pointer(lplpBuffer), puLen) then
Result := Format('%d.%d.%d.%d', [
HiWord(lplpBuffer.dwFileVersionMS),
LoWord(lplpBuffer.dwFileVersionMS),
HiWord(lplpBuffer.dwFileVersionLS),
LoWord(lplpBuffer.dwFileVersionLS)]);
finally
FreeMem(lpData);
end;
end;
end;
If I would like to save a IXMLDOMDocument3 in runtime to a file on my harddrive, what is the syntax for that?
E.g. like IXMLDOMDocument3.save('c:\test.xml')
Or is it even possible?
Best regards!
the sample code below demonstrates how to load and save IXMLDomDocument3 XML at runtime. It uses msxml header file from Delphi-2010. IXMLDomDocument3 inherits from IXMLDomDocument and has Save method (as you wrote in your question). If method parameter is a string, then it specifies file name (it creates or replaces target file).
program Project3;
{$APPTYPE CONSOLE}
uses SysUtils, msxml, comObj, activex;
procedure LoadAndSaveXML(LoadFile, SaveFile : string);
var xml : IXMLDOMDocument3;
tn : IXMLDOMElement;
begin
xml := CreateComObject(CLASS_DOMDocument60) as IXMLDOMDocument3;
xml.load(LoadFile);
xml.save(SaveFile);
end;
begin
try
CoInitialize(nil);
try
LoadAndSaveXML('D:\in.xml', 'D:\out.xml');
finally
CoUninitialize();
end;
except
on E: Exception do begin
Writeln(E.ClassName, ': ', E.Message);
readln;
end;
end;
end.
I need to process a set of bmp files using a console application, i'm using the TBitmap class, but the code doesn't compile because this error
E2003 Undeclared identifier: 'Create'
This sample app reproduces the issue
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils,
Vcl.Graphics,
WinApi.Windows;
procedure CreateBitMap;
Var
Bmp : TBitmap;
Flag : DWORD;
begin
Bmp:=TBitmap.Create; //this line produce the error of compilation
try
//do something
finally
Bmp.Free;
end;
end;
begin
try
CreateBitMap;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.
why this code doesn't compile?
The issue is in the order of your uses clause, the WinApi.Windows and Vcl.Graphics units have a type called TBitmap, when the compiler find an ambiguous type resolves the type using the last unit of the uses list where is present. in this case use the TBitmap of the Windows unit which points to the BITMAP WinAPi structure , to resolve this change the order of your units to
uses
System.SysUtils,
WinApi.Windows,
Vcl.Graphics;
or you can declare the type using the full qualified name like so
procedure CreateBitMap;
Var
Bmp : Vcl.Graphics.TBitmap;
Flag : DWORD;
begin
Bmp:=Vcl.Graphics.TBitmap.Create;
try
//do something
finally
Bmp.Free;
end;
end;
I want to get the whole list of classes defined in a specific unit
How can I get the list of all instances of those classes, irrespective of where they are created?
First before to answer your question, remember always include your delphi version in questions related to the Rtti.
1) Asumming which you are using a new version of delphi (>=2010) you can get the unit name of a type using the QualifiedName property , from there you must check the IsInstance property to determine if is a class.
Check the next sample.
{$APPTYPE CONSOLE}
{$R *.res}
uses
Rtti,
System.SysUtils;
procedure Test;
Var
t : TRttiType;
//extract the unit name from the QualifiedName property
function GetUnitName(lType: TRttiType): string;
begin
Result := StringReplace(lType.QualifiedName, '.' + lType.Name, '',[rfReplaceAll])
end;
begin
//list all the types of the System.SysUtils unit
for t in TRttiContext.Create.GetTypes do
if SameText('System.SysUtils',GetUnitName(t)) and (t.IsInstance) then
Writeln(t.Name);
end;
begin
try
Test;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
Readln;
end.
2) The Rtti can't list the instances of the classes. because the Rtti is about type information and not of instances.
Question 1
The following code does what you ask, relying on the new RTTI introduced in Delphi 2010:
program FindClassesDeclaredInUnit;
{$APPTYPE CONSOLE}
uses
SysUtils, Rtti, MyTestUnit in 'MyTestUnit.pas';
procedure ListClassesDeclaredInNamedUnit(const UnitName: string);
var
Context: TRttiContext;
t: TRttiType;
DeclaringUnitName: string;
begin
Context := TRttiContext.Create;
for t in Context.GetTypes do
if t.IsInstance then
begin
DeclaringUnitName := t.AsInstance.DeclaringUnitName;
if SameText(DeclaringUnitName, UnitName) then
Writeln(t.ToString, ' ', DeclaringUnitName);
end;
end;
begin
ListClassesDeclaredInNamedUnit('MyTestUnit');
Readln;
end.
unit MyTestUnit;
interface
type
TClass1 = class
end;
TClass2 = class
end;
implementation
procedure StopLinkerStrippingTheseClasses;
begin
TClass1.Create.Free;
TClass2.Create.Free;
end;
initialization
StopLinkerStrippingTheseClasses;
end.
Question 2
There is no global registry of object instances.