BPSoftware.com Blog

Monday, December 18, 2006

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;

Labels: .NET, Code, Delphi

posted by Brad Prendergast at 9:31:00 PM (0 comments)
Links to this post
Permalink

Sunday, December 17, 2006

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'.

Labels: .NET, Code, Delphi, VB.NET

posted by Brad Prendergast at 8:04:00 AM (0 comments)
Links to this post
Permalink

Wednesday, August 30, 2006

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;

Labels: Code, Delphi, WIN32

posted by Brad Prendergast at 6:43:00 AM (0 comments)
Links to this post
Permalink

Tuesday, August 29, 2006

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.

Labels: Code, Delphi, WIN32

posted by Brad Prendergast at 8:00:00 PM (1 comments)
Links to this post
Permalink

Sunday, August 27, 2006

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.

Labels: Code, Delphi, WIN32

posted by Brad Prendergast at 6:18:00 PM (0 comments)
Links to this post
Permalink

Tray it a bit easier

There are a number of neat components available when installing Borland Development Studio. Unfortunately, there are not always a lot of demos readily available for a quick reference for basic use. As I was browsing through some outdated applications I came across one that minimized to the system tray. I also recalled there is now a TTrayIcon installed with a base BDS install. The TTrayIcon component makes it a lot easier (and cuts out quite a bit of code) to minimize your application icon to the system tray.

type
TForm1 = class(TForm)
TrayIcon1: TTrayIcon;
procedure TrayIcon1Click(Sender: TObject);
private
procedure WMSysCommand(var Msg: TWMSysCommand); message WM_SYSCOMMAND;
end;

procedure TForm1.TrayIcon1Click(Sender: TObject);
begin
SendMessage(handle, WM_SYSCOMMAND, SC_RESTORE, 0);
end;

procedure TForm1.WMSysCommand(var Msg: TWMSysCommand);
begin
case Msg.CmdType of
SC_MINIMIZE: begin
Visible:= False;
TrayIcon1.Visible:= True;
end;
SC_RESTORE: begin
Visible:= True;
TrayIcon1.Visible:= False;
end;
else
Inherited;
end;
end;

Labels: Code, Delphi, WIN32

posted by Brad Prendergast at 7:24:00 AM (0 comments)
Links to this post
Permalink

Sunday, August 20, 2006

Ye Old TFileEdit

I am in the process of going through some old code snippets. I am updating a lot of things here and there. One thing that I have just made some changes to is the TFileEdit component that I've had available for a few years. I have made some changes to the property editor and classed the DialogOptions instead of having them as options that appear as part of the editor.

Labels: Components, Delphi

posted by Brad Prendergast at 10:36:00 AM (0 comments)
Links to this post
Permalink

Friday, July 28, 2006

TypInfo is cool!

uses
TypInfo;

type
TColorState = (CS_Red, CS_Blue, CS_Green);

procedure TForm1.Button1Click(Sender: TObject);
var
colorstate: TColorState;
begin
ColorState:= TColorState(GetEnumValue(TypeInfo(TColorState),'CS_Red'));
Edit1.Text:= GetEnumName(TypeInfo(TColorState), Ord(ColorState));
end;

Labels: Code, Delphi, WIN32

posted by Brad Prendergast at 8:18:00 AM (1 comments)
Links to this post
Permalink

Sunday, July 23, 2006

Having a little fun and getting a Callback

Callback functions allow a developer to create customized code for ‘standard calls’ from within an application. Callback functions are implemented throughout Windows applications and can be used to perform various tasks. The same callback function can be called with different ‘custom function’ references throughout an application. Two examples of callback functions are the EnumWindows and EnumChildProc Functions.

First create the functions that are passed to the callback function. For example:

//from MSDN:
// GetClassName
// The GetClassName function retrieves the name of the class to which the
// specified window belongs.

// GetWindowText
// The GetWindowText function copies the text of the specified window's title
// bar (if it has one) into a buffer. If the specified window is a control,
// the text of the control is copied. However, GetWindowText cannot retrieve
// the text of a control in another application.

// The IsWindowVisible
// The IsWindowVisible function retrieves the visibility state of the
// specified window.

