| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Ассоциирование типов файлов с программой [D6, D7, Win2k, WinXP]

SlasherX ©   (2004-08-14 08:03:00) 

Есть у кого-нибудь подробное описание работы с типами файлов в Windows?
Следующая проблема: Мне необходимо предоставить возможность пользователю самому выбирать, какие типы файлов он хочет открывать с помощью моей программы, а какие не хочет. В случае, если он выбрал сначала какой то тип файлов, а потом убрал - необходимо восстанавливать предыдущее состояние.
Помогите плиз.

---

Кириешки   (2004-08-14 09:50:00) [1]


var
reg:TRegistry;
begin
reg:=TRegistry.Create;
reg.RootKey:=HKEY_CLASSES_ROOT;
reg.OpenKey('.'+ext,True);
reg.WriteString('',ext+'file');
reg.CloseKey;
reg.CreateKey(ext+'file');
reg.OpenKey(ext+'file\DefaultIcon',True);
reg.WriteString('',FileName+',0');
reg.CloseKey;
reg.OpenKey(ext+'file\shell\open\command',True);
reg.WriteString('',FileName+' "%1"');
reg.CloseKey;
reg.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
RegisterFileType('iii',Application.ExeName);
end;

---------------------
или вот полнее : (начало)


      prg  : the application                      
procedure registerfiletype(ft,key,desc,icon,prg:string);
procedure deregisterFileType(ft: String);
procedure FileTAddAction(key, name, display, action: String);
procedure FileTDelAction(key, name: String);
procedure FileTAddNew(ft, param: String; newType: TFileNewType);
procedure FileTDelNew(ft: String);

implementation

procedure FileTDelNew(ft: String);
var myReg:TRegistry;
begin
myReg:=TRegistry.Create;
myReg.RootKey:=HKEY_CLASSES_ROOT;
if not myReg.KeyExists(ft) then
begin
MyReg.Free;
Exit;
end;
MyReg.OpenKey(ft, true);
if MyReg.KeyExists('ShellNew') then
MyReg.DeleteKey('ShellNew');
MyReg.CloseKey;
MyReg.Free;
end;

procedure FileTAddNew(ft, param: String; newType: TFileNewType);
var myReg:TRegistry;
begin
myReg:=TRegistry.Create;
myReg.RootKey:=HKEY_CLASSES_ROOT;
if not myReg.KeyExists(ft) then
begin
MyReg.Free;
Exit;
end;
myReg.OpenKey(ft+'\ShellNew', true);
case NewType of
ftNullFile : MyReg.WriteString('NullFile', '');
ftFileName : MyReg.WriteString('FileName', param);
ftCommand  : MyReg.WriteString('Command', param);
end;
MyReg.CloseKey;
MyReg.Free;
end;

procedure FileTDelAction(key, name: String);
var myReg: TRegistry;
begin
myReg:=TRegistry.Create;
myReg.RootKey:=HKEY_CLASSES_ROOT;

if key[1] = '.' then
key := copy(key,2,maxint)+'_auto_file';

