delphi 注册表

Delphi中定义了一个Tregistry类，通过使用这个类中封装的很多有关对注册表操作的方法和属性可以完成对注册表的操作。
1、在注册表中创建一个新的关键字
Tregistry类中有一个CreateKey方法，使用该方法可以在注册表中创建一个新的关键字，该方法的原型声明为：function CreateKey(const Key: string) : Boolean;
2、向注册表关键字中写入相关的数据值
在Tregistry类中提供了一系列的Write方法用来写入与当前关键字相关的数据值。常用方法的原型定义如下：
procedure WriteString(const Name, Value : string);
procedure WriteInteger(const Name : string ; Value : Integer);
procedure WriteFloat(const Name : string ; Value : Double);
procedure WriteTime(const Name : string ; Value : TDateTime);
procedure WriteBool(const Name : string ; Value : Boolean);
3、从注册表关键字中读出相关的数据值
在Tregistry类中还提供了与Write方法相对应用的用来读出与当前关键字相关的数据值。常用方法的原型定义如下：
founction ReadString(const Name : string) : string;
founction ReadInteger(const Name : string) : Integer;
founction ReadFloat(const Name : string) : Double;
founction ReadTime(const Name : string) : TdateTime;
founction ReadBool(const Name) : Boolean;
4、从注册表删除关键字或指定的数据值
使用Tregistry中提供的DeleteKey和DeleteValue方法可以删除指定的关键字和数据值。这两个方法的原型定义如下：
function DeleteKey(const Key : string) : Boolean;
function DeleteValue(const Key : string) : Boolean;
使用DeleteKey方法删除指定的关键字时，如果被删除的关键字在任何层次有子关键字，它们将同时被删除。上面两个方法在执行时，如果删除成功，则返回True；否则返回False。
5.其他函数
reg.keyexists()
reg.valueexists()

