I have embedded several resources into the executable, for instance language (text) files.
Below you can see the contents of Languages.rc file:
Language_English RCDATA Languages\English.ini
Language_German RCDATA Languages\German.ini
Language_Czech RCDATA Languages\Czech.ini
I found this answer, which definitely helps, however I have rather hard time implementing it.
Suppose you want to get the list of those resources as a EOL-delimited string, then the first step would be defining EnumRCDataProc function:
function EnumRCDataProc(hModule: HMODULE; lpszType, lpszName: PChar; lParam: NativeInt): BOOL; stdcall;
begin
TStrings(lParam).Add(lpszName);
Result := True;
end;
Once we have that done, we can get to work:
function EnumerateRCDataResourceNames: string;
var
ExecutableHandle: HMODULE;
ResourcesList: TStringList;
begin
ExecutableHandle := LoadLibraryEx(PChar(Application.ExeName), 0, LOAD_LIBRARY_AS_DATAFILE);
try
ResourcesList := TStringList.Create;
try
EnumResourceNames(ExecutableHandle, RT_RCDATA, #EnumRCDataProc, NativeInt(ResourcesList));
Result := ResourcesList.Text;
finally
ResourcesList.Free;
end;
finally
FreeLibrary(ExecutableHandle);
end;
end;
Remarks:
As is in the original answer (see question), it is not possible to use LOAD_LIBRARY_AS_DATAFILE_EXCLUSIVE or LOAD_LIBRARY_AS_IMAGE_RESOURCE as these types are no longer defined in Delphi XE6, at least AFAIK.
You can, however, define those constants, according to MSDN:
LOAD_LIBRARY_AS_DATAFILE_EXCLUSIVE = $00000040
LOAD_LIBRARY_AS_IMAGE_RESOURCE = $00000020
Related
AS. since closing related questions - more examples added below.
The below simple code (which finds a top-level Ie window and enumerates its children) works Ok with a '32-bit Windows' target platform. There's no problem with earlier versions of Delphi as well:
procedure TForm1.Button1Click(Sender: TObject);
function EnumChildren(hwnd: HWND; lParam: LPARAM): BOOL; stdcall;
const
Server = 'Internet Explorer_Server';
var
ClassName: array[0..24] of Char;
begin
Assert(IsWindow(hwnd)); // <- Assertion fails with 64-bit
GetClassName(hwnd, ClassName, Length(ClassName));
Result := ClassName <> Server;
if not Result then
PUINT_PTR(lParam)^ := hwnd;
end;
var
Wnd, WndChild: HWND;
begin
Wnd := FindWindow('IEFrame', nil); // top level IE
if Wnd <> 0 then begin
WndChild := 0;
EnumChildWindows(Wnd, #EnumChildren, UINT_PTR(#WndChild));
if WndChild <> 0 then
..
end;
I've inserted an Assert to indicate where it fails with a '64-bit Windows' target platform. There's no problem with the code if I un-nest the callback.
I'm not sure if the erroneous values passed with the parameters are just garbage or are due to some mis-placed memory addresses (calling convention?). Is nesting callbacks infact something that I should never do in the first place? Or is this just a defect that I have to live with?
edit:
In response to David's answer, the same code having EnumChildWindows declared with a typed callback. Works fine with 32-bit:
(edit: The below does not really test what David says since I still used the '#' operator. It works fine with the operator, but if I remove it, it indeed does not compile unless I un-nest the callback)
type
TFNEnumChild = function(hwnd: HWND; lParam: LPARAM): Bool; stdcall;
function TypedEnumChildWindows(hWndParent: HWND; lpEnumFunc: TFNEnumChild;
lParam: LPARAM): BOOL; stdcall; external user32 name 'EnumChildWindows';
procedure TForm1.Button1Click(Sender: TObject);
function EnumChildren(hwnd: HWND; lParam: LPARAM): BOOL; stdcall;
const
Server = 'Internet Explorer_Server';
var
ClassName: array[0..24] of Char;
begin
Assert(IsWindow(hwnd)); // <- Assertion fails with 64-bit
GetClassName(hwnd, ClassName, Length(ClassName));
Result := ClassName <> Server;
if not Result then
PUINT_PTR(lParam)^ := hwnd;
end;
var
Wnd, WndChild: HWND;
begin
Wnd := FindWindow('IEFrame', nil); // top level IE
if Wnd <> 0 then begin
WndChild := 0;
TypedEnumChildWindows(Wnd, #EnumChildren, UINT_PTR(#WndChild));
if WndChild <> 0 then
..
end;
Actually this limitation is not specific to a Windows API callbacks, but the same problem happens when taking address of that function into a variable of procedural type and passing it, for example, as a custom comparator to TList.Sort.
http://docwiki.embarcadero.com/RADStudio/Rio/en/Procedural_Types
procedure TForm2.btn1Click(Sender: TObject);
var s : TStringList;
function compare(s : TStringList; i1, i2 : integer) : integer;
begin
result := CompareText(s[i1], s[i2]);
end;
begin
s := TStringList.Create;
try
s.add('s1');
s.add('s2');
s.add('s3');
s.CustomSort(#compare);
finally
s.free;
end;
end;
It works as expected when compiled as 32-bit, but fails with Access Violation when compiled for Win64. For 64-bit version in function compare, s = nil and i2 = some random value;
It also works as expected even for Win64 target, if one extracts compare function outside of btn1Click function.
This trick was never officially supported by the language and you have been getting away with it to date due to the implementation specifics of the 32 bit compiler. The documentation is clear:
Nested procedures and functions (routines declared within other routines) cannot be used as procedural values.
If I recall correctly, an extra, hidden, parameter is passed to nested functions with the pointer to the enclosing stack frame. This is omitted in 32 bit code if no reference is made to the enclosing environment. In 64 bit code the extra parameter is always passed.
Of course a big part of the problem is that the Windows unit uses untyped procedure types for its callback parameters. If typed procedures were used the compiler could reject your code. In fact I view this as justification for the belief that the trick you used was never legal. With typed callbacks a nested procedure can never be used, even in the 32 bit compiler.
Anyway, the bottom line is that you cannot pass a nested function as parameter to another function in the 64 bit compiler.
I used the Resource DLL Wizard in Delphi 2010 to generate resource only dll's for my program. When I look at them using Notepad++ it seems they are using ANSI encoding. Is there some setting I missed? It doesn't seem like a unicode program should store it's resources in ANSI especially for Asian languages.
I was looking specifically at the TABOUTBOX RT_RCDATA record. I tried to load it using the following code,
procedure LoadFromResFile(const FileName: string);
var
LibHandle: THandle;
ResourceLocation: HRSRC;
ResourceSize: dword;
ResourceHandle: THandle;
ResourcePointer: pointer;
ResStr: string;
begin
LibHandle := LoadLibraryEx(PWideChar(FileName), 0, LOAD_LIBRARY_AS_DATAFILE or LOAD_LIBRARY_AS_IMAGE_RESOURCE);
if LibHandle > 0 then
begin
ResourceLocation := FindResource(LibHandle, 'TABOUTBOX', RT_RCDATA);
ResourceSize := SizeofResource(LibHandle, ResourceLocation);
ResourceHandle := LoadResource(LibHandle, ResourceLocation);
ResourcePointer := LockResource(ResourceHandle);
if ResourcePointer <> nil then
begin
SetLength(ResStr, ResourceSize);
CopyMemory(#ResStr[1], ResourcePointer, ResourceSize);
FreeResource(ResourceHandle);
end;
FreeLibrary(LibHandle);
end else
begin
ResStr := SysErrorMessage(GetLastError);
ShowMessage(ResStr);
end;
I got garbage, but when I changed the type of ResStr to AnsiString, it showed up correctly. Opening the file in Notepad++ I can see that the dialog resources appear to be ansi, including the label captions.
The Resource DLL wizard creates RCDATA resources for localized DFMs. The RCDATA resource named TABOUTBOX is a binary DFM resource. String values stored within a DFM (component names, captions, etc) are encoded using UTF8 in modern Delphi versions, including 2010. But the DFM data itself is binary in nature, it represents the complete structure of serialized components. It is not itself Unicode data, so you can't load it as-is into a UnicodeString (it "works" when you change ResStr to an AnsiString, but only because of its 8bit nature). DFM resources are meant for TForm/TDataModule/TFrame-derived classes (in this case, TAboutBox) to load and de-serialize at runtime.
If you want to view a DFM resource as human-readible text, you have to use the ObjectBinaryToText() or ObjectResourceToText() function to decode it. For example:
var
LibHandle: THandle;
ResStrm: TResourceStream;
StrStrm: TStringStream;
ResStr: string;
begin
LibHandle := LoadLibraryEx(PChar(FileName), 0, LOAD_LIBRARY_AS_DATAFILE or LOAD_LIBRARY_AS_IMAGE_RESOURCE);
if LibHandle > 0 then
begin
try
ResStrm := TResourceStream.Create(LibHandle, 'TABOUTBOX', RT_RCDATA);
try
StrStrm := TStringStream.Create;
try
ObjectBinaryToText(ResStrm, StrStrm);
StrStrm.Position := 0;
ResStr := StrmStrm.DataString;
finally
StrStrm.Free;
end;
finally
ResStrm.Free;
end;
finally
FreeLibrary(LibHandle);
end;
end else
begin
ResStr := SysErrorMessage(GetLastError);
end;
ShowMessage(ResStr);
end;
I have created a resource file for a Delphi 2007 application. The resource files contains 10 Bitmap entries. I was wondering if there was a way to load all of the bitmaps into an Imagelist by recursively going through the resource file or do I have to pull them out one at a time.
Thanks in advance.
To add all RT_BITMAP resource type images from the current module to an image list I would use this:
uses
CommCtrl;
function EnumResNameProc(hModule: HMODULE; lpszType: LPCTSTR; lpszName: LPTSTR;
lParam: LONG_PTR): BOOL; stdcall;
var
BitmapHandle: HBITMAP;
begin
Result := True;
BitmapHandle := LoadBitmap(HInstance, lpszName);
if (BitmapHandle <> 0) then
begin
ImageList_Add(HIMAGELIST(lParam), BitmapHandle, 0);
DeleteObject(BitmapHandle);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
EnumResourceNames(HInstance, RT_BITMAP, #EnumResNameProc,
LONG_PTR(ImageList1.Handle));
end;
I'm guessing that with "recursively going through the resource file" you want to ask is it possible to load the resources without knowing their name. For that there is class of API functions which allow you to enumerate resources in given module. See the "Resource Overviews, Enumerating Resources" topic for more info on that.
However, since you embedd the bitmaps into the exe yourself it is much easier to give them names which allow easy iteration, ie, in RC file:
img1 BITMAP foo.bmp
img2 BITMAP bar.bmp
Here name "pattern" is img + number. Now it is easy to load the images in a loop:
var x: Integer;
ResName: string;
begin
x := 1;
ResName := 'img1';
while(FindResource(hInstance, PChar(ResName), RT_BITMAP) <> 0)do begin
// load the resource and do something with it
...
// name for the next resource
Inc(x);
ResName := 'img' + IntToStr(x);
end;
I want to be able to determine if a particular unit has been compiled into a Delphi program, e.g. the unit SomeUnitName is part of some of my programs but not of others. I would like to have a function
function IsSomeUnitNameInProgram: boolean;
(which is of course not declared in SomeUnitName because in that case it would always be included) that at runtime returns true, if the unit has been compiled into the program, and false, if not.
My thoughts so far have gone along the lines of using the jcl debug information (compiled from a detailed map file) which I basically add to all my programs to determine this information, but I would prefer it, if jcl were not required.
Adding code to SomeUnitName is not an option.
This is currently for Delphi 2007 but preferably should also work for Delphi XE2.
Any thoughts?
some background on this since #DavidHeffernan asked:
This is not only for one program but for more than 100 different ones. Most of them are used internally but some also get delivered to customers. Since we use quite a few libraries, some bought others under various open source licenses, I wanted to be able to add a "credits" tab to the about box which displays only those libraries actually compiled into the program rather than all of them. Thanks to the answer from TOndrej this works now exactly as I wanted it to:
The code checks for a unit which is always linked if a library is used by the program and if it is there, it adds the library name, the copyright and a link to it to the about box.
Unit names are compiled into the 'PACKAGEINFO' resource where you can look it up:
uses
SysUtils;
type
PUnitInfo = ^TUnitInfo;
TUnitInfo = record
UnitName: string;
Found: PBoolean;
end;
procedure HasUnitProc(const Name: string; NameType: TNameType; Flags: Byte; Param: Pointer);
begin
case NameType of
ntContainsUnit:
with PUnitInfo(Param)^ do
if SameText(Name, UnitName) then
Found^ := True;
end;
end;
function IsUnitCompiledIn(Module: HMODULE; const UnitName: string): Boolean;
var
Info: TUnitInfo;
Flags: Integer;
begin
Result := False;
Info.UnitName := UnitName;
Info.Found := #Result;
GetPackageInfo(Module, #Info, Flags, HasUnitProc);
end;
To do this for the current executable pass it HInstance:
HasActiveX := IsUnitCompiledIn(HInstance, 'ActiveX');
(GetPackageInfo enumerates all units which may be inefficient for executables with many units, in that case you can dissect the implementation in SysUtils and write your own version which stops enumerating when the unit is found.)
This function will return the list of unit names included in an application. Works in Delphi 2010. Not verified for other compilers.
function UnitNames: TStrings;
var
Lib: PLibModule;
DeDupedLibs: TList<cardinal>;
TypeInfo: PPackageTypeInfo;
PInfo: GetPackageInfoTable;
LibInst: Cardinal;
u: Integer;
s: string;
s8: UTF8String;
len: Integer;
P: PByte;
begin
result := TStringList.Create;
DeDupedLibs := TList<cardinal>.Create;
Lib := LibModuleList;
try
while assigned( Lib) do
begin
LibInst := Lib^.Instance;
Typeinfo := Lib^.TypeInfo;
if not assigned( TypeInfo) then
begin
PInfo := GetProcAddress( LibInst, '#GetPackageInfoTable');
if assigned( PInfo) then
TypeInfo := #PInfo^.TypeInfo;
end;
if (not assigned( TypeInfo)) or (DeDupedLibs.IndexOf( LibInst) <> -1) then continue;
DeDupedLibs.Add( LibInst);
P := Pointer( TypeInfo^.UnitNames);
for u := 0 to TypeInfo^.UnitCount - 1 do
begin
len := P^;
SetLength( s8, len);
if len = 0 then Break;
Inc( P, 1);
Move( P^, s8[1], len);
Inc( P, len);
s := UTF8ToString( s8);
if Result.IndexOf( s) = -1 then
Result.Add( s)
end
end
finally
DeDupedLibs.Free
end
end;
Example to use in the was suggested in the question...
function IsSomeUnitNameInProgram: boolean;
var
UnitNamesStrs: TStrings;
begin
UnitNamesStrs := UnitNames;
result := UnitNamesStrs.IndexOf('MyUnitName') <> -1;
UnitNamesStrs.Free
end;
This question already has answers here:
Closed 10 years ago.
Possible Duplicate:
Delphi: Selecting a directory with TOpenDialog
I need to open a specific folder on my project. When I use opendialog1, I can only open a file. How about opening a folder ?
PS : I use Delphi 2010
On Vista and up you can show a more modern looking dialog using TFileOpenDialog.
var
OpenDialog: TFileOpenDialog;
SelectedFolder: string;
.....
OpenDialog := TFileOpenDialog.Create(MainForm);
try
OpenDialog.Options := OpenDialog.Options + [fdoPickFolders];
if not OpenDialog.Execute then
Abort;
SelectedFolder := OpenDialog.FileName;
finally
OpenDialog.Free;
end;
which looks like this:
You're looking for SelectDirectory in the FileCtrl unit. It has two overloaded versions:
function SelectDirectory(var Directory: string;
Options: TSelectDirOpts; HelpCtx: Longint): Boolean;
function SelectDirectory(const Caption: string; const Root: WideString;
var Directory: string; Options: TSelectDirExtOpts; Parent: TWinControl): Boolean;
The one you want to use depends on the version of Delphi you're using, and the specific appearance and functionality you're looking for; I( usually find the second version works perfectly for modern versions of Delphi and Windows, and users seem happy with the "normally expected appearance and functionality".
You also can use TBrowseForFolder action class (stdActns.pas):
var
dir: string;
begin
with TBrowseForFolder.Create(nil) do try
RootDir := 'C:\';
if Execute then
dir := Folder;
finally
Free;
end;
end;
or use WinApi function - SHBrowseForFolder directly (second SelectDirectory overload uses it, instead of first overload, which creates own delphi-window with all controls at runtime):
var
dir : PChar;
bfi : TBrowseInfo;
pidl : PItemIDList;
begin
ZeroMemory(#bfi, sizeof(bfi));
pidl := SHBrowseForFolder(bfi);
if pidl <> nil then try
GetMem(dir, MAX_PATH + 1);
try
if SHGetPathFromIDList(pidl, dir) then begin
// use dir
end;
finally
FreeMem(dir);
end;
finally
CoTaskMemFree(pidl);
end;
end;