if key[Length(key)-1] <> '\' then //Add a \ if necessary
key:=key+'\';
myReg.OpenKey('\'+key+'shell\', true);
if myReg.KeyExists(name) then
myReg.DeleteKey(name);
myReg.CloseKey;
myReg.Free;
end;

procedure FileTAddAction(key, name, display, action: String);
var
myReg:TRegistry;
begin
myReg:=Tregistry.Create;
myReg.RootKey:=HKEY_CLASSES_ROOT;
if name='' then name:=display;

if key[1] = '.' then
key:= copy(key,2,maxint)+'_auto_file';

if key[Length(key)-1] <> '\' then //Add a \ if necessary
key:=key+'\';
if name[Length(name)-1] <> '\' then //dito. For only two calls, I won't write a function...
name:=name+'\';

myReg.OpenKey(key+'Shell\'+name, true);
myReg.WriteString('', display);
MyReg.CloseKey;
MyReg.OpenKey(key+'Shell\'+name+'Command\', true);
MyReg.WriteString('', action);
myReg.Free;
end;

procedure deregisterFileType(ft: String);
var
myreg:TRegistry;
key: String;
begin
myreg:=TRegistry.Create;
myReg.RootKey:=HKEY_CLASSES_ROOT;
{
1.01: Added the following if-statement: I thought
      TRegistry.OpenKey would raise an exception when
      the key does not exist. Actually it opens NO key
      and returns False. The myReg.DeleteKey then
      deleted the WHOLE HKEY_CLASSES_ROOT-Key. Ups.
}
if myReg.OpenKey(ft, False) = false then
Exit;
key:=MyReg.ReadString('');
MyReg.CloseKey;
myReg.DeleteKey(ft);
myReg.DeleteKey(key);
myReg.Free;
end;

procedure registerfiletype(ft,key,desc,icon,prg:string);
var myreg : treginifile;
   ct : integer;
begin

    // make a correct file-extension
    ct := pos('.',ft);
    while ct > 0 do begin
          delete(ft,ct,1);
          ct := pos('.',ft);
    end;
    if (ft = '') or (prg = '') then exit; //not a valid file-ext or ass. app
    ft := '.'+ft;
    myreg := treginifile.create('');
    try
       myreg.rootkey := hkey_classes_root; // where all file-types are described
       if key = '' then key := copy(ft,2,maxint)+'_auto_file'; // if no key-name is given,
                                                            // create one
       myreg.writestring(ft,'',key); // set a pointer to the description-key
       myreg.writestring(key,'',desc); // write the description
       if icon <> '' then
          myreg.writestring(key+'\DefaultIcon','',icon); // write the def-icon if given
       myreg.writestring(key+'\shell\open\command','',prg+' "%1"'); //association
    finally
           myreg.free;
    end;
//     showmessage('File-Type '+ft+' associated with'#13#10+
//     prg+#13#10);

end;

а вызывать так :

procedure TForm1.Button1Click(Sender: TObject);
begin
RegisterFileType('.tst', 'testfile', 'A Testfile', '', Application.ExeName);
ShowMessage('.tst-Files are now registered under the type ''A Testfile''');
end;

procedure TForm1.Button2Click(Sender: TObject);
var f:TextFile;
begin
AssignFile(f, ExtractFilePath(Application.ExeName)+'test.tst');
Rewrite(f);
writeln(f, 'This is a simple test');
closeFile(f);
ShowMessage('File Created: '+ExtractFilePath(Application.ExeName)+'test.tst');
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
FileTAddAction('testfile', 'edit', 'Edit with Notepad', 'Notepad "%1"');
ShowMessage('''Edit with Notepad'' added to the context menu of all .tst-Files!');
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
FileTAddNew('.tst', '', ftNullFile);
ShowMessage('The entry ''A Testfile'' is now added to the ''New''-contextmenu'+#13+#13+
           'Before you test the next 4 Buttons, please have a look at the'+#13+
           'directory of this Application ('+ExtractFilePath(Application.ExeName)+
           ')'+#13+'to see, what you have done while clicking the first 4 buttons!');
           end;

procedure TForm1.Button5Click(Sender: TObject);
begin
FileTDelNew('.tst');
ShowMessage('Entry deleted from the new-context-Menu');
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
FileTDelAction('testfile', 'edit');
ShowMessage('Action deleted from the context-Menu');

end;

procedure TForm1.Button7Click(Sender: TObject);
begin
DeregisterFileType('.tst');
end;

procedure TForm1.Button8Click(Sender: TObject);
begin
DeleteFile(ExtractFilePath(Application.ExeName)+'test.tst');
showMessage('File deleted');
end;



---

Sergey Kaminski   (2004-08-14 08:05:00) [2]

Информации более чем достаточно в Win32.hlp

---

Наверх