function EnumWindowsProc(Handle: HWND; AppVal: LongInt): BOOL; stdcall;
var
WindowName: Array[0..255] of Char;
ClassName: Array[0..255] of Char;
begin
if IsWindowVisible(Handle) then
begin
GetClassName(Handle,ClassName,SizeOf(ClassName));
GetWindowText(Handle,WindowName,SizeOf(WindowName));
//you could do something more with the information here
end;
end;

function EnumChildWindowsProc(Handle: HWND; AppVal: LongInt): BOOL; stdcall;
var
WindowName: Array[0..255] of Char;
ClassName: Array[0..255] of Char;
begin
if IsWindowVisible(Handle) then
begin
GetClassName(Handle,ClassName,SizeOf(ClassName));
GetWindowText(Handle,WindowName,SizeOf(WindowName));
//you could do something more with the information here
end;
end;

In order to you the callback functions you pass your ‘custom functions’:

EnumWindows(@EnumWindowsProc,LPARAM(Self));

// Handle is the parent window whose child windows are to be enumerated.
EnumChildWindows(Handle,@EnumChildWindowsProc,LPARAM(Self));

Having a little fun I put together a little application that enumerates through visible parent

and child windows. These windows are added to a TreeView, which then the text of the window retrieved or set. The text is retrieved and set by sending a WM_GETTEXT or WM_SETTEXT to the window handle. As you can see from the screenshot you can have a little fun with this. You can even have your own finish button.

Using callback functions in classes can also be accomplished. The LPARAM parameter is application defined. This parameter can be used to pass ‘whatever you want’ into the callback function. For the above program I created a class that enumerated the windows and stored them in a list. The class listing is as follows:

type

TMyWindowObject= class(TObject)
private
FClassName: string;
FWindowHandle: HWND;
FWindowName: string;
public
property WindowClassName: string read FClassName write FClassName;
property WindowHandle: HWND read FWindowHandle write FWindowHandle;
property WindowName: string read FWindowName write FWindowName;
function GetWindowText:string;
procedure SetWindowText(text: string);
procedure CloseWindow;
end;

TMyWindows = class(TObject)
Public
WindowList: TList;
procedure AddWindowObject(Handle: HWND);
constructor Create;
destructor Destroy;override;
procedure ClearList;
function GetChildWindows(Handle: Integer): Boolean;
function GetWindows: Boolean;
end;

implementation

function EnumChildWindowsProc2(Handle: HWND; ctrlHWND: Integer): BOOL; stdcall;
begin
if IsWindowVisible(Handle) then
begin
TMyWindows(ctrlHWND).AddWindowObject(Handle);
end;
end;

function EnumWindowsProc2(Handle: HWND; ctrlHWND: Integer): BOOL; stdcall;
begin
if IsWindowVisible(Handle) then
begin
TMyWindows(ctrlHWND).AddWindowObject(Handle);
end;
end;

{ TMyWindows }

procedure TMyWindows.ClearList;
var
i: Integer;
begin
for i := WindowList.Count - 1 downto 0 do
begin
TMyWindowObject(WindowList.Items[i]).Free;
end;
WindowList.Clear;
end;

constructor TMyWindows.Create;
begin
inherited;
WindowList:= Tlist.Create;
end;

destructor TMyWindows.Destroy;
begin
ClearList;
WindowList.Free;
inherited;
end;

procedure TMyWindows.AddWindowObject(Handle: HWND);
var
WindowName: Array[0..255] of Char;
ClassName: Array[0..255] of Char;
MyWindowObject: TMyWindowObject;
begin
MyWindowObject:= TMyWindowObject.Create;
GetClassName(Handle,ClassName,SizeOf(ClassName));
GetWindowText(Handle,WindowName,SizeOf(WindowName));
MyWindowObject.WindowHandle:= Handle;
MyWindowObject.WindowClassName:= ClassName;
MyWindowObject.WindowName:= WindowName;
WindowList.Add(MyWindowObject);
end;

function TMyWindows.GetChildWindows(Handle: Integer): Boolean;
begin
ClearList;
GetChildWindows:= EnumChildWindows(Handle,@EnumChildWindowsProc2,LPARAM(Self));
end;

function TMyWindows.GetWindows: Boolean;
begin
ClearList;
GetWindows:= EnumWindows(@EnumWindowsProc2,LPARAM(Self));
end;

