随笔 - 2146  文章 - 97 评论 - 11767 trackbacks - 253

代码文件:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses Registry, ShlObj;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Memo1.Align := alTop;
  Memo1.ScrollBars := ssBoth;
  Button1.Caption := '设置文件关联、图标关联';
  Button2.Caption := '取消设置';

  if (ParamStr(1) <> '') and FileExists(ParamStr(1)) then
    Memo1.Lines.LoadFromFile(ParamStr(1));
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  reg: TRegistry;
begin
  reg := TRegistry.Create;
  reg.RootKey := HKEY_CLASSES_ROOT;

  {在注册表中添加我们虚拟的 .tst 格式, 并指定默认项的值是 TestFile}
  reg.OpenKey('.tst', True);
  reg.WriteString('', 'TestFile');
  reg.CloseKey;

  {文件打开关联}
  reg.OpenKey('TestFile\shell\open\command', True);
  reg.WriteString('', ParamStr(0) + ' %1');
  reg.CloseKey;

  {文件图标关联}
  reg.OpenKey('TestFile\DefaultIcon', True);
  reg.WriteString('', ParamStr(0) + ',0');
  reg.CloseKey;

  reg.Free;

  {刷新图标显示}
  SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, nil, nil);
end;

{清除上面的设置}
procedure TForm1.Button2Click(Sender: TObject);
var
  reg: TRegistry;
begin
  reg := TRegistry.Create;
  reg.RootKey := HKEY_CLASSES_ROOT;
  reg.DeleteKey('.tst');
  reg.DeleteKey('TestFile');
  reg.Free;
  SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, nil, nil);
end;

end.

posted on 2008-08-24 00:17  万一  阅读(...)  评论(...编辑  收藏