//> 1) How do I programmatically set file associations so when a person double
//> clicks it will open my application?
//>
//> 2) Once a file association is set, when double clicking, if my app is already
//> open, a second instance is opened. How do I prevent a second instance from
//> opening (I can do this with the "lonely" component) yet STILL have the existing
//> app that is opened get a message to process the file that is double clicked?
//
//These two questions are connected, you need to create a number of keys in the
//registry and make your application a DDE server. Since this question comes up
//regularly i have created a sample application to show the steps involved. The app
//registers itself when started but you can move that part to an installation
//program, of course.
//Apologies to any lurkers for the size of this message, but i think in this case
//well commented code is more important than a small message size.
{+------------------------------------------------------------
| Unit FileAssociation_Demo1
|
| Version: 1.0 Created: 14.03.99
| Last Modified: 14.03.99
| Environment : Delphi 4.02, tested on Win95B
| Author : P. Below
| Project: Sample applications
| Description:
| This is a simple demo application that shows how to register
| an application as server for a file extension (.TED in this
| case) and how to use DDE to open files from Explorer in
| an existing instance of the program.
| A file association requires, at minimum, the following keys
| in the registry under HKEY_CLASSES_ROOT (HKCR):
|
| HKCR\<extension> = <filetype>
| HKCR\<filetype> = <description>
| HKCR\<filetype>\shell\open\command = <application> "%1"
|
| "open" is one of the standard verbs, others that may be used
| are "edit", "print", and "printto". If all verbs are implemented
| by the same application command line switches may be used
| to differentiate the action to take in the command key string.
| See the entry for HKCR\rtffile in regedit.exe for an example.
|
| If only the three keys above are present Explorer will open
| a new instance of the application for each file. To get it to
| use an existing instance one needs to make the application into
| a DDE server and add some more keys to the registry:
|
| HKCR\<filetype>\shell\open\ddeexec = <macrostring>
| HKCR\<filetype>\shell\open\ddeexec\topic = <topicname>
| HKCR\<filetype>\shell\open\ddeexec\application = <DDE Servername>
|
| If a TDDEServerConv object is used to implement the DDE server
| then <topicname> is the name of the TDDEServerConv component
| and <DDE Servername> is the applications filename, without
| path and extension.
|
| To test this application copy a number of textfiles (e.g. PAS
| files) to extension TED and open them in Explorer. Note that
| you have to run the application once manually to get it to
| register itself.
+------------------------------------------------------------}
Unit Fileassociation_demo1;
Interface
Uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, DdeMan, ComCtrls;
Type
TForm1 = Class(TForm)
TEDDdeServer: TDdeServerConv;
PageControl1: TPageControl;
Procedure FormCreate(Sender: TObject);
Procedure TEDDdeServerExecuteMacro(Sender: TObject; Msg: TStrings);
Private
Procedure RegisterAssociation;
Procedure AddFileeditor(Const filename: String);
{ Private declarations }
Public
{ Public declarations }
End;
Var
Form1: TForm1;
Implementation
Uses Registry, ShlObj;
{$R *.DFM}
Type
ERegistryError = Class( Exception );
ResourceString
eCannotCreateKey =
'Cannot create key %s, the user account may not have the required '+
'rights to create registry keys under HKEY_CLASSES_ROOT.';
{+------------------------------------------------------------
| Procedure CreateKey
|
| Description:
| This is a helper routine which uses the passed reg object
| to create a registry key.
| Error Conditions:
| If the key cannot be created a ERegistryError exception is
| raised.
| Created: 14.03.99 by P. Below
+------------------------------------------------------------}
Procedure CreateKey( reg: TRegistry; Const keyname: String );
Begin
If not reg.OpenKey( keyname, True ) Then
raise ERegistryError.CreateFmt( eCannotCreateKey, [keyname] );
End; { CreateKey }
{+------------------------------------------------------------
| Procedure RegisterFiletype
|
| Parameters :
| extension : file extension, including the dot, to register
| filetype : string to use as key for the file extension
| description: string to show in Explorer for files with this
| extension. If description is empty the file
| type will not show up in Explorers list of
| registered associations!
| verb : action to register, 'open', 'edit', 'print' etc.
| The action will turn up as entry in the files
| context menu in Explorer.
| serverapp : full pathname of the executable to associate with
| the file extension, including any command line
| switches. Include the "%1" placeholder as well.
| Actions like printto may require more than one
| placeholder.
| Description:
| Creates the three basic registry keys for a file extension.
| HKCR\<extension> = <filetype>
| HKCR\<filetype> = <description>
| HKCR\<filetype>\shell\<verb>\command = <serverapp>
| If the keys already exist they are overwritten!
| Error Conditions:
| A ERegistryError exception will result if a key cannot be
| created. Failure to create a key is usually due to insufficient
| user rights and only a problem on NT.
| Created: 14.03.99 by P. Below
+------------------------------------------------------------}
Procedure RegisterFiletype( Const extension, filetype, description,
verb, serverapp: String );
Var
reg: TRegistry;
keystring: String;
Begin
reg:= TRegistry.Create;
Try
reg.Rootkey := HKEY_CLASSES_ROOT;
CreateKey( reg, extension );
reg.WriteString( '', filetype );
reg.CloseKey;
CreateKey( reg, filetype );
reg.WriteString('', description );
reg.closekey;
keystring := Format('%s\shell\%s\command', [filetype, verb] );
CreateKey( reg, keystring );
reg.WriteString( '', serverapp );
reg.CloseKey;
Finally
reg.free;
End;
End; { RegisterFiletype }
{+------------------------------------------------------------
| Procedure RegisterDDEServer
|
| Parameters :
| filetype : file type key name to register the server for
| verb : action to register, 'open', 'edit', 'print' etc.
| topic : DDE topic name to use. This is usually the name
| of a TDDEServerConv component.
| servername: DDE server name to use. This is usually the
| filename of the executable, without extension
| and path.
| macro : DDE macro to execute for the action, needs to
| include a "%1" placeholder for a filename.
| Description:
| Creates the registry keys required to open files of this type
| via DDE from Explorer or ShellExecute. RegisterFileType needs
| to be called first to associate the filetype with an extension.
| The registry keys added are
| HKCR\<filetype>\shell\<verb>\ddeexec = <macro>
| HKCR\<filetype>\shell\<verb>\ddeexec\topic = <topic>
| HKCR\<filetype>\shell\<verb>\ddeexec\application = <servername>
| If the keys already exist they are overwritten!
| Error Conditions:
| A ERegistryError exception will result if a key cannot be
| created. Failure to create a key is usually due to insufficient
| user rights and only a problem on NT.
| Created: 14.03.99 by P. Below
+------------------------------------------------------------}
Procedure RegisterDDEServer( Const filetype, verb, topic, servername, macro:
String );
Var
reg: TRegistry;
keystring: String;
Begin
reg:= TRegistry.Create;
Try
reg.Rootkey := HKEY_CLASSES_ROOT;
keystring := Format( '%s\shell\%s\ddeexec',[filetype, verb] );
CreateKey( reg, keystring );
reg.WriteString( '', macro );
reg.CloseKey;
CreateKey( reg, keystring + '\Application' );
reg.WriteString( '', servername );
reg.CloseKey;
CreateKey( reg, keystring + '\topic' );
reg.WriteString( '', topic );
reg.CloseKey;
Finally
reg.free;
End;
End; { RegisterDDEServer }
{+------------------------------------------------------------
| Procedure TForm1.RegisterAssociation
|
| Call method: static
| Visibility : private
| Description:
| Register this application as server for the .TED file
| extension.
| Error Conditions:
| A ERegistryError exception will result if a key cannot be
| created.
| Created: 14.03.99 by P. Below
+------------------------------------------------------------}
Procedure TForm1.RegisterAssociation;
Begin
RegisterFiletype(
'.TED',
'TEDFile',
'TED File',
'open',
Application.Exename+' "%1"' );
RegisterDDEServer(
'TEDFile',
'open',
TEDDdeServer.Name,
Uppercase( ChangeFileExt(
ExtractFilename( Application.Exename ),
EmptyStr )),
'[Open("%1")]' );
ShChangeNotify( SHCNE_ASSOCCHANGED, 0, Nil, Nil );
End; { TForm1.RegisterAssociation }
{+------------------------------------------------------------
| Procedure TForm1.FormCreate
|
| Event : OnCreate
| Used by : the form
| Call method: static
| Visibility : published
| Description:
| On form creation we register the application as server for
| the .TED extension and create editors for any file that
| may have been passed on the commandline.
| Note that the commandline processing code needs to be
| changed if command line switches are used to select
| between different actions!
| Error Conditions:
| A ERegistryError exception may be raised in the registration
| process.
| Created: 14.03.99 by P. Below
+------------------------------------------------------------}
Procedure TForm1.FormCreate(Sender: TObject);
Var
i: integer;
Begin
RegisterAssociation;
For i:= 1 To ParamCount Do
AddFileeditor( ParamStr( i ));
End; { TForm1.FormCreate }
{+------------------------------------------------------------
| Procedure TForm1.TEDDdeServerExecuteMacro
|
| Event : OnExecuteMacro
| Used by : TEDDdeServer
| Call method: static
| Visibility : published
| Description:
| This method is called when the DDE server receives a macro
| request. In this case the request will always be a single
| line but the code is able to deal with several macros rolled
| into one request, as long as the macros are separated by
| line breaks.
| Error Conditions: none
| Created: 14.03.99 by P. Below
+------------------------------------------------------------}
Procedure TForm1.TEDDdeServerExecuteMacro(Sender: TObject; Msg: TStrings);
Var
filename: String;
i, n: Integer;
Begin
If Msg.Count > 0 Then Begin
For i := 0 To Msg.Count-1 Do Begin
filename := Msg[i];
If Pos('[Open(', filename) = 1 Then Begin
n:= Pos('"', filename );
If n > 0 Then Begin
Delete( filename, 1, n );
n:= Pos('"', filename );
If n > 0 Then
Delete( filename, n, maxint );
AddFileeditor( filename );
End; { if }
End; { If }
End; { For }
End; { if }
End; { TForm1.TEDDdeServerExecuteMacro }
{+------------------------------------------------------------
| Procedure TForm1.AddFileeditor
|
| Parameters :
| filename: full pathname of a file to view
| Call method: static
| Visibility : private
| Description:
| Creates a new tabsheet in the pagecontrol and a TMemo on
| this tabsheet. The file is loaded into the memo and the
| tabsheet is made active.
| Error Conditions:
| Exceptions may result if the file is not found or is not
| a textfile.
| Created: 14.03.99 by P. Below
+------------------------------------------------------------}
Procedure TForm1.AddFileeditor( Const filename: String );
Var
tab: TTabSheet;
memo: TMemo;
Begin
tab := TTabsheet.Create(self);
tab.Pagecontrol := pagecontrol1;
tab.caption := Extractfilename( filename );
memo := TMemo.Create( tab );
memo.Align := alClient;
memo.Parent := tab;
memo.lines.LoadFromFile( filename );
Pagecontrol1.ActivePage := tab;
End; { TForm1.AddFileeditor }
End.
{
object Form1: TForm1
Left = 192
Top = 128
AutoScroll = False
Caption = 'Form1'
ClientHeight = 373
ClientWidth = 632
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 120
TextHeight = 16
object PageControl1: TPageControl
Left = 0
Top = 0
Width = 632
Height = 373
Align = alClient
TabOrder = 0
end
object TEDDdeServer: TDdeServerConv
OnExecuteMacro = TEDDdeServerExecuteMacro
Left = 32
Top = 24
end
end
}
//Peter Below (TeamB) 100113.1101@compuserve.com)
//No e-mail responses, please, unless explicitely requested!