{ TMyWindowObject }

procedure TMyWindowObject.CloseWindow;
begin
PostMessage(FWindowHandle,WM_CLOSE,0,0);
end;

function TMyWindowObject.GetWindowText: string;
var
iLen: Integer;
strText: string;
begin
iLen:= SendMessage(FWindowHandle,WM_GETTEXTLENGTH,0,0);
SetLength(strText,iLen);
SendMessage(FWindowHandle,WM_GETTEXT, iLen + 1,lParam(PChar(strText)));
Result:= strText;
end;

procedure TMyWindowObject.SetWindowText(text: string);
begin
SendMessage(FWindowHandle,WM_SETTEXT,0,Longint(text));
end;

end.

Labels: Code, Delphi, WIN32

posted by Brad Prendergast at 5:30:00 PM (1 comments)
Links to this post
Permalink

Saturday, July 08, 2006

Who does not like cookies?

As I was doing some odd exploration of an older ASP application I decided to do some experimentation with cookies. As with most of my posts I try to drop things back significantly allowing for some basic examples. Cookies are a way for a web application to store specific information. Cookies are small text files that are stored on a client machine and are contained in the Response and Request traffic between a client and host computer. Web applications can read cookies whenever a user visits the site. Information such as user preferences could be stored in a cookie.

Within .NET there the HttpCookie Class is used for dealing with cookie information. Basic dealing with cookies is a lot easier than it may initially sound. I was able to put together a sample application that stores a textbox, validated textbox and calendar date (cookies store strings) in a cookie in only a few minutes.

Start a new ASP.NET Web Application from within BDS2006. On the default design form place a two text boxes, a calendar control, a RegularExpressionValidator and three buttons. I also placed some labels for identification.

Label1: System.Web.UI.WebControls.Label;
txtName: System.Web.UI.WebControls.TextBox;
btnWrite: System.Web.UI.WebControls.Button;
btnRead: System.Web.UI.WebControls.Button;
btnClear: System.Web.UI.WebControls.Button;
Calendar1: System.Web.UI.WebControls.Calendar;
txtEmail: System.Web.UI.WebControls.TextBox;
Label3: System.Web.UI.WebControls.Label;
RegularExpressionValidator1: System.Web.UI.WebControls.RegularExpressionValidator;
Label4: System.Web.UI.WebControls.Label;

Set the properties for RegularExpression1 as follows:

// This checks for a proper email address
ValidationExpression:= ‘\w+([-+.]\w+)*@\w+([-.]\w+)*\.\w+([-.]\w+)*’;
ControlToValidate:= txtEmail;
ErrorMessage:= ‘Invalid Email’;

The following is the code behind the page (For maintenance, I’d use constants for the value and cookie names):

procedure TWebForm1.Page_Load(sender: System.Object; e: System.EventArgs);
begin
// The calendar defaults to a selected date of 01/01/0001
if Calendar1.SelectedDate = DateTime.Parse('01/01/0001') then
Calendar1.SelectedDate:= DateTime.Now;
end;

procedure TWebForm1.btnClear_Click(sender: System.Object; e: System.EventArgs);
var
hc: HttpCookie;
begin
if Request.Cookies['MySite'] <> nil then
begin
hc:= Request.Cookies['MySite'];
// This method may work, however the proper way to clear a cookie
// is to set the cookie to have a prior expiration date
// hc.Values.Clear;
// Response.Cookies.Add(hc);
// Calendar1.SelectedDate:= DateTime.Now;
hc.Expires:= DateTime.Now.AddDays(-100);
txtName.Text:='';
txtEmail.Text:= '';
Calendar1.SelectedDate:= DateTime.Now;
end;
end;

procedure TWebForm1.btnRead_Click(sender: System.Object; e: System.EventArgs);
var
hc: HttpCookie;
begin
if Request.Cookies['MySite'] <> nil then
begin
txtEmail.Text:= Request.Cookies['MySite'].Values['email'];
txtName.Text:= Request.Cookies['MySite'].Values['name'];
Calendar1.SelectedDate:= DateTime.Parse(Request.Cookies['MySite'].Values['date']);
end
else
begin
txtEmail.Text:= '';
txtName.Text:= '';
Calendar1.SelectedDate:= DateTime.Now;
end;
end;

