DELPHI AREA Forum

Like in subject. how to do it?

Normally i would analyse keys in registry, but in this conditions it's allmost imposible to me. I want to register extension as good as does it Delphi instaler (ofcoz with DDE), but also save older association, and when user decides to unassociate extension it should restore saved association

http://jrsoftware.org/isfaq.php#assoc

Hope that it helps.

Kambiz

Well i want to do it without instalator. It should be in program.

Although that link is related to an installer, however you just need to follow the registry links described on the page in your own program.

Yes, you're right... but how to save/restore associations?

GetAssociation reads the association information of the given file extension from registry.
SetAssociation assigns the association information of the given file extension to registry.
The file extension must begin with a perid.

Code: Select all

uses
  Registry;

function GetAssociation(const Ext: String; var Name, Desc, Command, Icon: String): Boolean;
var
  R: TRegistry;
begin
  Result := False;
  R := TRegistry.Create;
  try
    R.RootKey := HKEY_CLASSES_ROOT;
    if R.OpenKeyReadOnly('\' + Ext) then
    begin
      Name := R.ReadString('');
      R.CloseKey;
      if R.OpenKeyReadOnly('\' + Name) then
      begin
        Desc := R.ReadString('');
        R.CloseKey;
        if R.OpenKeyReadOnly('\' + Name + '\shell\open\command') then
        begin
          Command := R.ReadString('');
          R.CloseKey;
          Result := True;
          if R.OpenKeyReadOnly('\' + Name + '\DefaultIcon') then
          begin
            Icon := R.ReadString('');
            R.CloseKey;
          end
          else
            Icon := '';
        end;
      end;
    end;
  finally
    R.Free;
  end;
end;

function SetAssociation(const Ext: String; const Name, Desc, Command, Icon: String): Boolean;
var
  R: TRegistry;
begin
  Result := False;
  R := TRegistry.Create;
  try
    R.RootKey := HKEY_CLASSES_ROOT;
    if R.OpenKey('\' + Ext, True) then
    begin
      R.WriteString('', Name);
      R.CloseKey;
      if R.OpenKey('\' + Name, True) then
      begin
        R.WriteString('', Desc);
        R.CloseKey;
        if R.OpenKey('\' + Name + '\shell\open\command', True) then
        begin
          R.WriteString('', Command);
          R.CloseKey;
          Result := True;
          if (Icon <> '') and R.OpenKey('\' + Name + '\DefaultIcon', True) then
          begin
            R.WriteString('', Icon);
            R.CloseKey;
          end;
        end;
      end;
    end;
  finally
    R.Free;
  end;
end;

An example of usage:

Code: Select all

procedure TForm1.Button1Click(Sender: TObject);
var
  Name, Desc, Command, Icon: String;
begin
  if GetAssociation('.txt', Name, Desc, Command, Icon) then
  begin
    Memo1.Lines.Add(Name);
    Memo1.Lines.Add(Desc);
    Memo1.Lines.Add(Command);
    Memo1.Lines.Add(Icon);
  end;
end;

Hope that it helps.
Kambiz