More Hash - Part II

Taking the same approach and design as Part I of this 'post' here is the resulting code for 'hashing' Delphi style. Again, this uses the System.Security.Cryptography Namespace to compute the hash values. This application used the MD5, SHA1,SHA2566, SHA384 and SHA512 classes. I did change the visibility of some of the functions as compared to the 'other' version.

uses System.IO, System.Security.Cryptography, System.Text;

type
hashtype = (MD5,SHA1,SHA256,SHA384,SHA512);

frmMain = class(System.Windows.Forms.Form)
procedure GroupCompare_CheckedChanged(sender: System.Object; e: System.EventArgs);
procedure btnFile_Click(sender: System.Object; e: System.EventArgs);
procedure btnCompare_Click(sender: System.Object; e: System.EventArgs);
private
procedure ClearForm;
function GetHash(contents: array of byte; hasht: hashtype): string;
function GetByteString(data: array of Byte): string;
public
function GetFileHash(const filename: string; hasht: hashtype): string;
function GetStringHash(const input: string; hasht: hashtype): string;
end;

procedure frmMain.ClearForm;
begin
txtValue1.Text := '';
txtValue2.Text := '';
txtResults1.Text := '';
txtResults2.Text := '';
end;

procedure frmMain.btnFile_Click(sender: System.Object; e: System.EventArgs);
begin
if ofdFiles.ShowDialog = System.Windows.Forms.DialogResult.OK then
begin
case Convert.ToInt32(Button(sender).Tag.ToString) of
0: txtValue1.Text:= ofdFiles.FileName;
1: txtValue2.Text:= ofdFiles.FileName;
end;
end;
end;

function frmMain.GetByteString(data: array of Byte): string;
var
sBuilder: StringBuilder;
i: integer;
begin
sBuilder:= StringBuilder.Create();
for i:= 0 to Length(data) - 1 do
begin
sBuilder.Append(data[i].ToString('x2'));
end;
result:= sBuilder.ToString();
end;

function frmMain.GetFileHash(const filename: string; hasht: hashtype): string;
var
oFileStream: System.IO.FileStream;
instance: FileInfo;
lBytes: System.Int64;
filecontents: array of byte;
begin
try
if
(filename '') then
begin
instance:= FileInfo.Create(filename);
oFileStream:= instance.OpenRead;
lBytes:= oFileStream.Length;
SetLength(filecontents, lBytes);
oFileStream.Read(filecontents, 0, lBytes);
oFileStream.Close();
result:= GetHash(filecontents, hasht);
end
else
begin

result:= '';
end;
except on
ex: Exception do
begin
MessageBox.Show(ex.Message, ex.Source, MessageBoxButtons.OK, MessageBoxIcon.Error);
result:= '';
end;
end;
end;

function frmMain.GetHash(contents: array of byte; hasht: hashtype): string;
var
res: array of Byte;
HashA: HashAlgorithm;
begin
Case hasht of
hashtype.MD5: begin
HashA:= MD5CryptoServiceProvider.Create;
res:= HashA.ComputeHash(contents)
end;
hashtype.SHA1: begin
HashA:= SHA1Managed.Create;
res:= HashA.ComputeHash(contents);
end;
hashtype.SHA256: begin
HashA:= SHA256Managed.Create;
res:= HashA.ComputeHash(contents);
end;
hashtype.SHA384: begin
HashA:= SHA384Managed.Create;
res:= HashA.ComputeHash(contents);
end;
hashtype.SHA512: begin
HashA:= SHA512Managed.Create;
res:= HashA.ComputeHash(contents);
end;
end;

result:= GetByteString(res);
end;

function frmMain.GetStringHash(const input: string; hasht: hashtype): string;
begin
result:= GetHash(Encoding.Default.GetBytes(input), hasht);
end;

procedure frmMain.btnCompare_Click(sender: System.Object; e: System.EventArgs);
var
myCursor: System.Windows.Forms.Cursor;
hasht: hashtype;
begin
myCursor:= Cursor;
Cursor:= Cursors.WaitCursor;
try
try
if
radMD5.Checked then
hasht:= hashtype.MD5;
if radSHA1.Checked then
hasht:= hashtype.SHA1;
if radSHA256.Checked then
hasht:= hashtype.SHA256;
if radSHA384.Checked then
hasht:= hashtype.SHA384;
if radSHA512.Checked then
hasht:= hashtype.SHA512;

