Mega Code Archive
Fileassoctwo
<![CDATA[
Hi
I was away for a while...
anyway, here are my file association routines - not tested since win95
{--------------------------------------------------------------------------------}
type
TRootKey = (hkClassesRoot, hkCurrentConfig, hkCurrentUser, hkDynData, hkLocalMachine, hkUsers);
const
RootKeysArray: array[TRootKey] of TInteger = (HKEY_CLASSES_ROOT, HKEY_CURRENT_CONFIG, HKEY_CURRENT_USER,
HKEY_DYN_DATA, HKEY_LOCAL_MACHINE, HKEY_USERS);
{----------------------------------------------------------------------------------}
function IsEmptyString(const S: string): boolean;
begin
Result := Trim(S) = '';
end;
{-----------------------------------------------------------------------------------
Description : creates file associations and adds menu items for them in the
Explorer context menu
Parameters : FileAssocInfo : TFileAssocInfo
TFileAssocInfo = record
AppPath : string; // full path to the xecutable to associate with the extension
Extension : string; // the file extension without the leading period
Key : string; // a registry key name to create for the association
Description : string; // a description for the file type
AddLocalMenu : boolean; // it True adds the explorer local menu
MenuString : string; // the menu caption to display
OpenCmd : string; // the open command line argument, ie /o
Icon : string; // ie C:\MyApps\MyApp.exe,0 or C:\WINDOWS\SYSTEM\shell32.dll,0
end;
example call:
with FileAssocInfo do
begin
AppPath := 'C:\Windows\Notepad.exe';
Extension := 'AAA';
Key := 'AAA_TEST';
Description := 'AAA test file';
AddLocalMenu := True;
MenuString := 'Hey, I can open an AAA file!';
OpenCmd := '';
Icon := '';
end;
if not CreateFileAssoc(FileAssocInfo) then
ShowMessage('CreateFileAssoc failed');
Author : Theo Bebekis - bebekis@otenet.gr
-----------------------------------------------------------------------------------}
function ShCreateFileAssoc( FileAssocInfo : TFileAssocInfo): boolean;
{-----------------------------------------------------}
function AssebleOpenCmd(OpenCmd, AppPath: string): string;
begin
OpenCmd := Trim(OpenCmd);
if not IsEmptyString(OpenCmd) then OpenCmd := OpenCmd + ' ';
Result := AppPath + ' ' + OpenCmd + '%1';
end;
{-----------------------------------------------------}
var
S : string;
begin
Result := False;
with FileAssocInfo do
begin
if IsEmptyString(AppPath) then Exit;
if IsEmptyString(Extension) then Exit;
if Length(Extension) > 3 then RaiseError(cExtensionTooLong);
if IsEmptyString(Key) then Exit;
if IsEmptyString(Description) then Exit;
if AddLocalMenu and IsEmptyString(MenuString) then Exit;
if not (Extension[1] = '.') then
Extension := '.' + Extension;
{ write... }
with TRegIniFile.Create(' ') do
try
RootKey := RootKeysArray[hkClassesRoot];
{ write the extension - the Key points to description registy key }
WriteString(Extension, '', Key);
{ write the description key }
WriteString(Key, '', Description);
{ write the default icon if defined }
if not IsEmptyString(Icon) then
WriteString(Key + '\DefaultIcon', ' ', Icon);
{ write the OpenCmd - association }
OpenCmd := AssebleOpenCmd(OpenCmd, AppPath);
WriteString(Key + '\shell\open\command', ' ', OpenCmd );
{ add the Explorer local menu item }
if AddLocalMenu then
begin
S := Key + '\shell\' + 'Local_Menu';
WriteString(S, ' ', MenuString);
S := Key + '\shell\' + 'Local_Menu' + '\command';
WriteString(S, ' ', OpenCmd);
end;
Result := True;
finally
CloseKey;
Free;
end;
end;
end;
{----------------------------------------------------------------------------------
Description :
Notes :
-----------------------------------------------------------------------------------}
procedure ShDeleteFileAssoc(Ext, Key: string);
begin
with TRegIniFile.Create('') do
try
RootKey := RootKeysArray[hkClassesRoot];
if not (Ext[1] = '.') then Ext := '.' + Ext;
EraseSection(Ext);
EraseSection(Key);
finally
CloseKey;
Free;
end;
end;
{----------------------------------------------------------------------------------
Description :
Parameters :
Error checking :
Notes :
-----------------------------------------------------------------------------------}
procedure ShOpenWithDlg(const Path: string);
begin
ShExecute('RunDLL32.exe', PChar('shell32.dll,OpenAs_RunDLL ' + Path), SW_NORMAL);
end;
Theo
-----------------------------------
Theo Bebekis
Thessaloniki, Greece
bebekis@otenet.gr
-----------------------------------
_______________________________________________
Delphi mailing list -> Delphi@elists.org
http://elists.org/mailman/listinfo/delphi
]]>