BPSoftware.com Blog

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

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

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

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

Thursday, January 12, 2006

Piecing it all together (Part 3)

Part 2

Step 3 – The Add-In

One nice thing I like about Microsoft® Office® is the ability to write code behind the application. This allows for the creation of complex macros and coding in VBA. You can write [virtually] anything that you can with Visual Basic®, with one big differences being the inability to make stand alone applications.
The next step takes us into Microsoft® Excel®. Once it is running open up the Visual Basic® Editor (Alt+F11) and Insert a Module.

The easiest way for an end user to call our DLL is via a menu item. Seeing how we are creating an Add-in, our menu item should be created when loaded and removed when unloaded. For this we use the Auto_Open and Auto_Close procedures. I also like to put version information in my menus. We also need to declare our DLL function so that our VBA ‘application’ knows it exists.
[Here comes the VB part]

Option Explicit

Const strVersion As String = "Rev 1.00A"

Declare Function DoEmpty Lib "emptydll" (ByVal thestring As String, _
ByVal base As Single, ByVal newbase As Single, ByRef ooutsingle As Single) As Boolean

Sub Auto_Open()
Dim MyMenu As Menu

Set MyMenu = MenuBars(xlWorksheet).Menus.Add("BPStuff", 10)
MyMenu.MenuItems.Add "CallIt", "CallMyEmptyDll"
MyMenu.MenuItems.Add "---"
MyMenu.MenuItems.Add strVersion
End Sub

Sub Auto_Close()
MenuBars(xlWorksheet).Menus("BPStuff").Delete
End Sub

Sub CallMyEmptyDll()

Dim sometext As String * 30
Dim returnsingle As Single
Dim theresult As Boolean

sometext = ActiveCell.Value
While ((sometext <> Empty) And Not (IsEmpty(ActiveCell)))
theresult = DoEmpty(sometext, 400, 450.56, returnsingle)
If theresult Then
Selection.Offset(0, 1).Select
ActiveCell.Value = returnsingle
Selection.Offset(1, -1).Select
sometext = ActiveCell.Value
End If
Wend
End Sub

This simple example looks at the current cell and checks for a value and then ‘performs a calculation’ and places the result in the adjacent cell. To allow for an undetermined number of items this procedure goes through a list and stops when it finds a blank cell or value. The only thing left is to save the application as an Excel® Add-in (*.xla) and place it in the Add-in directory (or any other directory). From within Excel® select Tools --> Add-ins and activate your newly saved add-in. Once active it will load each time.

Well, I think we’re all done with our project. At this point you should be able to select a cell and call our function from a menu.

Labels: Apps, Code, VB, WIN32

posted by Brad Prendergast at 7:19: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

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

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,