if radFiles.Checked then
begin
txtResults1.Text:= GetFileHash(txtValue1.Text, hasht);
txtResults2.Text:= GetFileHash(txtValue2.Text, hasht);
end
else
begin
txtResults1.Text:= GetStringHash(txtValue1.Text, hasht);
txtResults2.Text:= GetStringHash(txtValue2.Text, hasht);
end;

if (System.&String.Compare(txtResults1.Text, txtResults2.Text) = 0) then
begin
picResult.Image:= ImageList1.Images[1];
end
else
begin
picResult.Image:= ImageList1.Images[0];
end;

except
on ex: Exception do
MessageBox.Show(ex.Message, ex.Source, MessageBoxButtons.OK, MessageBoxIcon.Error);
end;
finally
Cursor:= myCursor;
end;
end;

procedure frmMain.GroupCompare_CheckedChanged(sender: System.Object; e: System.EventArgs);
var
i: System.Int32;
begin
ClearForm;
if sender is control then
begin
try

i:= Convert.ToInt32(Control(Sender).Tag.ToString);
except
i:= 0;
end;
end;

case i of
0: begin
lblValue1.Text:= 'File 1:';
lblValue2.Text:= 'File 2:';
txtValue1.ReadOnly:= True;
txtValue2.ReadOnly:= True;
btnValue1.Visible:= True;
btnValue2.Visible:= True;
end;
1: begin
lblValue1.Text:= 'String 1:';
lblValue2.Text:= 'String 2:';
txtValue1.ReadOnly:= False;
txtValue2.ReadOnly:= False;
btnValue1.Visible:= False;
btnValue2.Visible:= False;
end;
end;
end;

Is it a Hash Brown?

It has been one crazy semester (I think the lack of activity can vouch for that). I've come up to the surface and see that a lot of the landscape has changed, take the emergence of CodeGear for example. I am hoping this is a breathe of new life that can revitalize the Delphi community and not just a last ditch effort (personally I think the BDS IDE is far better for development than VS). I am optimistic about the whole thing and hope they endure the 'rebirth process'.

As I was submerged in my own little world for a period of time, I had the need to calculate the Hash value for files. This actually turned out to server two purposes. The first being the verification of a file as original (intact) by comparing the hash value of the current and original file. Second, it turned out to be a fast way of identifying identical files. Often times a CRC is used to calculate a checksum, however I opted to make use of the System.Security.Cryptography Namespace. This Namespace has a number of useful hash functions including SHA1, SHA256 and SHA512. Surprisingly (or not) these are relatively easy to use and eliminate the need to formulate the algorithm on your own. Here it is in a couple of worlds:

Delphi:

uses
System.Security.Cryptography, System.IO;

procedure frmMain.ClearForm;
begin
txtSHA1.Text:= '';
txtSHA256.Text:= '';
txtSHA512.Text:= '';
end;

procedure frmMain.txtFileName_TextChanged(sender: System.Object; e: System.EventArgs);
begin
ToolTip1.SetToolTip(txtFileName,txtFileName.Text);
end;

procedure frmMain.btnCalculate_Click(sender: System.Object; e: System.EventArgs);
var
myCursor: System.Windows.Forms.Cursor;
oFileStream: FileStream;
lBytes: int64;
instance: FileInfo;
filecontents: Array of Byte;
result: Array of Byte;
SHA1M: SHA1Managed;
SHA256M: SHA256Managed;
SHA512M: SHA512Managed;

begin
myCursor:= Cursor;
Cursor:= Cursors.WaitCursor;
try
try
if not
(txtFileName.Text='') then
begin
ErrorProvider1.SetError(btnFile,'');

instance:= FileInfo.Create(txtFileName.Text);
oFileStream:= instance.OpenRead;
lBytes:= oFileStream.Length;
SetLength(filecontents,lBytes);
oFileStream.Read(filecontents,0,lBytes);
oFileStream.Close;

