Форум: "Основная";
Текущий архив: 2004.08.29;
Скачать: [xml.tar.bz2];

Вниз

Ассоциирование типов файлов с программой   Найти похожие ветки 

← →
SlasherX ©   (2004-08-14 08:03) [0]

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

---

← →
Sergey Kaminski ©   (2004-08-14 08:05) [1]

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

---

← →
Кириешки ©   (2004-08-14 09:50) [2]


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;



---

Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2004.08.29;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.48 MB
Время: 0.041 c