procedure TWebForm1.btnWrite_Click(sender: System.Object; e: System.EventArgs);
var
hc: HttpCookie;
begin
if RegularExpressionValidator1.IsValid then
begin
hc:= HttpCookie.Create('MySite');
hc.Values['name']:= txtName.Text;
hc.Values['email']:= txtEmail.Text;
hc.Values['date']:= Calendar1.SelectedDate.ToShortDateString;
// Expire cookie in 1hour. Always set an expiration
// if you do not set an expiration date the cookie is not
// stored; it will be treated as a session variable
// DateTime.MaxValue will make it last forever
hc.Expires:= DateTime.Now.AddHours(1);
Response.Cookies.Add(hc);
end;
end;

For some more information take a look at ASP.NET Cookies Overview on MSDN. Another valuable link is How to Share Session State Between Classic ASP and ASP.NET.

Labels: .NET, ASP.NET, Code, Delphi

posted by Brad Prendergast at 6:47:00 PM (0 comments)
Links to this post
Permalink

Saturday, July 01, 2006

DayLightTime

In an attempt to better understand what’s available and come up with new ways of doing things, I often browse through various class definitions. As I was browsing through some classes this morning, I came across the DaylightTime Class. The DaylightTime Class is part of the System.Globalization namespace. This class is used to define the period of daylight-savings time. The GetDaylightChanges Method of the TimeZone Class returns a timezone’s DaylightTime for a specified year. This may not all sound so interesting, however using this in an ASP.NET application a semi-useful utility can be developed. This example also shows how to dynamically work with a System.Web.UI.WebControls.Table Class. Dynamically created table data is not persistent and would need to be ‘refreshed’ on each postback page display. In this example I just use one row for displaying a year’s calculation. A System.Web.UI.WebControls.RangeValidator is also used in this demonstration. Check out my new DayLightTime Display.

In the page class:

public
localzone: TimeZone;
daylight: System.Globalization.DaylightTime;
tr: TableRow;
tcYear,
tcStart,
tcEnd,
tcChange: TableCell;

procedure TWebForm1.Page_Load(sender: System.Object; e: System.EventArgs);
begin
localzone:= TimeZone.CurrentTimeZone;
lblTimeZone.Text:= localzone.StandardName;
//txtYear.Text:= '1999';
end;

procedure TWebForm1.btnProcess_Click(sender: System.Object; e: System.EventArgs);
var
year: Integer;
begin
if RangeValidator1.IsValid then
begin
try
year:= Convert.ToInt32(txtYear.Text);
except
//dynamically setting it to the current year
//is also an option
year:= 2006;
txtYear.Text:= year.ToString;
end;
tblOutput.Rows.Add(CreateDaylightRow(year));
end;
end;

function TWebForm1.CreateDaylightRow(year: integer): TableRow;
begin
daylight:= localzone.GetDaylightChanges(year);

tr:= TableRow.Create;

tcYear:= TableCell.Create;
tcStart:= TableCell.Create;
tcEnd:= TableCell.Create;
tcChange:= TableCell.Create;

tcYear.Text:= year.ToString;
tr.Cells.Add(tcYear);

tcStart:= TableCell.Create;
tcStart.HorizontalAlign:= HorizontalAlign.Right;
tcStart.Text:= daylight.Start.ToString('yyyy-MM-dd HH:mm');
tr.Cells.Add(tcStart);

tcEnd:= TableCell.Create;
tcEnd.HorizontalAlign:= HorizontalAlign.Right;
tcEnd.Text:= daylight.&End.ToString('yyyy-MM-dd HH:mm');
tr.Cells.Add(tcEnd);

tcChange:= TableCell.Create;
tcChange.HorizontalAlign:= HorizontalAlign.Right;
tcChange.Text:= daylight.Delta.ToString;
tr.Cells.Add(tcChange);

Result:= tr;
end;

Labels: .NET, ASP.NET, Code, Delphi

posted by Brad Prendergast at 8:50:00 AM (0 comments)
Links to this post
Permalink

Saturday, June 24, 2006

Conversion Utility