SHA1M:= SHA1Managed.Create;
result:= SHA1M.ComputeHash(filecontents);
txtSHA1.Text:= Convert.ToBase64String(result);

SHA256M:= SHA256Managed.Create;
result:= SHA256M.ComputeHash(filecontents);
txtSHA256.Text:= Convert.ToBase64String(result);

SHA512M:= SHA512Managed.Create;
result:= SHA512M.ComputeHash(filecontents);
txtSHA512.Text:= Convert.ToBase64String(result);
end
else
begin

ErrorProvider1.SetError(btnFile,'Select a filename');
end;
except

on e: exception do
MessageBox.Show(e.Message, e.Source, MessageBoxButtons.OK,
MessageBoxIcon.Error);
end;
finally

Cursor:= myCursor;
end;
end;

procedure frmMain.btnFile_Click(sender: System.Object; e: System.EventArgs);
begin
if (ofdFileName.ShowDialog = System.Windows.Forms.DialogResult.OK) then
begin
ClearForm;
txtFileName.Text:= ofdFileName.FileName;
end;
end;

VB:

Imports System.Security.Cryptography
Imports System.IO

Public Class frmMain

Private Sub btnFile_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnFile.Click
If ofdFileName.ShowDialog Then
ClearForm()
txtFileName.Text = ofdFileName.FileName
End If
End Sub

Private Sub txtFileName_TextChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles txtFileName.TextChanged
ToolTip1.SetToolTip(txtFileName, txtFileName.Text)
End Sub

Private Sub ClearForm()
txtSHA1.Text = ""
txtSHA256.Text = ""
txtSHA512.Text = ""
End Sub

Private Sub btnCalculate_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnCalculate.Click
Dim myCursor As Cursor
Dim oFileStream As System.IO.FileStream
Dim lBytes As Long
Dim result() As Byte

myCursor = Cursor
Cursor = Cursors.WaitCursor
Try

If Not (txtFileName.Text = "") Then
ErrorProvider1.Clear() 'Introduced .NET 2.0

Dim instance As New FileInfo(txtFileName.Text)
oFileStream = instance.OpenRead()
lBytes = oFileStream.Length
Dim filecontents(lBytes) As Byte
oFileStream.Read(filecontents, 0, lBytes)
oFileStream.Close()

Dim sha1M As New SHA1Managed
result = sha1M.ComputeHash(filecontents)
txtSHA1.Text = Convert.ToBase64String(result)

Dim sha256M As New SHA256Managed
result = sha256M.ComputeHash(filecontents)
txtSHA256.Text = Convert.ToBase64String(result)

Dim sha512M As New SHA512Managed
result = sha512M.ComputeHash(filecontents)
txtSHA512.Text = Convert.ToBase64String(result)
Else
ErrorProvider1.SetError(btnFile, "Select a filename")
End If

Catch ex As Exception
MessageBox.Show(ex.Message, ex.Source, MessageBoxButtons.OK, MessageBoxIcon.Error)

Finally
Cursor = myCursor
End Try
End Sub

End Class

This is another post done with Live Writer, I think it is pretty 'groovy'.

TShellExecuteInfo

In keeping with the posting of old sample snippets in my projects folder; ShellExecuteEx can be used to perform an action such as edit, print, open or properties display on a file. A ShellExecuteInfo structure is passed to the ShellExecuteEx function. A sample of how to display a file's properties dialog is as follows:



uses
ShellAPI;
procedure MyShellExecuteInfo(const filename: string; iVerb: integer);
var
sei: TShellExecuteInfo;
Buffer: array[0..MAX_PATH] of Char;
begin
FillChar(sei,sizeof(sei),0);
sei.cbSize:= sizeof(sei);
sei.lpFile:= PAnsiChar(filename);
// sei.lpDirectory and sei.lpIDList
Case iVerb of
0: sei.lpVerb:= 'properties';
1: sei.lpVerb:= 'open';
2: sei.lpVerb:= 'edit';
3: sei.lpVerb:= 'explore';
4: sei.lpVerb:= 'print';
end;
sei.fMask:= SEE_MASK_INVOKEIDLIST;
sei.nShow:= SW_SHOWNORMAL;
ShellExecuteEx(@sei);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
MyShellExecuteInfo(FileEdit1.Text,RadioGroup1.ItemIndex);
end;