//代码与关键注释
uses registry;
procedure TForm1.Button1Click(Sender: TObject);
var
reg:Tregistry;
s:string;
begin
reg:=Tregistry.Create;
reg.RootKey:=HKEY_LOCAL_MACHINE;
reg.OpenKey('softwaremicrosoftwindowscurrentversion
un', True);//启动选项注册表选项位置
reg.Writestring('zqd', application.ExeName);//前面那个可以任意设置，自己记住就好了,金山开机管理名字是这个，启动程序有zqd
if reg.ValueExists('zqd') then  //存在了 就说明添加成功了保险起见
showmessage('设置成功');
reg.CloseKey;
reg.Free;
end;
 
procedure TForm1.Button2Click(Sender: TObject);
var
reg:Tregistry;
s:string;
begin
reg:=Tregistry.Create;
reg.RootKey:=HKEY_LOCAL_MACHINE;
reg.OpenKey('softwaremicrosoftwindowscurrentversion
un',false);
if reg.DeleteValue('zqd')then                      //刚才设置的那个
begin
showmessage('已经取消了');
end
else
showmessage('没有自动运行');
reg.CloseKey;
reg.Free;
end;
end.

View Code

获取程序安装目录

registry;
Procedure TMainFrm.LoadSoftList;
var
  myreg:TRegistry;
  myList:TStringList;
  i:integer;
  curkey,SName:string;
begin
  myreg:=TRegistry.Create;
  MyList:=TStringList.Create;
  myreg.RootKey:=HKEY_LOCAL_MACHINE;
  //获取注册表安装目录
  if myreg.OpenKey('SoftwareMicrosoftWindowsCurrentVersionuninstall',False) then
  Begin
    myreg.GetKeyNames(myList);
    //memo1.Lines.Text:=myList.Text;
    curkey:=myreg.CurrentPath;
    myreg.CloseKey;
    for i:=0 to MyList.Count-1 do
    if myreg.OpenKey(curKey+''+MyList.Strings[i],False) then
    Begin
      if myreg.ValueExists('DisplayName') then
        Sname:=myreg.ReadString('DisplayName')
      else
        SName:=MyList.Strings[i];
      if myreg.ValueExists('DisplayVersion') then
        Sname:=Sname+'  版本：'+myreg.ReadString('DisplayVersion')
      else
        SName:=MyList.Strings[i];
      memo1.Lines.Add(SName);
      myreg.CloseKey;
    end;
  end;
end;

procedure TMainFrm.GetWinMemory;
var
  PhysicalTotalOut,PhysicalFreeOut,VirtualTotalOut,VirtualFreeOut:string;
  MemStatus: MEMORYSTATUS;
begin
  MemStatus.dwLength := sizeof(MEMORYSTATUS);
  GlobalMemoryStatus(MemStatus); //返回内存使用信息
  PhysicalTotalOut:=FormatFloat(' Physical Memory Total: #,## ',Round(MemStatus.dwTotalPhys/ 1024 / 1024));
  PhysicalFreeOut:=FormatFloat(' Physical Memory Free: #,## ',MemStatus.dwAvailPhys/ 1024 / 1024);
  VirtualTotalOut:=FormatFloat(' Virtual Memory Total: #,## ',MemStatus.dwTotalVirtual/ 1024 / 1024);
  VirtualFreeOut:=FormatFloat(' Virtual Memory Free: #,## ',MemStatus.dwAvailVirtual/ 1024 / 1024);
  Label3.Caption:= PhysicalTotalOut +#13+PhysicalFreeOut;
  Label4.Caption:= VirtualTotalOut +#13+ VirtualFreeOut;
End;

View Code

利用Delphi监视注册表的变化

我们在编写软件的时候，常常需要把一些信息保存到系统的注册表中。如果用户更改了注册表的信息，我们如何及时知道，并做相应的处理呢？通过研究，我们发现在Win98以上操作系统中，微软在SDK函数库中增加了RegNotifyChangeKeyValue函数，用于监视注册表特定键值的变化。下面我们就怎样用Delphi编一个注册表监视器，做详细地探讨。
关于注册表监视函数
下面是注册表监视函数地声明：
function RegNotifyChangeKeyValue(
hKey : HKEY, // 需要监视地注册表键
bWatchSubtree : LongBool, // 是否监视其子键
dwNotifyFilter : Cardinal, // 监视键变化的类型
hEvent : Cardinal, // 当有变化时所触发的通知事件句柄
fAsynchronous : LongBool // 异步通知事件标志
) : integer;
根据MSDN中对该函数的描述，我们对其参数做一下描述：
hKey －－我们所要监视的目标键值句柄，它必须是已经被打开的。要打开一个注册表键可以利用Tregistry 中的OpenKeyReadOnly函数。
dwNotifyFilter ――是一组标志集合，用于标识我们需要监视的变化类型，它们包括：
REG_NOTIFY_CHANGE_NAME – 增加或删除了子键
REG_NOTIFY_CHANGE_ATTRIBUTES – 改变了键的属性
REG_NOTIFY_CHANGE_LAST_SET – 键值发生了改变
REG_NOTIFY_CHANGE_SECURITY －键的安全属性发生了改变
hEvent ――当有变化时所触发的通知事件句柄。我们可以利用SDK函数CreateEvent来创建一个事件。
fAsynchronous ――以异步方式触发事件标志。

现在我们已经对如何利用该函数有了大体的了解：
1．打开需要监视的注册表键
2．创建触发事件
3．调用注册表监视函数，等待事件触发。
如果等待事件触发在主界面中实现，就会造成界面堵塞。一个解决办法就是，等待事件触发在线程中实现。

在线程中实现注册表的监视
在Delphi下进行多现成程序设计并不需要去学习庞大的Win32 API函数，我们可以利用Delphi标准的多线程类Tthread来完成我们的工作。
Tthread是一个抽象类――一个带有虚拟抽象方法的类，不能直接使用它。要做的是把Tthread作为基类，用继承的形式来生成子类。实际上，根据TThread来写线程应用是非常容易的。
1．无论何时创建一个TThread对象，首先要创建它的派生类。
2．每次创建一个TThread对象的派生类的时候，都要重载Execute方法。
我们可以利用Delphi的向导，来生成创建TThread派生类的代码：
选择Delphi的File菜单下的New选项，再选择“TThread Object”项目，Delphi就会构造基本的程序模块，然后我们再根据需要做相应修改。如下图我们构建了一个注册表监视线程：

下面我们看看该线程是如何实现对注册表的监视的：

procedure TRegMonitorThread.Execute;
begin
InitThread; // 打开注册表键,创建通知事件
while not Terminated do
begin
if WaitForSingleObject(FEvent, INFINITE) = WAIT_OBJECT_0 then
begin
fChangeData.RootKey := RootKey;
fChangeData.Key := Key;
SendMessage(Wnd, WM_REGCHANGE,
RootKey, LongInt(PChar(Key)));
ResetEvent(FEvent); // Fevent对象复位，等待再次被触发
RegNotifyChangeKeyValue(FReg.CurrentKey, 1, Filter, FEvent, 1);
end;
end;
end;

View Code

我们可以看到，Execute 过程实际上是一个循环，结束的条件是进程退出。在循环中，调用WaitForSingleObject API函数进入等待状态，直到FEvent 对象变为有信号状态。可以看出我们所等待的Fevent ，RegNotifyChangeKeyValue 曾经调用。
注意，Fevent 被触发后，我们用SendMessage 发送消息到主窗口，下面我们对此做详细讨论。
利用自定义消息传递监视信息

利用自定义消息传递监视信息
消息是Windows发出的一个通知，它告诉应用程序某个事件发生了。在Delphi中，大多数情况下Windows的消息被封装在VCL的事件中，我们只需处理相应的VCL事件就可以了，但如果我们需要利用自己定义的消息实现某些功能，再Delphi中是如何实现的呢？下面我们看看是如何利用自定义消息传递监视信息的：
1．首先定义自定义休息WM_REGCHANGE：
WM_REGCHANGE = WM_USER + 1973;
2．声明主窗体中消息响应应函数：
procedure WMREGCHANGE(var Msg : TMessage); message WM_REGCHANGE;
3．实现消息响应函数：

procedure TForm1.WMREGCHANGE(var Msg: TMessage);
begin
with Memo1.Lines do
begin
Add('-----------------------------------');
Add('Registry change at ' + DateTimeToStr(Now));
Add(IntToStr(RegMonitorThread.ChangeData.RootKey) +
' - ' + RegMonitorThread.ChangeData.Key);
end;
end;

View Code

我们在主界面上放了一个TMemo控件，用于显示注册表监视信息，在消息响应函数中，监视信息在TMemo控件中的显示。

本文来自CSDN博客，转载请标明出处：http://blog.csdn.net/oury/archive/2005/04/12/343722.aspx

通过注册表监视已安装软件

HKEY_LOCAL_MACHINESOFTWAREMicrosoftwindowsCurrentVersionUninstall我最终还是决定通过监控这个注册表项来达到判断是否有软件安装下来的目的。虽然不是所有的软件安装后都会修改该项，但是，大部分是可以的。

View Code

注册文件类型

unit regftyp; 
(*************************************************************************** 
This is a unit to handle filetyp-associations in Win95/NT. The unit supports 
 
-Registration of a filetype 
-Adding extra-actions to an entry (Like 'Edit' for Batch-Files) 
-Adding an entry to the 'New'-Context-Menu 
-Removing all the stuff that the unit can create.. 
 
Here the description of the procedures: 
 
 
RegisterFileType :   Registers a filetype 
 params: 
       ft   : the file-ext to create an association (.txt) 
       key  : the registry-key-name (not necessary) (txtfile) 
       desc : a description for the file-type       (Text-File) 
       icon : the default-icon (not necessary)      (Application.ExeName+',1') 
       prg  : the application                       (Application.ExeName 
 
 NOTES: 
       The number in the Icon-parameter describes the Index of the Icon in the 
       given filename. Note that it begins with 0 for the first icon 
 
 Example: 
       registerFileType('.rvc', 
                        'rvconfile', 
                        'RasInTask Connection', 
                        Application.ExeName+',1', 
                        Application.ExeName); 
 
----------------------- 
 
DeregisterFileType :    Removes the registration of a filetype 
 params: 
       ft   : the file-ext to create an association (.txt) (with point!!) 
 
 NOTES: 
       -This procedure kills all entries for our filetype. Also features like 
        extended actions and entries to the new-context-menu! 
 
 Example: 
       deregisterFileType('.tst'); 
 
------------------------ 
 
FileTAddAction :          Adds an action to the ContextMenu of our filetype 
 params: 
       key     : the same as in the functions above  (txtfile) 
       name    : the name of the action (not necessary) (notepad) 
       display : this is shown in the contextMenu (Edit with Notepad) 
       action  : The Action to do 
 
 NOTES: 
       If you have set up the association with this unit and an empty 'key', 
       please give here the file extension. 
       Other to the RegisterFileTpe-Call, you MUST set the FULL 
       action-parameter: 
       If you wish to open the file, you MUST write the %1 at the end, 
       because I think that there are many possibilities for an entry in the 
       Context-Menu, so I won't destroy many of them.. 
 
 Example: 
       FileTAddAction('rvconfile','edit','Edit',Application.ExeName+'-e "%1"'); 
 
------------------------ 
 
FileTDelAction :         Removes the created Action 
 params: 
       key     : the same as in the functions above  (txtfile) 
       name    : the name of the action              (notepad) 
 
 NOTES: 
       -If you have set up the association with this unit and an empty 'key', 
        please give here the file extension. 
       -If you left the param 'name' blank when you created the action, you 
        should give here the value of 'display'. 
       -Note that you have not to call this procedure if you wish to deregister 
        a filetype. My Procedure is very radical and kills the actions too... 
 
 
 Example: 
       FileTDelAction('rvconfile','edit'); 
 
procedure FileTAddNew(ft, param: String; newType: TFileNewType); 
 
------------------------ 
 
FileTAddNew :         Adds an entry to the New-context-menu 
 params: 
       ft      : the extension of our file (with point!!) (.txt) 
       param   : for extended information (see NOTES)     (Application.ExeName+' -cn') 
       newType : the typ of the entry to create           (ftCommand) 
 
 NOTES: 
       -The parameter newType is of the type 'TFileNewType' which must have one 
        of the following values: 
           ftNullFile    If the user clicks on our entry, windows will create 
                         a file with the size 0 bytes. The procedure parameter 
                         'param' is ignored 
           ftFileName    Windows will copy the File you give to this procedure 
                         in the 'param'-parameter. Useful, if your application 
                         reads a fileheader which must exist... 
           ftCommand     Windows launches the program you have given to this 
                         procedure in the 'param'-parameter. 
                         This can be used to display a wizzard 
 
       -If you use the ftCommand-type, please note that your Wizzard MUST 
        display a "Save As"-Dialog ore something like this, if you wish to 
        create a file: Windows does not copy or create a file in the folder 
        in which the user has clicked on our entry. 
 
 Example: 
       FileTAddNew('.tst','', ftNullFile); 
 
------------------------ 
 
FileTDelNew :         Removes our entry in the 'New'-ContextMenu 
 params: 
       ft      : the filetype of our file (with point!!)  (.txt) 
 
 NOTES: 
       -Note that you have not to call this procedure if you wish to deregister 
        a filetype. My Procedure is very radical and kills the actions too... 
 
 
 Example: 
       FileTDelNew('.tst'); 
 
-------------------------------------------------------------------------------- 
 
I have written this unit for my Freeware(!) program RasInTask. It is a 
dialup-dialer with some extra-feature. 
 
For the version 1.1 I am now implementing a feature named "virtual connections", 
and I need to register filetypes. I do not know why Microsoft did not implement 
a "RegisterFiletype"-Function to the API. So the programmer has to do very to 
much of work. 
 
You can use this Unit when- and whereever you wish. It is freeware. 
 
Please visit my Homepage at http://www.mittelschule.ch/pilif/ for other cool 
tools or send an Email to pilit@dataway.ch or pilif@nettaxi.com 
 
Version 1.0 
 
History: none 
 
ToDo-List: 
 
I will add some Errorhandling. Since I did in the past never need to create 
exceptions, I do not know how to do this. I will add some as soon as I know 
how... 
 
*******************************************************************************) 
 
interface 
 
uses windows,registry,dialogs; 
 
type 
     TFileNewType = (ftNullFile, ftFileName, ftCommand); //This is the type of 
                                                        //entry to add to the 
                                                        //new-menu 
 
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; 
myReg.OpenKey(ft, False); 
key:=MyReg.ReadString(''); 
MyReg.CloseKey; 
//showMEssage(key); 
myReg.DeleteKey(ft); 
myReg.DeleteKey(key); 
myReg.Free; 
end; 
 
procedure registerfiletype(ft,key,desc,icon,prg:string); 
var myreg : treginifile; 
    ct : integer; 
begin 
//   RegisterFileType('.tst', 'testfile', 'A Testfile', '', 
//                    Application.ExeName); 
 
     // 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+'shellopencommand','',prg+' "%1"'); //association 
     finally 
            myreg.free; 
     end; 
//     showmessage('File-Type '+ft+' associated with'#13#10+ 
//     prg+#13#10); 
 
 
 
end; 
end. 







unit Unit1; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
  StdCtrls; 
 
type 
  TForm1 = class(TForm) 
    Button1: TButton; 
    Button2: TButton; 
    Button3: TButton; 
    Button4: TButton; 
    Button5: TButton; 
    Button6: TButton; 
    Button7: TButton; 
    Button8: TButton; 
    Label1: TLabel; 
    procedure Button1Click(Sender: TObject); 
    procedure Button2Click(Sender: TObject); 
    procedure Button3Click(Sender: TObject); 
    procedure Button4Click(Sender: TObject); 
    procedure Button5Click(Sender: TObject); 
    procedure Button6Click(Sender: TObject); 
    procedure Button7Click(Sender: TObject); 
    procedure Button8Click(Sender: TObject); 
  private 
    { Private-Deklarationen } 
  public 
    { Public-Deklarationen } 
  end; 
 
var 
  Form1: TForm1; 
 
implementation 
 
uses regftyp; 
 
{$R *.DFM} 
 
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; 
 
end.

View Code

注册文件类型,设置文件图标

{-------------------------------------------------------------------------------
  @过程名:    slpert -> TFm_main.SetAssociatedExec
  @作者:      Gavin
  @日期:      2004.09.08
  @功能描述：
  @参数:      FileExt, Filetype, FileDescription, MIMEType, ExecName: string
  @返回值:    Boolean
-------------------------------------------------------------------------------}

Function TFm_main.SetAssociatedExec(FileExt, Filetype, FileDescription,
  MIMEType, ExecName: String): Boolean; {修改成功，返回True，否则False}
Var
  Reg: TRegistry;
  ShFileInfo: TSHFILEINFO;
  IconIndex: integer;
Begin

  Result := False; {}
  // ShGetFileInfo(Pchar(ExecName), 0, SHFileInfo,SizeOf(SHFileInfo), SHGFI_LARGEICON or SHGFI_SYSICONINDEX or SHGFI_TYPENAME or SHGFI_SMALLICON);
   //IconIndex:=SHFileInfo.iIcon;
   //showmessage(inttostr(iconIndex));
  If (FileExt = ) Or (ExecName = ) Then
    Exit; {如果文件类型为空或者没有定义执行程序就退出，FileExt必须带″.″，如.BMP}
  Reg := TRegistry.Create;
  Try
    Reg.RootKey := HKey_Classes_Root;
    If Not Reg.OpenKey(FileExt, True) Then
      Exit; {当不能正确找到或创建FileExt键时退出，这种情况一般是注册表有错误，以下同}
    Reg.WriteString(, FileType);
    If MIMEType <> Then
    Begin
      Reg.WriteString(Content Type, MIMEType);
    End;
    Reg.CloseKey;
    If Not Reg.OpenKey(FileType, True) Then
      Exit;
    Reg.WriteString(, FileDescription);
    If Not Reg.OpenKey(shellopencommand, True) Then
      Exit;
    Reg.WriteString(, ExecName + "%1");
    {执行程序一般都有参数，例如WinZip的“winzip32.exe ″％1″”，″％1″参数指ZIP文件的文件名。因此ExecName应视情况加入参数}
    Reg.CloseKey;
    If Not Reg.OpenKey(FileType + DefaultIcon, True) Then
      Exit;
    Reg.WriteString(,ExecName+ ,1);   ///ExtractFilePath(
    Reg.CloseKey;
    Result := true;
  Finally
    Reg.Free;
  End;
End;


文章整理：西部数码--专业提供域名注册、虚拟主机服务
http://www.west263.com
以上信息与文章正文是不可分割的一部分,如果您要转载本文章,请保留以上信息，谢谢!

View Code