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;

It is pretty basic and simple to use, but for some reason I am fascinated by it.

Labels: .NET, Code, Delphi

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

Sunday, April 09, 2006

Where is the registry in .NET?

Back in January, I posted about retrieving system Time Zone Information. Without going into a verbose explanation of why, I decided to move the application that utilizes this code to .NET. In the process of moving this application ‘forward’ (Is moving to .NET considered going forward?) I got the impression that the registry might have lost some importance in .NET. What is the basis for my initial feeling? Well, first take a guess at the namespace where Registry access resides…. If you guessed Microsoft.Win32 you guess right.

With that being said, and not dwelling on the fact that they places registry access into the Win32 namespace (don't forget to put that in your uses clause) I went ahead and created a new WinForm application with a System.Windows.Forms.ComboBox (cbxTimeZone) and System.Windows.Forms.TextBox (txtOutput). I changed the Multiline property of the TextBox to True and set it to ReadOnly.

I changed up the code as follows:

const
basetzikey = 'SOFTWARE\Microsoft\Windows NT\CurrentVersion\Time Zones\';

procedure TWinForm.FillComboBox(cbxCombo: ComboBox);
var
rootkey: RegistryKey; //Microsoft.Win32.RegistryKey
subkeynames: array of string;
subkeyname: string;
begin
cbxCombo.Items.Clear;
rootkey:= Registry.LocalMachine;
subkeynames:= rootkey.OpenSubKey(basetzikey,false).GetSubKeyNames;
for subkeyname in subkeynames do
cbxCombo.Items.Add(subkeyname.ToString);
end;

procedure TWinForm.FillTextEdit(timezone: string; txtEdit: TextBox);
type
bytearray= array[] of byte;
var
sb: System.Text.StringBuilder;
rootkey: RegistryKey; //Microsoft.Win32.RegistryKey
subkeyvalues: array of string;
subkeyvalue: string;
keyname: string;
b: bytearray;
i: Smallint;

begin
txtEdit.Clear;

sb:= StringBuilder.Create;
sb.Append(basetzikey);
sb.Append(timezone);
keyname:= sb.ToString;

sb.Remove(0, sb.Length);

rootkey:= Registry.LocalMachine;
subkeyvalues:= rootkey.OpenSubKey(keyname,false).GetValueNames;
for subkeyvalue in subkeyvalues do
begin
sb.Remove(0, sb.Length);
sb.Append(subkeyvalue);
sb.Append(': ');
sb.Append(rootkey.OpenSubKey(keyname,false).GetValue(subkeyvalue).ToString);
sb.Append(#13#10);
if subkeyvalue = 'TZI' then
begin
// you could reporduce the TIME_ZONE_INFORMATION record
// I am just looking for the BIAS which is the first two bytes
// of the structure
b:= bytearray(rootkey.OpenSubKey(keyname,false).GetValue(subkeyvalue));// as bytearray;
i:= b[1] shl 8;
i:= i + b[0];
sb.Append('Bias: ' );
sb.Append(i);
sb.Append(' minutes.');
sb.Append(#13#10);
end;
txtedit.AppendText(sb.ToString);
end;
end;

procedure TWinForm.cbxTimeZone_SelectedIndexChanged(sender: System.Object; e: System.EventArgs);
begin
FillTextEdit(ComboBox(sender).Text,txtOutput);
end;

constructor TWinForm.Create;
begin
inherited Create;
InitializeComponent;
FillComboBox(cbxTimeZone);
end;

The next thing I am going to experiment with is whether or not it is more efficient to clear out and reuse a stringbuilder or create a new one each time I loop through and build the strings as above.

Labels: .NET, Code, Delphi

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

Saturday, March 25, 2006

HTML Element

When developing an ASP.NET application with BDS® 2006 the Web Controls allow you to create code and control events to manage the flow of your application. The interaction with HTML elements via code is not as obvious, but is possible. Placing an HTML Div HTML Element on an ASP.NET Web Application page results in the following page code:

<div>Div</div>

Change the code to look something like:

<div runat="server" id="divarea"></div>

Declare a strict protected variable for your ‘divarea’ in your webform class. The variable name should match the id you give your element.

strict protected
divarea: System.Web.UI.HtmlControls.HtmlGenericControl;

Your HTML Element is now accessible in you codebehind page. You have access to the controls properties and can do something like the following in your code to change the text of the ‘divarea’:

divarea.InnerHtml:= ‘This is a HTML Div Element’;

Putting this together with the information in a previous post I created a ‘blogroll’ page that displays the most recent 5 posts from a few feeds I monitor. BDS® 2006 truly simplifies ASP.NET.

Labels: ASP.NET, Code, Delphi

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

Monday, March 13, 2006

Syndicate Me

RSS has quickly picked up as an effective way of monitoring updated content on web sites (I even have one for this site). There are many applications available to aggregate these feeds. RSS is common enough that RSS aggregation is available (or soon to be) in popular web browsers. What if you wanted your own application or web site to include RSS feed information?

Aggregating and parsing RSS feed information via System.XML namespace of .NET is a lot easier than it sounds. Fortunately RSS is a standard structure XML file. The sub-elements of each item element contain the update information. I have created three (extremely basic) separate examples (BDS 2006, VB.NET 2005 and ASP.NET) of including feed information in your application. (I also put some together using the MSXML ActiveX library that I’ll probably put in another post)

Setting the sample (WinForm) application up in BDS 2006 (Delphi®) and VB.NET 2005 is pretty much the same. On a form I place a Button, TextBox and RichTextBox (screenshot is the two side-by-side).

The TextBox is where one enters the URL of a RSS feed. When the button is clicked the RichTextBox is filled with the feed sub-element information. They both need to use the System.XML namespace.

VB.NET Code

Private Sub btnProcess_Click(ByVal sender As System.Object, ByVal e As System.EventArgs)

Dim XMLDoc As New System.Xml.XmlDocument
Dim rssItems As System.Xml.XmlNodeList
Dim child, cn As System.Xml.XmlNode

RichTextBox1.Clear()
XMLDoc.Load(TextBox1.Text)
' each of the sub-elements of the item element contain the feed information
rssItems = XMLDoc.GetElementsByTagName("item")
For Each child In rssItems
For Each cn In child.ChildNodes
' you could filter and/or process each element by name - depending
' on what you'd like to do with node data (i.e. hyperlink to the
' actual post)
RichTextBox1.AppendText(cn.Name)
RichTextBox1.AppendText(vbCr)
RichTextBox1.AppendText(cn.InnerText.Trim)
RichTextBox1.AppendText(vbCrLf)
Next
Next
End Sub

Delphi® Code

procedure TWinForm.Button1_Click(sender: System.Object; e: System.EventArgs);
var
XMLDoc: System.Xml.XmlDocument;
rssItems: System.Xml.XmlNodeList;
child, cn: System.Xml.XmlNode;

begin
RichTextBox1.Clear;

XMLDoc:= XmlDocument.Create;
XMLDoc.Load(TextBox1.Text);
rssItems:= XMLDoc.GetElementsByTagName('item');
For child in rssItems do
begin
For cn in child.ChildNodes do
begin
RichTextBox1.AppendText(cn.Name);
RichTextBox1.AppendText(#13);
RichTextBox1.AppendText(cn.InnerText.Trim);
RichTextBox1.AppendText(#13#10);
end;
end;
end;

To display the same information on an ASP.NET web page create a document with the following code:

<%@ Page Language="VB" Debug = true%>
<%@ Import namespace="System.Xml" %>
<html>
<head>
<title>BPSoftware.com - RSS Reader</title>
</head>

<body bgcolor="#f8f8ff">
<%

Dim XMLDoc As New System.Xml.XmlDocument
Dim rssItems As System.Xml.XmlNodeList
Dim child, cn As System.Xml.XmlNode

XMLDoc.Load("http://www.techweb.com/rss/all.xml ")
rssItems = XMLDoc.GetElementsByTagName("item")
For Each child In rssItems
For Each cn In child.ChildNodes %>
<%=cn.Name%>
<br />
<%=cn.InnerText.Trim%>
<br />
<%
Next
Next
%>

</body>
</html>

After you get the basic connectivity and processing working, it is easy to filter our and process only the sub-elements that you’d like to include in your application or on your web page. There is a lot that can be done with this inside of an application; I figured I’d go with the basics to help spark some interest. For some unknown reason I've abandoned C some time ago, but if anyone wants to follow up with the same in C please do....

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

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

Saturday, February 25, 2006

I did not win

Lately, all of my focus has been on the Olympics so things have been a little quiet. In my last post I talked about an ASP.NET Random Number Generator created with BDS 2006. Believe it or not, it is surprisingly simple to get something like this up and running. I have worked on a number of ASP.NET applications developed with BDS 2006, in both the internally and externally hosted environments. Typically, any SNAFUs that I have encountered (excluding code typos and incorrectness) have been due to server configuration issues and not a problem with the tool used to create the application.

To get the Random Number Generator running I first needed a Virtual Directory on the server hosting the application. I started out with a new ASP.NET Web Application and saved it with the same name as the application name for the Virtual Directory (by default it the name of the virtual directory).

I then created a ‘form’ and decorated it with a few items from the Web Controls section of the Tool Palette.

With the layout of the form in place a few lines of code were needed to get things going (I created a few functions of my own for dealing with input):

function TWebForm1.IsNumeric(str: string): Boolean;
var
code: integer;
v: integer;
begin
Val(str,v,code);
Result:= (code = 0);
end;

function TWebForm1.ToInteger(str: string): Integer;
var
code: integer;
v: integer;
begin
Val(str,v,code);
if (code = 0) then
Result:= v
else
Result:= 0;
end;

procedure TWebForm1.txtCount_TextChanged(sender: System.Object; e: System.EventArgs);
begin
if Not(IsNumeric(TextBox(Sender).Text)) then
begin
TextBox(Sender).ForeColor:= Color.Red;
TextBox(Sender).Font.Bold:= True;
TextBox(Sender).Text:= '#ERROR#';
end
else
begin
TextBox(Sender).ForeColor:= Color.Black;
TextBox(Sender).Font.Bold:= False;
end;
end;

procedure TWebForm1.btnGenerate_Click(sender: System.Object; e: System.EventArgs);
var
i, y: Integer;
z: single;
lowerbound, upperbound, counter: integer;
intRnd: Single;
// mylist: System.Collections.Hashtable;
mylist: System.Collections.SortedList;
st: System.Text.StringBuilder;
DictEntry: DictionaryEntry;
Enumerator: IEnumerator;
begin
// mylist:= Hashtable.Create;
myList:= SortedList.Create;
lbNumbers.Items.Clear;
lbStats.Items.Clear;

upperbound:= ToInteger(txtUpperBound.Text);
lowerbound:= ToInteger(txtLowerBound.Text);
counter:= ToInteger(txtCount.Text);

if (IsNumeric(txtUpperBound.Text) and
IsNumeric(txtLowerBound.Text) and
IsNumeric(txtCount.Text)) then
begin
Randomize;
For i := 1 To counter do
begin
intRnd := Int((upperbound - lowerbound + 1) * Random + lowerbound);

// HashTable for statistics
if Not mylist.ContainsKey(intRnd.ToString('#,###')) then
mylist.Add(intRnd.ToString('#,###'),'1')
else
begin
y:= ToInteger(mylist.Item[intRnd.ToString].ToString) + 1;
mylist.Item[intRnd.ToString]:= y.ToString('#,###');
end;

if (chkDupes.Checked and
(lbNumbers.Items.FindByText(intRnd.ToString('#,###')) = Nil))
or Not(chkDupes.Checked) then
lbNumbers.Items.Add(intRnd.ToString('#,###'));
end;

// enumerate hash for statistical output
Enumerator := Mylist.GetEnumerator;
st:= StringBuilder.Create;
while Enumerator.MoveNext do
begin
st.Remove(0,st.Length);
DictEntry := DictionaryEntry(Enumerator.Current);
z:= (ToInteger(DictEntry.Value.ToString)/counter * 100);
st.Append(z.ToString('00.00') + '% - ');
st.Append(DictEntry.Key.ToString + ' - (');
st.Append(DictEntry.Value.ToString + ' entries)');
lbStats.Items.Add(st.ToString);
end;
end;
end;

That’s pretty much all the code that is needed. In order to ‘manually publish’ the application, after testing the code and ensuring the application functions as desired, copy the .DLL from application’s Bin directory and the form’s .aspx file to the hosting site (if you do not have a web.config file on the published site you will need to copy that file as well).

With BDS 2006 you can get this up and running rather quickly, I think it takes longer to write this post; unfortunately it didn’t serve up any winning numbers for me…….

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

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

Thursday, February 02, 2006

CursorText

Looking back on a post made in response to a question about changing a cursor to text, I decided to change the code around a little for use in a local utility. The idea is to display ‘text’ as a cursor instead of an ‘image’. I toyed with passing a TIcon (a cursor and icon are the same structure) back as a back as a function result and passing a preexisting TIcon as a parameter. After coming up with an overloaded function, passing it back ‘felt better’. However, I prefer that the ‘cursor’ be created and destroyed outside of the function.

A function is as follows:

function TForm1.CreateCursorText(thecursor: TIcon; const cursortext: string;
fontcolor: TColor; fontsize: Integer; hs: TPoint): Integer;
var
iconwidth,
iconheight : integer;
bmpColor: TBitmap;
r: TRect;
iconinfo: TIconInfo;
begin
bmpColor:= TBitmap.Create;
try
iconwidth:= GetSystemMetrics(SM_CXCURSOR);
iconheight:= GetSystemMetrics(SM_CYCURSOR);
r.Top:= 0;
r.Left:= 0;
r.Bottom:= iconheight;
r.Right:= iconwidth;

bmpColor.Height:= iconheight;
bmpColor.Width:= iconwidth;
bmpColor.Canvas.Brush.Color:= clBlack;
bmpColor.Canvas.FillRect(r);
bmpColor.Canvas.Font.Size:= fontsize;
bmpColor.Canvas.Font.Color:= fontcolor;
bmpColor.Canvas.TextOut(2,2,cursortext);
bmpColor.TransparentColor:= clBlack;

iconinfo.fIcon:= False;
iconinfo.xHotspot:= hs.X;
iconinfo.yHotspot:= hs.Y;
iconinfo.hbmMask:= bmpColor.MaskHandle;
iconinfo.hbmColor:= bmpColor.Handle;
thecursor.Handle:= CreateIconIndirect(iconinfo);

DeleteObject(iconinfo.hbmColor);
Result:= 1;
finally
bmpColor.Free;
end;
end;

An example of how to use it would be something like:

const
crMyCursor = 5;

var
aicon: TIcon;
oldcursor: TCursor;
hotspot: TPoint;
begin
aicon:= TIcon.Create;
try
hotspot.X:= 3;
hotspot.Y:= 2;
CreateCursorText(aicon, edit1.Text, clBlue,8,hotspot);
oldcursor:= Screen.Cursor;
Screen.Cursors[crMyCursor]:= aicon.Handle;
Screen.Cursor:= crMyCursor;
//do something
finally
Screen.Cursor:= oldcursor;
aicon.Free;
end;
end;

Labels: Code, Delphi, WIN32

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

Sunday, January 22, 2006

MyOwnConversion

There are a number of ‘tools’ available to create ASP.NET code. Having created a number of ASP.NET ‘applications’ in an environment other than Delphi® (Don’t interpret this wrong, Delphi® is my passion and always my FIRST choice. Unfortunately, limitations and guidelines can often restrict the tools used.) and having a little time available I decided to create an ASP.NET web application with my reaffirmed passion BDS 2006 (a.k.a. Delphi 10). Question: What could I throw together quick that could serve as something useful? Answer: I do like the ConvertIt demo that shipped with both Delphi® 2005 and BDS 2006.
I fired up ‘Delphi for the Microsoft .NET Framework’ (The ability to selectively load personalities is one thing I am very fond of) and decided to get stared on a new ASP.NET Web Application. On a form I dropped a ComboBox (cbxConversions), TextBox (txtValue), and two ListBoxes (lstFrom and lstTo).

To ensure the ‘proper’ flow of my design I set the AutoPostBack property to True for cbxConversions, lstFrom and txtValue. Now for the code (the events coincide with the defaults for the controls):

unit WebForm1;

interface

uses
System.Collections, System.ComponentModel,
System.Data, System.Drawing, System.Web, System.Web.SessionState,
System.Web.UI, System.Web.UI.WebControls, System.Web.UI.HtmlControls,
ConvUtils, Borland.Vcl.Classes, Borland.Vcl.StdConvs,Borland.Vcl.StrUtils,
Borland.Vcl.SysUtils;

type
TWebForm1 = class(System.Web.UI.Page)
{$REGION 'Designer Managed Code'}
strict private
procedure InitializeComponent;
procedure cbxConversions_SelectedIndexChanged(sender: System.Object; e: System.EventArgs);
procedure lbFrom_SelectedIndexChanged(sender: System.Object; e: System.EventArgs);
procedure txtValue_TextChanged(sender: System.Object; e: System.EventArgs);
{$ENDREGION}
strict private
procedure Page_Load(sender: System.Object; e: System.EventArgs);
strict protected
lstFrom: System.Web.UI.WebControls.ListBox;
lstTo: System.Web.UI.WebControls.ListBox;
cbxConversions: System.Web.UI.WebControls.DropDownList;
txtValue: System.Web.UI.WebControls.TextBox;
procedure OnInit(e: EventArgs); override;
end;

implementation

{$REGION 'Designer Managed Code'}
///

/// Required method for Designer support -- do not modify
/// the contents of this method with the code editor.
///

procedure TWebForm1.InitializeComponent;
begin
Include(Self.lstFrom.SelectedIndexChanged, Self.lbFrom_SelectedIndexChanged);
Include(Self.cbxConversions.SelectedIndexChanged, Self.cbxConversions_SelectedIndexChanged);
Include(Self.txtValue.TextChanged, Self.txtValue_TextChanged);
Include(Self.Load, Self.Page_Load);
end;
{$ENDREGION}

procedure TWebForm1.Page_Load(sender: System.Object; e: System.EventArgs);
var
LFamilies: TConvFamilyArray;
i: integer;
begin
if cbxConversions.Items.Count <= 0 then
begin
GetConvFamilies(LFamilies);
for I := 0 to Length(LFamilies) - 1 do
cbxConversions.Items.Add(ConvFamilyToDescription(LFamilies[I]));
end;
end;

procedure TWebForm1.OnInit(e: EventArgs);
begin
//
// Required for Designer support
//
InitializeComponent;
inherited OnInit(e);
end;

procedure TWebForm1.txtValue_TextChanged(sender: System.Object; e: System.EventArgs);
begin
lbFrom_SelectedIndexChanged(sender,e);
end;

procedure TWebForm1.lbFrom_SelectedIndexChanged(sender: System.Object; e: System.EventArgs);
var
LValue: Double;
LBaseType, LTestType: TConvType;
I: Integer;
begin
lstTo.Items.Clear;
try
LValue := StrToFloatDef(txtValue.Text, 0);
if lstFrom.SelectedIndex <> -1 then
begin
DescriptionToConvType(
lstFrom.Items.Item[lstFrom.SelectedIndex].Text,
LBaseType
);
for I := 0 to lstFrom.Items.Count - 1 do
begin
DescriptionToConvType(lstFrom.Items.Item[i].Text, LTestType);
lstTo.Items.Add(Format('%n %s', [Convert(LValue, LBaseType, LTestType),
ConvTypeToDescription(LTestType)]));
end;
end;
except
lstTo.Items.Add('Cannot parse value');
end;
end;

procedure TWebForm1.cbxConversions_SelectedIndexChanged(sender: System.Object; e: System.EventArgs);
var
LFamily: TConvFamily;
LTypes: TConvTypeArray;
I: Integer;
begin
lstFrom.Items.Clear;
lstTo.Items.Clear;
if DescriptionToConvFamily(
cbxConversions.Items[cbxConversions.SelectedIndex].Text,
LFamily) then
begin
GetConvTypes(LFamily, LTypes);
for I := 0 to Length(LTypes) - 1 do
lstFrom.Items.Add(ConvTypeToDescription(LTypes[I]));
end;
end;

end.

I built the application and fired up one of my test Virtual Machines (As I had mentioned before, Microsoft® Virtual PC is a developers dream) and configured an application root for my newly created ASP.NET application. I copied over the ‘application’ and within minutes I had a functional web based variation of a conversion program a la BDS 2006 style.

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

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

Tuesday, January 17, 2006

Where in the world?

When dealing with individuals in different time zones it is not always easy to keep track of ‘their’ local time. Many know the time zone bias for the popular world time zones but what about those not so well known places? In an effort to prevent the need to do some quick calculations I decided I’d write a little utility (desktop clock that will be added to the Freeware section someday soon) to display multiple time zone times. Question:With the idea in mind, how does one get a list of time zones and calculate the bias?

Answer: MSDN is your friend! I found a nice article on Retrieving Time-Zone Information. The article explains where and how the time zone information is stored. The TIME_ZONE_INFORMATION structure contains a Bias, StandardBias and DaylightBias to assist in the calculating of the time in a selected time zone.

For the following quick code I had placed a TComboBox and a TMemo on a TForm. When the form is shown the available time zones are added to the TComoBox.Items. When a time zone is selected pieces of information are displayed in the TMemo. For this I used BDS2006.

interface

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

type
TForm1 = class(TForm)
ComboBox1: TComboBox;
Memo1: TMemo;
procedure ComboBox1Change(Sender: TObject);
procedure FormShow(Sender: TObject);
public
procedure FillComboBox(combobox: TComboBox);
procedure FillMemo(timezone: string; memo: TMemo);
end;

var
Form1: TForm1;

implementation

uses
Registry;
{$R *.dfm}

{ TForm1 }

procedure TForm1.ComboBox1Change(Sender: TObject);
begin
if Sender is TComboBox then
FillMemo(TComboBox(Sender).Text,Memo1);
end;

procedure TForm1.FillComboBox(combobox: TComboBox);
var
reg: TRegistry;
begin
reg:= TRegistry.Create(KEY_READ);
combobox.Items.BeginUpdate;
try
comboBox.Items.Clear;
reg.RootKey:= HKEY_LOCAL_MACHINE;
if reg.OpenKey('SOFTWARE\Microsoft\Windows NT\CurrentVersion\Time Zones',False) then
reg.GetKeyNames(combobox.Items);
finally
reg.Free;
combobox.Items.EndUpdate;
end;
end;

procedure TForm1.FillMemo(timezone: string; memo: TMemo);
var
reg: TRegistry;
regkey: string;
tzi: TTimeZoneInformation;
begin
memo.Lines.Clear;
reg:= TRegistry.Create(KEY_READ);
regkey:= Format('SOFTWARE\Microsoft\Windows NT\CurrentVersion\Time Zones\%s',[timezone]);
try
reg.RootKey:= HKEY_LOCAL_MACHINE;
if reg.OpenKey(regkey,False) then
begin
memo.Lines.Add(Format('Daylight Time Display: %s',[reg.ReadString('Dlt')]));
memo.Lines.Add(Format('Standard Time Display: %s',[reg.ReadString('Std')]));
reg.ReadBinaryData('TZI',tzi,sizeof(tzi));
memo.Lines.Add(Format('Bias: %d minutes',[tzi.Bias]));
end;
finally
reg.Free;
end;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
FillComboBox(ComboBox1);
end;

end.

Labels: Code, Delphi, WIN32

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

Saturday, January 14, 2006

Is it better to be tall or short?

[lead-in paragrah omitted]

I recently needed to access bitmap resources from a file. The bitmap contained a number of individual [standard sized] images ‘strung’ together. These also needed to be loaded into a TImageList.

procedure AddCommCtrlBitMaps(imagelist: TImageList);
var
handle: THandle;
bitmap: TBitMap;
colTrans: TColor;
begin
handle := LoadLibrary('COMCTL32.DLL');
if (handle=0) then
RaiseLastOSError;
bitmap:= TBitMap.Create;
try
bitmap.LoadFromResourceName(handle,'#124');
imagelist.Add(bitmap,bitmap);
colTrans := bitmap.Canvas.Pixels[0,15];
imagelist.AddMasked(bitmap,coltrans);
finally
bitmap.Free;
FreeLibrary(handle);
end;
end;

Your task young padawan – what is the VB equivalent? C++? or any other language? Hey, maybe this is the start of a ‘Translation Challenge of the Week’??

Labels: Code, Delphi, WIN32

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

Wednesday, January 11, 2006

Piecing it all together (Part 2)

Part 1

Step 2 – The DLL

In the last piece I discussed the overall objective of this project as well as covered the classes used within the DLL that is ultimately going to be called from within an Excel® Add-in. The next thing step is to create the DLL that is going to be used. This was greatly simplified by having classes that were called, basically allowing just the ‘wrapping’ of the calling code. We are only accepting ‘string’ values in, if we were returning then this would be slightly different.

library emptydll;

uses
SysUtils,
ActiveX,
EmptyUnit,
Classes;

{$R *.res}
function DoEmpty(intext: pchar; inbase:single; innewbase: single; var outsingle: single):boolean;stdcall;
var
emptyitem: TEmptyItem;
emptycalc: TEmptyCalc;
begin
CoInitialize(nil);
emptycalc:= TEmptyCalc.Create(nil);
emptyitem:= TEmptyItem.Create(nil);
try
try
emptyitem.SomeText:= intext;
emptycalc.SomeBase:= inbase;
emptycalc.SomeNewBase:= innewbase;
emptycalc.GetCalc(emptyitem);
outsingle:= emptyitem.SomeSingle;
Result:= True;
except
Result:= False;
end;
finally
emptyitem.Free;
emptycalc.Free;
CoUninitialize;
end;
end;

exports DoEmpty;
begin
end.

To ensure that this DLL is ‘functional’ I created a test application with Delphi®.

type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
procedure Button1Click(Sender: TObject);
end;

function DoEmpty(intext: pchar; inbase:single; innewbase: single;
var outsingle: single):boolean;stdcall;external 'emptydll.dll';

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
mysingle: Single;
mytext: PChar;
begin
mytext:= 'TheText';
DoEmpty(mytext,400,450.56,mysingle);
Edit1.Text:= FloatToStr(mysingle);
end;

end.

Now that we have a DLL that works as intended the next thing we need to do is move to Excel® and create the Add-In. Before moving to the next step copy the emptydll.dll to the default (typically c:\windows\system32) system directory. There is an order for searching but for ease of use we’ll go with this.

Labels: Apps, Code, Delphi, WIN32

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

Tuesday, January 10, 2006

Piecing it all together (Part 1)

Just as important as it is to speak more than one language (or at least conversant), I feel it is equally important to know [exposure] more than one programming language. In a world pwned by M$ one can not get buy without having a little Visual Basic® as part their ‘language set’. I think a lot of programming comes down to understanding logic, concepts and ‘how things work’, once those are understood coming up with the syntax tends to be easier (that and a little RTFM).
Ok here is the scenario – I have a Delphi® application that does a significant number of queries and lengthy complex calculations on a SQL Server database based upon user input. The results are displayed to an on screen grid. This all works wonderful, well it did, until I needed to change the input from user entered to a column of data in an Excel® spreadsheet that writes back the calculation in predefined columns.
There are a number of ways this can be accomplished, the route I chose this time was to create an Excel® Add-in (Personal Macro Workbooks work too, however I prefer Add-ins for their deployment ease) that calls the Delphi® DLL from a menu item. Fortunately, I had created classes with public methods and properties to pass information back and forth to my main application, sort of a pseudo back and front end within my own application. I tend to do things this way because it simplifies things a bit in the event branch off needs (such as what I needed to do). In an attempt to keep things brief (I have a short attention span and can only handle a few pages at a time myself) I will break this up into multiple sections. All the code has been greatly simplified [and stripped down] from my original source (for a number of reasons), so it may not make too much functional sense but we’re working on concept here. I used BDS 2006 Update 1 and Excel® 2003 SP2 for this project.

Step 1 – The Classes

unit EmptyUnit;

interface

uses
SysUtils, Classes;

type
TEmptyItem = class(TComponent)
strict private
FSomeSingle: Single;
FSomeText: string;
public
property SomeSingle: Single read FSomeSingle write FSomeSingle;
property SomeText: string read FSomeText write FSomeText;
constructor Create(AOwner: TComponent); override;
end;

TEmptyCalc = class(Tcomponent)
private
FADOConnectionString: String;
FSomeBase: Single;
FSomeNewBase: Single;
FSomeSingle: Single;
FSomeText: string;
public
constructor Create(AOwner: TComponent); override;
procedure GetCalc(var emptyitem: TEmptyItem);
published
property ADOConnectionString: string read FADOConnectionString write FADOConnectionString;
property SomeBase: Single read FSomeBase write FSomeBase;
property SomeNewBase: Single read FSomeNewBase write FSomeNewBase;
property SomeSingle: Single read FSomeSingle write FSomeSingle;
property SomeText: string read FSomeText write FSomeText;
end;

implementation

{ TEmptyItem }

constructor TEmptyItem.Create(AOwner: TComponent);
begin
inherited;
FSomeSingle:= 0;
end;

{ TEmptyCalc }

constructor TEmptyCalc.Create(AOwner: TComponent);
begin
inherited;
FADOConnectionString:= '';
FSomeBase:= 0;
FSomeNewBase:= 0;
FSomeSingle:= 0;
FSomeText:= '';
end;

procedure TEmptyCalc.GetCalc(var emptyitem: TEmptyItem);
begin
SomeText:= emptyitem.SomeText;
SomeSingle:= 2.34; // This is filled from a query or whatever
emptyitem.SomeSingle:= (SomeNewBase - SomeBase) * SomeSingle;
end;

end.

Part 2 will cover The DLL

Labels: Apps, Code, Delphi, WIN32

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

Saturday, January 07, 2006

Some Component Updates

The Delphi® development environment and language allow for the easy creation of custom components. This allows developers to expand upon existing or create new components in the search to facilitate the creation and maintenance of software applications. Over the years, like so many other users of Delphi®, I have created a number of components and posted them to share with the Delphi® community.

As I work towards converting existing applications, there was a need to recompile and install component packages. Some minor changes have been made to most of the components, with the exception of TSHFileOp. The TSHFileOp component was basically rewritten to serve my needs in an easier way. I have also created a sample application (used for testing) using the TSHFileOp, TFileEdit and TDirectoryEdit components.

The source code is available for these components allowing for further customization if they come close, but fall short of individual needs. Most of them have accommodations for .Net. There may be other versions of similar components available tangled in this vast place we call the Internet. There are a number of websites available for developers to share and/or browse through custom components and/or source code. Websites such as:

Torry's Delphi Pages
Project JEDI
Delphi Super Page
Code Central
Delphi City

These sites are not listed in any order and this list does not indicate preference over sites that are not listed. There are a lot of quality sites out there.

Please feel free to add to the list.

Labels: Components, Delphi, Information, Tech

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

Thursday, December 29, 2005

Plug Me In

Recently I had an interesting conversation with someone regarding plug-ins and the custom expansion of application features. Plug-ins basically allow for the extension of an application to allow for additional features and functionality. One place that I have often utilized pseudo-plug-ins is for custom reports.
I found that having a ‘custom report directory’ where option forms with reports in dlls can be dropped works out well. An application can scan the directory for valid reports to list in some sort of report menu. A simplified version of loading a form is as follows:

In the main app:

type
DisplayFormDLL = function (reportdir:pchar): integer;stdcall;

var
h: THandle;
displayform: DisplayFormDLL;
libfilename: string;
result: integer;
begin
libfilename:= 'thedll.dll';
h := LoadLibrary(PChar(libfilename));
if h <> 0 then
try
@displayform := GetProcAddress(h,'DisplayForm');
if @displayform <> nil then
result:= displayform('New Caption');
finally
FreeLibrary(h);
end;
end;

In the DLL:

//Uses
//ActiveX;

function DisplayForm(mycaption:PChar):integer;stdcall;
begin
//CoInitialize(nil);
Form2:= TForm2.Create(nil);
try
Form2.Caption:= mycaption;
Result := Form2.ShowModal;
finally
Form2.Free;
//CoUninitialize;
end;
end;

Exports
DisplayForm;

If you want to use MDIChildren form it is more complicated, unless you use Runtime packages, then the above works well.

Labels: Code, Delphi, WIN32

posted by Brad Prendergast at 9:57:00 AM (2 comments)
Links to this post
Permalink

Saturday, December 24, 2005

Santa Did Come

After ordering ‘early’ and being placed on the backorder list, I received a special delivery this week. I guess the elves worked overtime this year. I haven’t had much opportunity to play with the addition to the desktop, however what I have played with so far it is leaps and bounds above its predecessor. Why didn’t they change the icon?

Labels: Delphi, Misc, Tech

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

Thursday, December 22, 2005

Resource Basket

I haven’t the foggiest idea why, but ‘A Tisket a Tasket a resource in a basket’ is echoing through my head.
December is usually a pretty hectic month. The period between Thanksgiving and Christmas leaves little time to do anything more than the bare minimum a.k.a. only what is absolutely necessary. Over the past week I had the opportunity to delve into resources a bit. Fortunately, I am not talking system resources, rather the additional files that are compiled into executables and libraries. To be more specific, my venture was initiated by cursors. As usual I’ll try to keep this brief, to the point and intuitive.
For those that are unaware, Cursors and Icons are basically the same type of files. The IconInfo structure contains the information about icons and cursors. The difference between the two is so slight that most of the time you can get away with renaming the .ico to .cur and vice versa. Within Delphi® you can easily extract an icon or cursor resource from a file and reference it with a TIcon Class.
The TIcon Class has a nice SaveToFile method that will allow you to save your extracted resource as its own file. This works fine, well, most of the time. Occasionally I noticed that I would get a ‘Bitmap is invalid error’. I had Google’d the newsgroups to see if anyone else had shared this mind numbing experience. I did find a few threads, however I didn’t come across any that discussed a solution or work around.
After pulling what I have left of my hair out I noticed a trend. I would consistently get this error with black and white (monochrome) cursors. Color cursors seemed to save properly. I loaded up and viewed the IconInfo. hbmMask and IconInfo. hbmColor bitmaps in a TImage and they looked valid. My next idea was to create a new cursor IconInfo and fill it with the IconInfo for the cursor that I had retrieved with the GetIconInfo function. I then created a TIcon with that information and then saved that to a file. To my pleasure it worked like a charm.
This is the quick function that I had come up with:

var
iconwidth, iconheight : integer;
iconinfo: TIconInfo;
bmpColor,
bmpMask: TBitmap;
TransparentColor: TColor;
tempicon: TIcon;
begin
bmpColor:= TBitmap.Create;
bmpMask:= TBitmap.Create;
tempicon:= TIcon.Create;
try
iconwidth:= GetSystemMetrics(SM_CXICON);
iconheight:= GetSystemMetrics(SM_CYICON);

bmpColor.Width:= iconwidth;
bmpColor.Height:= iconheight;
// DrawIconEx(bmpColor.Canvas.Handle,0,0,icon.Handle,0,0,0,0,DI_IMAGE);
DrawIconEx(bmpColor.Canvas.Handle,0,0,icon.Handle,0,0,0,0,DI_NORMAL);

bmpMask.Width:= iconwidth;
bmpMask.Height:= iconheight;
DrawIconEx(bmpMask.Canvas.Handle,0,0,icon.Handle,0,0,0,0,DI_MASK);

GetIconInfo(icon.Handle, iconinfo);
iconinfo.fIcon:= isIcon;
iconinfo.hbmMask:= bmpMask.MaskHandle;
iconinfo.hbmColor:= bmpColor.Handle;
tempicon.Handle:= CreateIconIndirect(iconinfo);
tempicon.SaveToFile(filename);
DestroyIcon(tempicon.Handle);
DeleteObject(iconinfo.hbmMask);
DeleteObject(iconinfo.hbmColor);
finally
tempicon.Free;
bmpMask.Free;
bmpColor.Free;
end;
end;

Of course, this can be improved (formatting and code wise, does anyone know of a good Delphi® html formatter? I tend to lose my formatting when I post these); in fact I did something like this in the latest update of AIconExtract. The latest version includes cursor resources. Who, knows one day I may one day add the ability to edit resources....

Labels: Code, Delphi, WIN32

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

Thursday, December 08, 2005

Did you say TitleCase?

Well, I came to inherit a bunch of malformed (malformatted if it were a word) phrases (strings). These phrases were a mix of lower and uppercase letters, with the latter being predominant. I for one can not stand all UPPERCASE text and strive to achieve some sort of aesthetically appealing display. IMHO. the usage of these phrases is best suited by a TitleCase format. Briefly, for those that do not know what TitleCase is, it is basically the capitalization of the first letter of each word in a phrase or sentence.

I threw together two functions (one for WIN32 and the other for .NET) to satisfy my short-term need to convert a phrase to TitleCase.

{Version for .NET}
uses
System.Globalization;

function MyTitleCase(const thetext: string): string;
var
gbCulture: System.Globalization.CultureInfo;
gbTextInfo: System.Globalization.TextInfo;
begin
gbCulture:= CultureInfo.Create('en-US');
gbTextInfo:= gbCulture.TextInfo;
Result:= gbTextInfo.ToLower(thetext);
Result:= gbTextInfo.ToTitleCase(Result);
end;

{Version for WIN32}
function MyTitleCase (const s: string):string;
var
flag: Boolean;
i: integer;
begin
flag:= True;
for i := 1 to Length(s) do
begin
if flag then
AppendStr(Result, UpperCase(s[i]))
else
AppendStr(Result, LowerCase(s[i]));
flag := (s[i] = ' ');
end;
end;

Labels: .NET, Code, Delphi, WIN32

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

Sunday, November 27, 2005

Delphi® and GetExplicitEntriesFromAcl

I have been doing quite a bit with the Windows® security (see BPACLer and an earlier post). At first glance it may seem complicated (what other unknowns don’t) but once you get the hang of it, it is rather ‘logical’. Each object has its own Access Control List (ACL) that either grants or denies access (via authorization) to that object.
ACLs are made up of Access Control Entries (ACE). Each ACE contains the authorization information for a Trustee. An ACE can either be an Effective or Explicit entry. In order to retrieve a list of Explicit Entries (EA) a call to GetExplicitEntriesFromAcl does the trick. I haven’t seen many examples (actually I haven’t seen a one) of using this from within Delphi® so I figured I’d post a sample use of this API. If you have any questions please let me know.

procedure GetEAList(filename: string; listbox: TListBox);
type
TEAArray = Array [0..0] of EXPLICIT_ACCESS;
PEAArray = ^TEAArray;

var
pSD: PSECURITY_DESCRIPTOR;
countofexplicitentries: Cardinal;
ListOfExplicitEntries: PEXPLICIT_ACCESS_A;
EAList: PEAArray;
pExplicitAccess: EXPLICIT_ACCESS;
pDACL: PACL;
i: integer;

begin
if not (GetNamedSecurityInfo(PChar(filename),SE_FILE_OBJECT,
DACL_SECURITY_INFORMATION, Nil, Nil, @pDACL, Nil,
pSD)=0) then
Exit;

GetMem(ListOfExplicitEntries,SizeOf(ListOfExplicitEntries));

if GetExplicitEntriesFromAcl(pDACL^,countofexplicitentries,@EAList) <>
ERROR_SUCCESS then
begin
FreeMem(ListOfExplicitEntries);
Exit;
end;

if (countofexplicitentries > 0) then
for i:= 0 to countofexplicitentries - 1 do
begin
pExplicitAccess:= EAList[i];
listbox.Items.Add(GetName(pExplicitAccess.Trustee.ptstrName));
case pExplicitAccess.Trustee.trusteetype of
TRUSTEE_IS_USER: listbox.Items.Add('TRUSTEE_IS_USER');
TRUSTEE_IS_GROUP: listbox.Items.Add('TRUSTEE_IS_GROUP');
TRUSTEE_IS_DOMAIN: listbox.Items.Add('TRUSTEE_IS_DOMAIN');
TRUSTEE_IS_ALIAS: listbox.Items.Add('TRUSTEE_IS_ALIAS');
TRUSTEE_IS_DELETED: listbox.Items.Add('TRUSTEE_IS_DELETED');
TRUSTEE_IS_INVALID: listbox.Items.Add('TRUSTEE_IS_INVALID');
TRUSTEE_IS_WELL_KNOWN_GROUP: listbox.Items.Add('TRUSTEE_IS_WELL_KNOWN_GROUP');
TRUSTEE_IS_UNKNOWN: listbox.Items.Add('TRUSTEE_IS_UNKNOWN');
end;

case pExplicitAccess.grfAccessMode of
NOT_USED_ACCESS: listbox.Items.Add('NOT_USED_ACCESS');
GRANT_ACCESS: listbox.Items.Add('GRANT_ACCESS');
SET_ACCESS: listbox.Items.Add('SET_ACCESS');
DENY_ACCESS: listbox.Items.Add('DENY_ACCESS');
REVOKE_ACCESS: listbox.Items.Add('REVOKE_ACCESS');
SET_AUDIT_FAILURE: listbox.Items.Add('SET_AUDIT_FAILURE');
end;
end;

FreeMem(ListOfExplicitEntries);
end;

In my opinion, it is extremely important that an administrator reviews the ACLs for the objects within their directory. I have been often times surprised by some of the holes that are permission based. It is not always that a Trustee would intentionally cause damage, however accidents do occur. There are also those cases where a Trustee may be impersonated and well, we all know what happens from there. I am often criticized for being overly restrictive, however I feel it is better to be safe than sorry. After all, people don't typically tell you what then can do, rather what they can't.

Labels: Code, Delphi, WIN32

posted by Brad Prendergast at 9:44:00 AM (5 comments)
Links to this post
Permalink

Friday, November 25, 2005

What's on my spreadsheet?

The ability for separate applications to ‘communicate and interact’ is well, neat. I have recently found and increasing need to create/manipulate some pretty involved Microsoft® Excel spreadsheets from a Delphi® application. The drive for this post is to show some simple sample code lines to accomplish tasks within Excel.

Besides searching newsgroups you can also search MSDN for additional commands. I have found the simplest way is to record a macro and the use the Visual Basic Editor to see the code commands created in the macro.

Delphi® includes Microsoft® Office® server controls. Keep in mind that these controls work with a specific version of Office. If you need to target additional versions, I have found variants to work well for manually creating the right version, for example:

uses
ComObj;

var
ExcelApplication: Variant;

ExcelApplication := CreateOleObject('Excel.Application.7');
ExcelApplication := CreateOleObject('Excel.Application.8');
ExcelApplication := CreateOleObject('Excel.Application.9');

For the most part I generally drop a TExcelApplication control onto a form and go from there. I guess you could also use TExcelWorkbook and TExcelworksheet components as well, but I prefer to manually create those. To create a new Workbook and Worksheet:

var
ExcelWorkBook1: TExcelWorkbook;
ExcelWorkSheet1: TExcelWorksheet;
lcid: integer;

begin
lcid := GetUserDefaultLCID;
ExcelApplication1.Visible[lcid] := true;
ExcelWorkBook1 := TExcelWorkBook.Create(ExcelApplication1);
ExcelWorkBook1.ConnectTo(ExcelApplication1.Workbooks.Add(EmptyParam, lcid));
ExcelWorksheet1 := TExcelWorksheet.Create(ExcelApplication1);

{The next line creates a new worksheet in a workbook}
ExcelWorkbook1.Sheets.Add(EmptyParam, EmptyParam, EmptyParam, EmptyParam, LCID);

{The next line attaches to the active worksheet in the workbook}
ExcelWorkSheet1.ConnectTo(ExcelWorkbook1.ActiveSheet as _Worksheet);

ExcelWorkSheet1.Name := 'My Sheet';
end;

The following are additional syntax examples:

var
{r and c are the row and column indexes}
r, c: Integer;
begin
{Freeze panes}
ExcelApplication1.ActiveWindow.FreezePanes:= true;

{Select range and merge cells}
ExcelWorkSheet1.Range[Excelworksheet1.Cells.Item[r-1,c-2], Excelworksheet1.Cells.Item[r,c]].Merge(true);

{Autofit a column}
Excelworksheet1.Cells.Item[r,c].EntireColumn.AutoFit;

{Hide column}
Excelworksheet1.Cells.Item[r,c].EntireColumn.Hidden:= True;

{Format cells}
{I typically never use with statements, in fact I despise them. I generally only use them when I am working with Excel cells. The following all don’t need to be used together, they are meant to be used as examples to pick and choose from.}
with Excelworksheet1.Cells do
begin
Item[r,c].HorizontalAlignment:= xlRight;
Item[r,c].Value:= 'somevalue';
Item[r,c].Font.Bold:= False;
Item[r,c].Font.Underline:= False;
Item[r,c].Font.Size:= 8;
Item[r,c].Font.ColorIndex:= 2;
Item[r,c].Interior.ColorIndex:= 1;
Item[r,c].NumberFormat:= '#,##0.00_);[Red](#,##0.00);-';
end;

{Add a formula to a cell, the cell ranges are offset from the current cell }
Excelworksheet1.Cells.Item[r,c].FormulaR1C1:= ‘=SUM(R[-12]C:R[-1]C)';

{Open a preexisting file}
ExcelApplication1.Workbooks.Add(filename,0);

ExcelWorksheet1.Free;
ExcelWorkBook1.Free;
end;

This sample was merely intended to give some general ideas and hopefully spark interest in working with Excel worksheets from within a Delphi® application. There seems to be an endless array of commands that you can use to communicate with a spreadsheet.

Labels: Code, Delphi, WIN32

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

Saturday, November 19, 2005

Free Gems Do Exist (Part 2)

As time progresses I am becoming far more comfortable and impressed with Microsoft’s Log Parser. For one thing, I am awed at how it processes so fast. I processed 404 logs (over 4.6GB) in seconds, not minutes or hours as I had first thought. The command line syntax is also quite powerful. This tool allows you to precisely and quickly analyze data without a lot of overhead.

I had mentioned in the first post that another bonus is the COM interface. All the power of this command-line tool can be wrapped in a nice GUI interface, which is exactly what I had done. After reading about the interfaces in the accompanying help file I imported the Type Library for Log Parser into Delphi® (I have Delphi® 5 and Delphi® 2005 installed on my development machine and I worked with Log Parser in both versions) and installed the new components. One thing to note is that the TLogQueryClass is the only class that seemed to work properly after importing the library. Each of the Input and Output format components kept on reporting invalid log formats when I passed them to the TLogQueryClass method. I tried numerous ways to get them working. This was/is more of a nuisance more than anything else. The help file clearly lists (I have also included them in this source) the classes which can easily be created as variants.

To get started with a simple example of how to use the Log Parser interfaces I started a new application and placed a TFileEdit, TStaticText, TListBox and three (3) TButtons on the TForm. Rather than go into a verbose explanation I figured I’d just post some sample code and let the code explain what is going on. Here is a wonderful byproduct of living in the 21st century; there is no guarantee or warranty, expressed or implied, concerning the applicability of code and techniques included in this example. This example code is supplied AS IS. If you wish to use this code or technique, it is your responsibility to test and certify the code in your project.

Button1 (caption:= ‘Output’) shows how to use an InputContextClass and OutputContextClass.
Button2 (caption:= ‘LogParser Version’) shows how to retrieve the version information from TLogQueryClass.
Button3 (caption:= ’Record’) shows how to retrieve the information into a RecordSetClass from an InputContextClass and iterate through each of the records. In this example I add each entry to a list box.

uses
ComObj;

{
Input Formats:
ADS : MSUtil.LogQuery.ADSInputFormat
BIN : MSUtil.LogQuery.IISBINInputFormat
CSV : MSUtil.LogQuery.CSVInputFormat
ETW : MSUtil.LogQuery.ETWInputFormat
EVT : MSUtil.LogQuery.EventLogInputFormat
FS : MSUtil.LogQuery.FileSystemInputFormat
HTTPERR : MSUtil.LogQuery.HttpErrorInputFormat
IIS : MSUtil.LogQuery.IISIISInputFormat
IISODBC : MSUtil.LogQuery.IISODBCInputFormat
IISW3C : MSUtil.LogQuery.IISW3CInputFormat
NCSA : MSUtil.LogQuery.IISNCSAInputFormat
NETMON : MSUtil.LogQuery.NetMonInputFormat
REG : MSUtil.LogQuery.RegistryInputFormat
TEXTLINE : MSUtil.LogQuery.TextLineInputFormat
TEXTWORD : MSUtil.LogQuery.TextWordInputFormat
TSV : MSUtil.LogQuery.TSVInputFormat
URLSCAN : MSUtil.LogQuery.URLScanLogInputFormat
W3C : MSUtil.LogQuery.W3CInputFormat
XML : MSUtil.LogQuery.XMLInputFormat

Output Formats:
CHART : MSUtil.LogQuery.ChartOutputFormat
CSV : MSUtil.LogQuery.CSVOutputFormat
DATAGRID : MSUtil.LogQuery.DataGridOutputFormat
IIS : MSUtil.LogQuery.IISOutputFormat
NAT : MSUtil.LogQuery.NativeOutputFormat
SQL : MSUtil.LogQuery.SQLOutputFormat
SYSLOG : MSUtil.LogQuery.SYSLOGOutputFormat
TPL : MSUtil.LogQuery.TemplateOutputFormat
TSV : MSUtil.LogQuery.TSVOutputFormat
W3C : MSUtil.LogQuery.W3COutputFormat
XML : MSUtil.LogQuery.XMLOutputFormat
}

procedure TForm1.Button1Click(Sender: TObject);
var
szQuery: WideString;
pObjectInput,
pObjectOutput: variant;

begin
szQuery:= Format('SELECT c-ip FROM %s GROUP BY c-ip',[FileEdit1.Text]);

pObjectInput:= CreateOleObject('MSUtil.LogQuery.W3CInputFormat');
pObjectOutput:= CreateOleObject('MSUtil.LogQuery.DataGridOutPutFormat');

LogQueryClass1.ExecuteBatch(szQuery,pObjectInput,pObjectOutput);

pObjectInput:= Unassigned;
pObjectOutput:= Unassigned;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
StaticText1.Caption:= Format('LogParser Version %d.%d',[LogQueryClass1.versionMaj,LogQueryClass1.versionMin]);
end;

procedure TForm1.Button3Click(Sender: TObject);
var
szQuery: WideString;
pObjectInput,
LogRecordSet,
oRecord: variant;

begin
szQuery:= Format('SELECT c-ip FROM %s GROUP BY c-ip',[FileEdit1.Text]);

pObjectInput:= CreateOleObject('MSUtil.LogQuery.W3CInputFormat');

LogRecordSet:= LogQueryClass1.Execute(szQuery,pObjectInput);

while not LogRecordSet.atEnd do
begin
oRecord:= LogRecordSet.GetRecord;
ListBox1.Items.Add(oRecord.GetValue(0));
{ ListBox1.Items.Add(oRecord.ToNativeString(',')); }
{ The ToNativeString method retrieves the entire record with each value separated by the specified delimiter. }

LogRecordSet.MoveNext;
end;

pObjectInput:= Unassigned;
oRecord:= Unassigned;
LogRecordSet:= Unassigned;
end;

If anyone else does anything with this interface I welcome the posting of examples. This is it for now, time to go off and expand upon the BPACLer application.

Labels: Apps, Code, Delphi, Information, Tech, WIN32

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

Sunday, November 06, 2005

FASTMM Saves the Day

Back in October, Borland® announced a new version of Delphi®. ‘Delphi 2006’, codename Dexter, looks like it is going to contain a number of significant fixes and enhancements. These enhancements look like they will greatly enhance Delphi®’s rapid application development (RAD) environment.

FASTMM is an opensource replacement memory manager for Borland® Delphi® (Thanks Pierre for an excellent project!). Not only does it noticeably increase speed, but it also assists with the debugging and logging of memory leaks. FASTMM discussions have been circulating for a while. Discussions about and attention to FASTMM have recently increased with the indications that FASTMM will be included in the next Delphi® release.

My curiosity was peaked, and I started working with FASTMM over the past week. I must admit that I am impressed. I am also excited to see how it will integrate with the newest release of Delphi®. I started working with some small applications to get the feel for its usage and functionality. In one of my tests I dropped a TShellComboBox, TShellListView and TShellListView from the Samples palette onto a TForm and ran the application. Much to my surprise, I received FASTMM notification of memory leaks when I closed the application. Considering I hadn’t written one line of code, I must admit I was skeptical of the leak. In order to give myself piece of mind (and boost confidence in FASTMM) I decided to look through ShellCtrls.pas to see if anything stood out. I also searched the web and QualityCentral (QC) to see if there were any fixes or posts discussing memory leaks with theses sample controls. I did find some old posts and fixes, however none related to my situation.

In reviewing ShellCtrls.pas I did notice a few things that potentially validated the memory leaks noted by FASTMM. I changed some code (listed below), recompiled and reran my sample application. I was pleasantly surprised to see that the dialog box (that causes your heart to drop) displaying memory leak information no longer appeared. I consider this my indoctrination to using FASTMM. Thus far I am very pleased with it and look forward to the continued use of this excellent memory manager.

The changes I made to ShellCtrls.pas:

In TCustomShellTreeView add:
public
destructor Destroy; override;

destructor TCustomShellTreeView.Destroy;
begin
if Assigned(FRootFolder) then
FRootFolder.Free;
inherited;
end;

In TCustomShellListView change:
destructor TCustomShellListView.Destroy;
begin
ClearItems;
FFolders.Free;
inherited;
end;

to

destructor TCustomShellListView.Destroy;
begin
ClearItems;
FFolders.Free;
if Assigned(FRootFolder) then
FRootFolder.Free;
inherited;
end;

In TCustomShellComboBox change:

destructor TCustomShellComboBox.Destroy;
begin
inherited Destroy;
if Assigned(FImageList) then FImageList.Free;
end;

to

destructor TCustomShellComboBox.Destroy;
var
i: integer;
begin
for i := 0 to Items.Count - 1 do
if Assigned(Folders[i]) then Folders[I].Free;
if assigned(FRootFolder) then FRootFolder.Free;

inherited Destroy;
if Assigned(FImageList) then FImageList.Free;
end;

Labels: Code, Delphi, Fixes, WIN32

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

Sunday, October 02, 2005

Delphi™ Components:TBPRichEdit Added

TBPRichEdit has been added to the list Delpi Components available for download. TBPRichEdit is a descendant of the native TRichEdit component. TBRichEdit has two additional scrolling events: OnVerticalScroll and OnHorizontalScroll. TBPRichEdit also adds properties (GutterSize, GutterColor, GutterTextColor) that display the TBPRichEditline numbers.

This component was developed due to a need to display line numbers (similar to TBPMemo) for a text listing. There was a slight twist; I wanted to 'colorize' certain text. Initially, my though was that it would only take a few moments to whip out this component, after all, the same code that adds the lines to the BPMemo could be used for a RichEdit. WRONG!
After creating the new component I realized that assigning the RichEdit as the parent of the PaintBox caused, well, issues. The text of the RichEdit was 'not being painted'. It was there. The text could be copied, pasted and cut, just not viewed within the RichEdit. After poking around a bit I did find one interesting tidbit that I had found in the Delphi 2005 help file for the BringToFront Method of a control, 'Note that controls that wrap Windows screen objects (control classes descended from TWinControl) always "stack" above lightweight controls (control classes descended from TGraphicControl).'. This got me thinking (how relevant this is still remains to be seen) about a number of things regarding the way this whole thing was set up and how a RichEdit gets created and painted. After some thought, the easiest way around this was to actually create and TPanel to hold the TPaintBox and then draw the panel over the RichEdit (adjusting for the potential moving and sizing of the RichEdit). One important thing to note, when performing this technique the BorderStyle and HorizontalScrollBar height need to be considered when positioning the panel. Afterall, we want the panel to line up and appear as if it is part of the RichEdit rather than something sitting on top of it. Covering the scroll bar is definitely quick way to screw that up.
At that point I only needed something to display the lines numbers for colored/highlighted text. I do at one point hope to adjust the line number positioning (centered) for the potential varying height of the lines of the TRichEdit. If there is anything else that you think should be added or see within the TBPRichEdit please let me know.

Labels: Code, Delphi, Information, Tech

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