That Special Folder

I am now on my second post with Windows Live Write, I think I'll stick with for a bit to see how it works out for me. As I was browsing through some of the code samples I put together for me to experiment (or whatever other reason I had for putting something together) I had come across this one for SHGetSpecialFolderPath. This may be a long post, but it is fairly straight forward.

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ShlObj, ShLwApi;

const
// Some redefined for readability
CSIDL_DESKTOP= $0000;
CSIDL_PROGRAMS= $0002;
CSIDL_CONTROLS= $0003;
CSIDL_PRINTERS= $0004;
CSIDL_FAVORITES= $0006;
CSIDL_STARTUP= $0007;
CSIDL_RECENT= $0008;
CSIDL_SENDTO= $0009;
CSIDL_DESKTOPDIRECTORY= $0010;
CSIDL_DRIVES= $0011;
CSIDL_NETHOOD= $0013;
CSIDL_FONTS= $0014;
CSIDL_COMMON_DOCUMENTS= $002E;
CSIDL_COMMON_FAVORITES= $001F;
CSIDL_BITBUCKET= $000A;
CSIDL_STARTMENU= $000B;
CSIDL_MYMUSIC= $000D;
CSIDL_COMMON_STARTMENU= $0016;
CSIDL_COMMON_PROGRAMS= $0017;
CSIDL_COMMON_STARTUP= $0018;
CSIDL_COMMON_DESKTOPDIRECTORY= $0019;
CSIDL_ALTSTARTUP= $0001D;
CSIDL_COMMON_ALTSTARTUP= $001E;
CSIDL_COOKIES= $0021;
CSIDL_HISTORY= $0022;
CSIDL_COMMON_TEMPLATES= $002D;
CSIDL_COMPUTERSNEARME= $003D;
CSIDL_CONNECTIONS= $0031;
CSIDL_PRINTHOOD= $001B;
CSIDL_TEMPLATES= $0015;
CSIDL_APPDATA= $0001A; //Version 4.71
CSIDL_INTERNET_CACHE= $0020; //Version 4.72
CSIDL_LOCAL_APPDATA= $001C; //Version 5.0
CSIDL_COMMON_ADMINTOOLS= $002F; //Version 5.0
CSIDL_ADMINTOOLS= $0030; //Version 5.0
CSIDL_COMMON_APPDATA= $0023; //Version 5.0
CSIDL_WINDOWS= $0024; //Version 5.0
CSIDL_SYSTEM= $0025; //Version 5.0
CSIDL_PROGRAM_FILES= $0026; //Version 5.0
CSIDL_MYPICTURES= $0027; //Version 5.0
CSIDL_PROFILE= $0028; //Version 5.0
CSIDL_PROGRAM_FILES_COMMON= $002B; //Version 5.0
CSIDL_MYVIDEO= $000E; //Version 6.0
CSIDL_PERSONAL= $0005; //Version 6.0
CSIDL_COMMON_MUSIC= $0035; //Version 6.0
CSIDL_COMMON_PICTURES= $0036; //Version 6.0
CSIDL_COMMON_VIDEO= $0037; //Version 6.0
CSIDL_CDBURN_AREA= $003B; //Version 6.0

type
TForm1 = class(TForm)
Edit1: TEdit;
Button1: TButton;
ListBox1: TListBox;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
Shlwapi_Ver: Real;
function Is471: Boolean;
function Is472: Boolean;
function Is5: Boolean;
function Is6: Boolean;
public
function
GetDLLVersionInfo(FileName: string): real;
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
i: integer;
pathname: array[0..MAX_PATH] of Char;
begin
i:= Integer(ListBox1.ItemIndex);
if not SHGetSpecialFolderPath(Handle, pathname, i, False) then
pathname:= 'UNKNOWN';

