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;

Posted on Wednesday, August 30, 2006 6:43 AM by Brad Prendergast

| Permalink | Comments (0)

Tags: , ,



   

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.

Posted on Tuesday, August 29, 2006 8:00 PM by Brad Prendergast

| Permalink | Comments (0)

Tags: , ,



   

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.

Posted on Sunday, August 27, 2006 6:18 PM by Brad Prendergast

| Permalink | Comments (0)

Tags: , ,