The conversion utility I posted about a few months back is accessible HERE. Feel free to use this tool to assist with unit conversions you need to solve.

Labels: .NET, ASP.NET, Code, Delphi

posted by Brad Prendergast at 4:28:00 PM (0 comments)
Links to this post
Permalink

Thursday, May 25, 2006

Local Computer Adapter Information

Most computers today have some sort of adapter for connecting to a network. It is often desirable to retrieve the local computer’s adapter information. The .NET Framework version 2.0 has the System.Net.NetworkInformation namespace to provide easy access to this and a lot of other adapter information. In the WIN32 world there is the Internet Protocol Helper (IP Helper), specifically the GetAdaptersInfo function. If you are using BDS® 2006 (or earlier versions) grab the IP Helper API from the JEDI Project (there is a lot of work in that project and we should all thank the contributors of that project).

With the IP Helper wrapper, getting the local adapter information is as easy as:

uses
IpHlpApi, IpTypes;

procedure RetrieveLocalAdapterInformation(strings: TStrings);
var
pAdapterInfo: PIP_ADAPTER_INFO;
AdapterInfo: IP_ADAPTER_INFO;
BufLen: DWORD;
Status: DWORD;
strMAC: String;
i: Integer;
begin
strings.Clear;

BufLen:= sizeof(AdapterInfo);
pAdapterInfo:= @AdapterInfo;

Status:= GetAdaptersInfo(nil, BufLen);
pAdapterInfo:= AllocMem(BufLen);

try
Status:= GetAdaptersInfo(pAdapterInfo, BufLen);

if (Status <> ERROR_SUCCESS) then
begin
case Status of
ERROR_NOT_SUPPORTED:
strings.Add('GetAdaptersInfo is not supported by the operating ' +
'system running on the local computer.');
ERROR_NO_DATA:
strings.Add('No network adapter on the local computer.');
else
strings.Add('GetAdaptersInfo failed with error #' + IntToStr(Status));
end;
Exit;
end;

while (pAdapterInfo <> nil) do
begin
strings.Add('Description: ' + pAdapterInfo^.Description);
strings.Add('Name: ' + pAdapterInfo^.AdapterName);

strMAC := '';
for I := 0 to pAdapterInfo^.AddressLength - 1 do
strMAC := strMAC + '-' + IntToHex(pAdapterInfo^.Address[I], 2);
Delete(strMAC, 1, 1);
strings.Add('MAC address: ' + strMAC);
strings.Add('IP address: ' + pAdapterInfo^.IpAddressList.IpAddress.S);
strings.Add('Gateway: ' + pAdapterInfo^.GatewayList.IpAddress.S);
strings.Add('DHCP enabled: ' + IntTOStr(pAdapterInfo^.DhcpEnabled));
strings.Add('DHCP: ' + pAdapterInfo^.DhcpServer.IpAddress.S);
strings.Add('Have WINS: ' + BoolToStr(pAdapterInfo^.HaveWins,True));
strings.Add('Primary WINS: ' + pAdapterInfo^.PrimaryWinsServer.IpAddress.S);
strings.Add('Secondary WINS: ' + pAdapterInfo^.SecondaryWinsServer.IpAddress.S);

pTempAdapterInfo := pAdapterInfo;
pAdapterInfo:= pAdapterInfo^.Next;
Dispose(pTempAdapterInfo);
end;
finally
Dispose(pAdapterInfo);
end;
end;

Note: Responding to a newsgroup posting gave me the idea of posting this blog message.

Labels: .NET, Code, Delphi

posted by Brad Prendergast at 7:10:00 AM (0 comments)
Links to this post
Permalink

Sunday, May 21, 2006

Event Log (Part 2)

In a previous post, I had mentioned that I needed something with a little more ‘oomph’ than the ‘standard’ Windows® Event Viewer. After giving some thought to what type of application to write, I began to contemplate how I was going to access the EventLogs on various machines. For this task I decided to give the EventLog Class a shot. The EventLog Class is found in the System.Diagnostics namespace. During my ‘exploration’ via creating a basic application, I was pleasantly surprised at how easy and fast I was able to create a basic yet functional EventLog Viewer.