Edit1.Text:= pathname;
Edit1.Hint:= Edit1.Text;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Shlwapi_Ver:= GetDLLVersionInfo('Shlwapi.dll');
ListBox1.Items.AddObject('CSIDL_DESKTOP', TObject(CSIDL_DESKTOP));
ListBox1.Items.AddObject('CSIDL_PROGRAMS', TObject(CSIDL_PROGRAMS));
ListBox1.Items.AddObject('CSIDL_CONTROLS', TObject(CSIDL_CONTROLS));
ListBox1.Items.AddObject('CSIDL_PRINTERS', TObject(CSIDL_PRINTERS));
ListBox1.Items.AddObject('CSIDL_FAVORITES', TObject(CSIDL_FAVORITES));
ListBox1.Items.AddObject('CSIDL_STARTUP', TObject(CSIDL_STARTUP));
ListBox1.Items.AddObject('CSIDL_RECENT', TObject(CSIDL_RECENT));
ListBox1.Items.AddObject('CSIDL_SENDTO', TObject(CSIDL_SENDTO));
ListBox1.Items.AddObject('CSIDL_DESKTOPDIRECTORY', TObject(CSIDL_DESKTOPDIRECTORY));
ListBox1.Items.AddObject('CSIDL_DRIVES', TObject(CSIDL_DRIVES));
ListBox1.Items.AddObject('CSIDL_NETHOOD', TObject(CSIDL_NETHOOD));
ListBox1.Items.AddObject('CSIDL_FONTS', TObject(CSIDL_FONTS));
ListBox1.Items.AddObject('CSIDL_COMMON_DOCUMENTS', TObject(CSIDL_COMMON_DOCUMENTS));
ListBox1.Items.AddObject('CSIDL_COMMON_FAVORITES', TObject(CSIDL_COMMON_FAVORITES));
ListBox1.Items.AddObject('CSIDL_BITBUCKET', TObject(CSIDL_BITBUCKET));
ListBox1.Items.AddObject('CSIDL_STARTMENU', TObject(CSIDL_STARTMENU));
ListBox1.Items.AddObject('CSIDL_MYMUSIC', TObject(CSIDL_MYMUSIC));
ListBox1.Items.AddObject('CSIDL_COMMON_STARTMENU', TObject (CSIDL_COMMON_STARTMENU));
ListBox1.Items.AddObject('CSIDL_COMMON_PROGRAMS', TObject(CSIDL_COMMON_PROGRAMS));
ListBox1.Items.AddObject('CSIDL_COMMON_STARTUP', TObject(CSIDL_COMMON_STARTUP));
ListBox1.Items.AddObject('CSIDL_COMMON_DESKTOPDIRECTORY', TObject(CSIDL_COMMON_DESKTOPDIRECTORY));
ListBox1.Items.AddObject('CSIDL_ALTSTARTUP', TObject(CSIDL_ALTSTARTUP));
ListBox1.Items.AddObject('CSIDL_COMMON_ALTSTARTUP', TObject(CSIDL_COMMON_ALTSTARTUP));
ListBox1.Items.AddObject('CSIDL_COOKIES', TObject(CSIDL_COOKIES));
ListBox1.Items.AddObject('CSIDL_HISTORY', TObject(CSIDL_HISTORY));
ListBox1.Items.AddObject('CSIDL_COMMON_TEMPLATES', TObject(CSIDL_COMMON_TEMPLATES));
ListBox1.Items.AddObject('CSIDL_COMPUTERSNEARME', TObject(CSIDL_COMPUTERSNEARME));
ListBox1.Items.AddObject('CSIDL_CONNECTIONS', TObject(CSIDL_CONNECTIONS));
ListBox1.Items.AddObject('CSIDL_PRINTHOOD', TObject(CSIDL_PRINTHOOD));
ListBox1.Items.AddObject('CSIDL_TEMPLATES', TObject(CSIDL_TEMPLATES));
if Is471 then
ListBox1.Items.AddObject('CSIDL_APPDATA', TObject(CSIDL_APPDATA));
if Is472 then
ListBox1.Items.AddObject('CSIDL_INTERNET_CACHE', TObject(CSIDL_INTERNET_CACHE));
if Is5 then
begin
ListBox1.Items.AddObject('CSIDL_LOCAL_APPDATA', TObject (CSIDL_LOCAL_APPDATA));
ListBox1.Items.AddObject('CSIDL_COMMON_ADMINTOOLS', TObject(CSIDL_COMMON_ADMINTOOLS));
ListBox1.Items.AddObject('CSIDL_ADMINTOOLS', TObject(CSIDL_ADMINTOOLS));
ListBox1.Items.AddObject('CSIDL_COMMON_APPDATA', TObject (CSIDL_COMMON_APPDATA));
ListBox1.Items.AddObject('CSIDL_WINDOWS', TObject(CSIDL_WINDOWS));
ListBox1.Items.AddObject('CSIDL_SYSTEM', TObject(CSIDL_SYSTEM));
ListBox1.Items.AddObject('CSIDL_PROGRAM_FILES', TObject (CSIDL_PROGRAM_FILES));
ListBox1.Items.AddObject('CSIDL_MYPICTURES', TObject(CSIDL_MYPICTURES));
ListBox1.Items.AddObject('CSIDL_PROFILE', TObject(CSIDL_PROFILE));
ListBox1.Items.AddObject('CSIDL_PROGRAM_FILES_COMMON', TObject(CSIDL_PROGRAM_FILES_COMMON));
end;
if is6 then
begin
ListBox1.Items.AddObject('CSIDL_MYVIDEO', TObject(CSIDL_MYVIDEO));
ListBox1.Items.AddObject('CSIDL_PERSONAL', TObject(CSIDL_PERSONAL));
ListBox1.Items.AddObject('CSIDL_COMMON_MUSIC', TObject(CSIDL_COMMON_MUSIC));
ListBox1.Items.AddObject('CSIDL_COMMON_PICTURES', TObject(CSIDL_COMMON_PICTURES));
ListBox1.Items.AddObject('CSIDL_COMMON_VIDEO', TObject(CSIDL_COMMON_VIDEO));
ListBox1.Items.AddObject('CSIDL_CDBURN_AREA', TObject(CSIDL_CDBURN_AREA));
end;
end;

function TForm1.GetDLLVersionInfo(FileName: string): real;
var
dllhandle: THandle;
myDllGetVersion: DllGetVersionProc;
dvi: TDllVersionInfo;
hr: HRESULT;
begin
dllhandle:= LoadLibrary(PAnsiChar(FileName));
if (handle=0) then
RaiseLastOSError;
try
myDllGetVersion:= GetProcAddress(dllhandle,'DllGetVersion');
if Assigned(myDllGetVersion) then
begin
FillChar(dvi, SizeOf(dvi), 0);
dvi.cbSize := SizeOf(dvi);
hr:= myDllGetVersion(dvi);
if hr = NOERROR then
Result:= dvi.dwMajorVersion + (dvi.dwMinorVersion/100)
else
Result:= 0;
end;
finally
FreeLibrary(dllhandle);
end;
end;

function TForm1.Is471: Boolean;
begin
Result:= Shlwapi_Ver >= 4.71;
end;

function TForm1.Is472: Boolean;
begin
Result:= Shlwapi_Ver >= 4.72;
end;

function TForm1.Is5: Boolean;
begin
Result:= Shlwapi_Ver >= 5.0;
end;

function TForm1.Is6: Boolean;
begin
Result:= Shlwapi_Ver >= 6.0;
end;

end.

A RT_BITMAP told me so

As hinted to in a previous post, there are many resources (images) contained within standard files on your computer. There are a number of ways to access these resources. You could use a program such as AIconExtract to extract the resources or you could simply access and load the resources at runtime. I was messing around and wanted to browse the image resources of standard files on my computer. A lot of files contain sized image resources strung together. I quickly came up with an ImageList Display application. This sample loads a bitmap resource into a TImageList and allows for the scrolling through the images in the imagelist. Rather than get too verbose, I’ll let the code do the talking.

type
TForm2 = class(TForm)
FileEdit1: TFileEdit;
ImageList1: TImageList;
ListBox1: TListBox;
Image1: TImage;
SpinEdit1: TSpinEdit;
StaticText1: TStaticText;
procedure FileEdit1Change(Sender: TObject);
procedure ListBox1Click(Sender: TObject);
procedure SpinEdit1Change(Sender: TObject);
procedure ListBox1KeyPress(Sender: TObject; var Key: Char);
private
procedure ClearImage;
procedure ClearImageList;
public
procedure
LoadBitmapNames(pFileName, pResType: PChar; Items: TStrings);
procedure AddResourceBitMaps(imagelist: TImageList; lpLibFileName: PChar;
const resname: string);
end;