Using BDS® 2006 (and yes, I also created a version with VB.NET using Visual Studio® 2005 -- I wanted to work with some of the .NET 2.0 changes to the EventLog Class -- I’ll post that code later), I created a new Windows Form Application.

For this basic application I placed an ImageList, TreeView, ListView and RichTextBox (separated by splitters to allow for sizing) onto the form. The ‘basic application’ concept was to display the available Event Logs for a computer in the TreeView. When an event log is selected within the TreeView, the ListView displays the selected EventLlog's entries. When and entry is selected in the ListView, the ‘event’ message is displayed in the RichTextBox. I had placed some images in the ImageList to cosmetically spruce things up a bit.

Here is the gist of some simple code: (Minor property adjustments and event assignments are not listed, but should be obvious)

const
//Image constants- the image locations in the ImageList
COMPUTERIMG= 0;
LOGIMG= 2;
ERRORIMG= 3;
WARNINGIMG= 4;
INFOIMG= 5;
AUDITIMG= 6;

type
stringarray= array of string;

// In the TWinForm class of the new form
private
strSelEvtLogName: string;
strSelComputerName: string;
procedure AddComputer(mytreeview: TreeView; computername: string);
procedure AppendLogMessage(myrichtextbox: RichTextBox; logname: string;
computername: string; index: Integer);
procedure DisplayLogEntries(mylistview: ListView; logname: string;
computername: string);
function GetEventLogNames(computername: string):stringarray;

// The class code
procedure TWinForm.DisplayLogEntries(mylistview: ListView; logname,
computername: string);
var
e: EventLog;
entry: EventLogEntry;
listitem: ListViewItem;
oldCursor: System.Windows.Forms.Cursor;
begin
e:= EventLog.Create(logname, computername);
oldCursor:= Cursor;
Cursor:= Cursors.WaitCursor;

mylistview.BeginUpdate;
mylistview.Items.Clear;

for entry in e.Entries do
begin
// Set the image index for the entry type
Case entry.EntryType of
EventLogEntryType.Error: begin // 1
listitem:= mylistview.Items.Add('Error');
listitem.ImageIndex:= ERRORIMG;
end;
EventLogEntryType.FailureAudit: begin // 16
listitem:= mylistview.Items.Add('Failure Audit');
listitem.ImageIndex:= AUDITIMG;
end;
EventLogEntryType.Information: begin // 4
listitem:= mylistview.Items.Add('Information');
listitem.ImageIndex:= INFOIMG;
end;
EventLogEntryType.SuccessAudit: begin // 8
listitem:= mylistview.Items.Add('Success Audit');
listitem.ImageIndex:= AUDITIMG;
end;
EventLogEntryType.Warning: begin // 2
listitem:= mylistview.Items.Add('Warning');
listitem.ImageIndex:= WARNINGIMG;
end;
end;

listitem.SubItems.Add(entry.TimeGenerated.ToLocalTime.ToString);
listitem.SubItems.Add(entry.Source);
listitem.SubItems.Add(entry.Category);

// The EventID property has been deprecated. in 2.0
listitem.SubItems.Add(entry.EventID.ToString);

// Note: The InstanceId property is new in the .NET Framework version 2.0.
//listitem.SubItems.Add(entry.InstanceId);

listitem.SubItems.Add(entry.UserName);
listitem.SubItems.Add(entry.MachineName);

//Remarks: Index is not necessarily zero-based. I love stuff like this
listitem.SubItems.Add(entry.Index.ToString);
end;

mylistview.EndUpdate;
Cursor:= oldCursor;

end;

procedure TWinForm.AddComputer(mytreeview: TreeView; computername: string);
var
strNames: stringarray;
strMy: string;
computernode,lognode: TreeNode;
begin
// Get a list of the event logs for a computer
strNames:= GetEventLogNames(computername);

computerNode:= mytreeview.Nodes.Add(computername);
computerNode.ImageIndex:= COMPUTERIMG;
for strMy in strNames do
begin
logNode:= computerNode.Nodes.Add(strMy);
logNode.ImageIndex:= LOGIMG;
logNode.SelectedImageIndex:= logNode.ImageIndex;
end;
end;