var
Form2: TForm2;

implementation

resourcestring
StrUnableToOpen = 'Unable to open %s.';
StrDImagesInImage = '%d images in Imagelist.';
{$R *.dfm}

procedure TForm2.AddResourceBitMaps(imagelist: TImageList; lpLibFileName: PChar;
const resname: string);
var
handle: THandle;
bitmap: TBitMap;
MaskColor: TColor;
begin
handle := LoadLibrary(lpLibFileName);
if (handle=0) then
RaiseLastOSError;
bitmap:= TBitMap.Create;
try
bitmap.LoadFromResourceName(handle, resname);
imagelist.Height:= bitmap.Height;
imagelist.Width:= bitmap.Height;
MaskColor:= bitmap.Canvas.Pixels[0,bitmap.height-1];
imagelist.AddMasked(bitmap, MaskColor);
finally
bitmap.Free;
FreeLibrary(handle);
end;
end;

procedure TForm2.ClearImage;
begin
Image1.Picture.Graphic:= Nil;
end;

procedure TForm2.ClearImageList;
begin
ImageList1.Clear;
end;

procedure TForm2.FileEdit1Change(Sender: TObject);
begin
if
Sender is TFileEdit then
begin
SpinEdit1.Value:= 0;
ClearImage;
LoadBitmapNames(PAnsiChar(TFileEdit(Sender).Text), RT_BITMAP,
ListBox1.Items);
end;
end;

procedure TForm2.ListBox1Click(Sender: TObject);
var
i: Integer;
begin
if Sender is TListBox then
begin
if
TListBox(Sender).SelCount 0 then
begin
for i := 0 to TListBox(Sender).Count - 1 do
begin
if
TListBox(Sender).Selected[i] then
begin
ClearImage;
ClearImageList;
AddResourceBitMaps(ImageList1, PAnsiChar(FileEdit1.Text), TListBox(Sender).Items[i]);
StaticText1.Caption:= Format(StrDImagesInImage, [ImageList1.Count]);
SpinEdit1.MaxValue:= ImageList1.Count - 1;
SpinEdit1.MinValue:= 0;
SpinEdit1.Value:= 0;
SpinEdit1Change(Sender);
end;
end;
end;
end;
end;

procedure TForm2.ListBox1KeyPress(Sender: TObject; var Key: Char);
begin
ListBox1Click(Sender);
end;

function EnumResNameProc(hMod: THandle; ResType, ResName: pchar;
Lines: TStrings): boolean; stdcall;
var
dw: dword;
begin
dw := dword(ResName);
if (hiword(dw) = 0) then
Lines.Add('#'+IntToStr(dw))
else
Lines.Add(ResName);
Result:= True;
end;

procedure TForm2.LoadBitmapNames(pFileName, pResType: PChar; Items: TStrings);
var
FileHandle: THandle;
begin
Items.Clear;
FileHandle:= LoadLibraryEx(pFilename,0,LOAD_LIBRARY_AS_DATAFILE);
try
if (FileHandle = INVALID_HANDLE_VALUE) then
raise EAccessViolation.Create(Format(StrUnableToOpen, [pFileName]));
if (filehandle > 0) then
EnumResourceNames(FileHandle,pResType,@EnumResNameProc,longint(Items))
else
Items.Clear;
finally
FreeLibrary(FileHandle);
end;
end;


procedure TForm2.SpinEdit1Change(Sender: TObject);
begin
ClearImage;
ImageList1.GetBitmap(SpinEdit1.Value,Image1.Picture.Bitmap);
end;

end.


For those that are interested in some trivial stuff, the source can be downloaded HERE.

Reading Stuff

Information in this document subject to change without notice.
All Software source code published is for demonstration and knowledge sharing purposes only. The Code is supplied "as is" without warranty as to result, performance or merchantability. Use at your own risk.
The opinions expressed herein are the opinions of the author and do not reflect those of any other entity.