procedure TWinForm.AppendLogMessage(myrichtextbox: RichTextBox; logname,
computername: string; index: Integer);
var
e: EventLog;
entry: EventLogEntry;
begin
e:= EventLog.Create(logname, computername);
entry:= e.Entries.Item[index];
myrichtextbox.AppendText(entry.Message);
end;

function TWinForm.GetEventLogNames(computername: string):stringarray;
var
c: Integer;
eventlogs: array of EventLog;
e: EventLog;
strNames: stringarray;
begin
c:= 0;
eventlogs:= EventLog.GetEventLogs(computername);

// Resize the array to number of eventlog names
SetLength(strNames, High(eventlogs)+1);

// Loop through the eventlogs and get the names
for e in eventLogs do
begin
strNames[c]:= e.LogDisplayName;
c:= c + 1;
end;

result:= strNames;
end;

procedure TWinForm.TreeView1_AfterSelect(sender: System.Object; e: System.Windows.Forms.TreeViewEventArgs);
var
myTreeView: TreeView;
myNode: TreeNode;
myParentNode: TreeNode;
begin
if sender is TreeView then
begin
myTreeView:= sender as TreeView;
myNode:= myTreeView.SelectedNode;
if (myNode.Parent <> Nil) then
begin
myParentNode:= myTreeView.SelectedNode.Parent;
strSelEvtLogName:= myNode.Text;
strSelComputerName:= myParentNode.Text;
DisplayLogEntries(ListView1, strSelEvtLogName, strSelComputerName);
end
else
begin
ListView1.Items.Clear;
end;
end;
end;

procedure TWinForm.ListView1_SelectedIndexChanged(sender: System.Object; e: System.EventArgs);
var
myItem: ListViewItem;
mySubItem: ListViewItem.ListViewSubItem;
index: Integer;
begin
RichTextBox1.Clear;
for myItem in ListView1.SelectedItems do
begin
index:= myItem.Index;
//mySubItem:= myItem.SubItems.Item[7];
//index:= Convert.ToInt32(mySubItem.Text) - 1;
AppendLogMessage(RichTextBox1, strSelEvtLogName, strSelComputerName, index);
end;
end;

procedure TWinForm.TWinForm_Load(sender: System.Object; e: System.EventArgs);
begin
// Add information for the local computer
AddComputer(TreeView1, SystemInformation.ComputerName);
// Expand display
TreeView1.ExpandAll;
end;

The writing of an event to a log looks just as simple, although I haven't had the opportunity to play with that yet.

Labels: .NET, Code, Delphi

posted by Brad Prendergast at 6:02:00 PM (0 comments)
Links to this post
Permalink

Sunday, May 14, 2006

myCursor Template

Well, for a brief moment, it seems I can come out from underneath the ~~rock~~ mountain that was placed atop my head. The more I use them, the more I like the code templates that are part of BDS® 2006. They can be a great savings when it comes to those repetetive 'code blocks'. Not only is the 'code block' inserted, but you can also have some dynamic content in them as well with the help of good the good ole' SyncEdit.
Generally, when I code a processing procedure/function I prefer to change the cursor to signify that something is 'happening' to the user. I often use the following code:

var
myCursor: TCursor;
begin
myCursor:= Screen.Cursor;
Screen.Cursor:= crHourglass;
try

finally
Screen.Cursor:= myCursor;
end;
end;

This code is simple enough, however it becomes easier with a good old 'scr' template. As you can see creating templates is rather simple and a great time saver.

Labels: Code, Delphi

posted by Brad Prendergast at 12:00:00 PM (3 comments)
Links to this post
Permalink

Wednesday, April 12, 2006

ErrorProvider

For some reason one of my favorite .NET Framework Class is the ErrorProvider class. This class allows you to visually indicate to the user that there is an error with one of the form controls. For example, if you have a user input form that allows the user to input information into a TextBox and the user tries to proceed without filling in the TextBox you can set the ErrorProvider to display an error icon, with an error hint, adjacent to the TextBox. The option of setting the BlinkStyle and BlinkRate is also neat.

A real simple example:

procedure TWinForm.Button1_Click(sender: System.Object; e: System.EventArgs);
begin
if TextBox1.text = '' then
ErrorProvider1.SetError(TextBox1,'Invalid Text Entered.')
else
ErrorProvider1.SetError(TextBox1,'');
end;