|
|||||||||
|
|||||||||
|
|
||||||||||||||
| | 网站首页 | 数据库教程 | web编程 | 服务器 | 程序设计 | | ||
 |
||
|
||
|
||||||||||
| Delphi的注册表操作 | ||||||||||
作者：佚名 文章来源：不详 点击数： 更新时间：2007-9-12  |
||||||||||
|
32位Delphi程序中可利用TRegistry对象来存取注册表文件中的信息。
一、创建和释放TRegistry对象 1.创建TRegistry对象。为了操作注册表，要创建一个TRegistry对象：ARegistry := TRegistry.Create； 2.释放TRegistry对象。对注册表操作结束后，应释放TRegistry对象所占内存：ARegistry.Destroy。 二、指定要操作的键 操作注册表时，首先应指定操作的主键：先给属性RootKey赋值以指定根键，然后用方法OpenKey来指定要操作的主键名。
1.指定根键(RootKey)。 根键是注册表的入口，也注册表信息的分类，其值可为： HKEY—CLASSES—ROOT：存储整个系统对象类信息，如ActiveX对象注册、文件关联等信息。 HKEY—CURRENT—USER：存储当前用户的配置信息。为属性RootKey的默认值。 HKEY—LOCAL—MACHINE：存储当前系统的软硬件配置信息。应用程序自己的信息可以存储在该根键下。 HKEY—USERS：存储所有用户通用的配置信息。 还可以是HKEY—CURRENT—CONFIG、HKEY—DYN—DATA。 2.指定要操作的主键。 Function OpenKey(const Key: string; CanCreate: Boolean): Boolean; Key：主键名，是键名全名中除去根键的部分，如Software\Borland\Delphi。 CanCreate：在指定的主键名不存在时，是否允许创建该主键，True表示允许。 返回值True表示操作成功。 3.关闭当前主键。 在读取或存储信息之后，应及时将关闭当前主键：procedure CloseKey。 三、从注册表中读取信息 Read系列方法从注册表读取指定的信息（字符串、二进制和十六进制），并转换为指定的类型。 1.Read系列方法。 function ReadString(const Name: string): string; 读取一个字符串值，Name为字符串名称。 function ReadInteger(const Name: string): Integer; 读取一个整数值，Name为整数名称。 function ReadBinaryData(const Name: string; var Buffer; BufSize: Integer):Integer; 读取二进制值，Name为二进制值名称，Buffer为接收缓冲区，BufSize为缓冲区大小，返回为实际读取的字节数。 其它方法还有：ReadBool、ReadCurrency、ReadDate、ReadDateTime、ReadFloat、ReadTime。 2.读取信息一例（显示Windows的版本）。 在HKEY—LOCAL—MACHINE\Software\Microsoft\Windows\CurrentVersion下，有三个字符串值Version、VersionNumber和SubVersionNumber，用于记录当前Windows的版本号。 {请在Uses中包含Registry单元} procedure TForm1.Button1Click(Sender:TObject); var ARegistry : TRegistry; begin ARegistry := TRegistry.Create; //建立一个TRegistry实例 with ARegistry do begin RootKey := HKEY—LOCAL—MACHINE;//指定根键为HKEY—LOCAL—MACHINE //打开主键Software\Microsoft\Windows\CurrentVersion if OpenKey( ′Software\Microsoft\Windows\CurrentVersion′,false ) then begin memo1.lines.add('Windows版本：′＋ ReadString(′Version′)); memo1.lines.add('Windows版本号：′＋ ReadString(′VersionNumber′)); memo1.lines.add(′Windows子版本号：′＋ ReadString(′SubVersionNumber′)); end; CloseKey;//关闭主键 Destroy;//释放内存 end; end; 四、向注册表中写入信息 Write系列方法将信息转化为指定的类型，并写入注册表。 1.Write系列方法。 procedure WriteString(const Name, Value: string); 写入一个字符串值，Name为字符串的名称，Value为字符串值。 procedure WriteInteger(const Name: string; Value: Integer); 写入一个整数值。 procedure WriteBinaryData(const Name: string; var Buffer; BufSize: Integer); 写入二进制值，Name为二进制值的名称，Buffer为包含二进制值的缓冲区，BufSize为缓冲区大小。 其它方法还有：WriteBool、WriteCurrency、WriteDate、WriteDateTime、WriteFloat、WriteTime。 2.写入信息一例。 下面程序使Delphi随Windows启动而自动运行。 var ARegistry : TRegistry; begin ARegistry := TRegistry.Create; //建立一个TRegistry实例 with ARegistry do begin RootKey:=HKEY—LOCAL—MACHINE; if OpenKey(′Software\Microsoft\Windows\CurrentVersion\Run′,True) then WriteString(′delphi′,′C:\Program Files\borland\delphi3\bin\delphi32.exe′); CloseKey; Destroy; end; end; 五、键值维护 除了在注册表中读取、存储外，程序可能还需要增加主键、删除主键、主键改名、数据值改名等。 1.创建新主键：function CreateKey(const Key: string): Boolean。 Key即为主键名，返回值True表示操作成功。 2.删除主键：function DeleteKey(const Key: string): Boolean。 Key即为主键名，返回值True表示操作成功。 3.复制或移动主键：procedure MoveKey(const OldName, NewName: string; Delete: Boolean)。 OldName、NewName分别表示源主键名和目标主键名；Delete表示是否删除源主键，True表示删除，False表示保留。 复制或移动一个主键将复制或移动该子键下的所有数据值和子键内容。 4.判断指定主键是否存在，其下是否有主键，并获取主键名称。 KeyExists用于判断指定主键是否存在： function KeyExists(const Key: string): Boolean;//返回值为True表示主键存在。 HasSubKeys用于判断指定主键下是否有子键：function HasSubKeys: Boolean; 返回值为True表示主键下有子键。 GetKeyNames用于获取子键名称：procedure GetKeyNames(Strings: TStrings); Strings用于返回当前主键下各子键的名称。 5.获取主键下的数据值名称：procedure GetValueNames(Strings: TStrings)。 Strings用于返回当前主键下各数值名称。 如要获取当前系统中的拨号连接名称，可利用获取主键HKEY—USERS \.DEFAULT\RemoteAccess\Addresses下的数值名称的方法来进行。 6.判断数值名称存在、数值名称改名。 ValueExists用于判断数值名称是否存在： function ValueExists(const Name: string): Boolean; 返回值为True表示数值名称存在。 RenameValue用于数值名称改名： procedure RenameValue(const OldName, NewName: string); 以上是注册表常用操作所对应的TRegistry的方法和属性，其它方法和属性请参见Delphi联机帮助文件。 以上程序在PWIN 98＋Delphi 3.0下调试通过。 2003-11-20 11:53:00 发表评语»»» 2003-11-20 11:59:20 注册表中对编程常用的几项（ODBC/BDE/Internet/Windows） 我用的是 WINDOWS 2000， WIN2000 的 REGEDIT 提供了类似 IE 中收藏夹的功能，我的收藏夹中有几个或许对大家编程时会有帮助（这是本人在编程过程中的探索出来的，请高手指教）： 1。关于 ODBC 和 DBE： HKEY_LOCAL_MACHINE\SOFTWARE\ODBC\ODBC.INI\ODBC File DSN 有你的 COMPUTER 上 ODBC 的 FILE DSN 的存放的缺省路径，如果你建立 FILE DSN 的时候选择了自己的路径，那你就得小心了，系统不会为你保存该路径，你的自己记住它，：-（； HKEY_LOCAL_MACHINE\SOFTWARE\ODBC\ODBCINST.INI\ODBC Drivers 列出了你的所有 ODBC DRIVER， 关于 ODBC DRIVER 的名称，有一个比较有趣的地方：不知大家又没有用TSession.GetDriverNames 取过系统 ODBC DRIVER 名，我用的时候 DRIVER 名最长只能取到 31 个字符，剩下的就被截掉了，不知是我编程有问题还是 DELPHI 的 BUG； HKEY_LOCAL_MACHINE\SOFTWARE\ODBC\ODBCINST.INI 列出了你的所有 ODBC DRIVER 的详细配置； HKEY_LOCAL_MACHINE\SOFTWARE\ODBC\ODBC.INI 列出了你的所有 SYSTEM DSN 以及它们的配置情况； HKEY_CURRENT_USER\Software\ODBC\ODBC.INI 列出了你的所有 USER DSN 以及它们的配置情况； 知道了以上的几个主键后，你就可以在程序中实现 %SystemRoot%\system32\odbcad32.exe 的大部分功能了。 HKEY_LOCAL_MACHINE\SOFTWARE\Borland\Database Engine 下面是你的 DBE 的配置，我就不多说了，大家拿它和 BDE 用户界面一比较就明白了。 2。关于 INTERNET 编程： HKEY_CLASSES_ROOT\htmlfile 系统对 HTMLFILE 的处理定义； HKEY_LOCAL_MACHINE\SOFTWARE\Clients INTERNET Option 中 INTERNET PROGRAM 的设定，尤其重要的是其中的 HKEY_LOCAL_MACHINE\SOFTWARE\Clients\Mail。 3。关于 WINDOWS 编程 HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run 每次该用户启动 WINDOWS 必定执行下面的命令（如果有，当然一般都有）， HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Runonce 该用户启动 WINDOWS 必定执行下面的命令（如果有），执行完后由 WINDOWS 把命令删掉，安装软件的时候特别有用， 以上两处是针对特定用户的，在HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion 下还有类似的地方，是针对所有用户的，我就不罗嗦了。 2003-11-20 12:16:38 Delphi 中注册表构件TRegistry 的应用 在Delphi3.0 及以上版本中，提供了一个构件TRegistry。在程序中可以利用它来实现对WIN95/98/NT 注册表的操作，可以很方便地在注册表中增加、修改和删除键值。这样可以在程序中完成一些特殊的功能。 ---- TRegistry 常用的属性和方法有（具体作用和用法请参考Delphi 帮 助）： RootKey、CreateKey、OpenKey、CloseKey、DeleteKey、ReadXXXX、WriteXXXX （XXXX表示数据类型如String、Integer等） 我们用到的属性和方法有： RootKey：注册表的根键名( 如HKEY_LOCAL_MACHINE等) OpenKey( KeyName:string; CanCreate:boolean )： 使当前键为KeyName，CanCreate 表示当指定的键不存在时是否创建，True 表示创建 SetKey( KeyName,KeyValue : string )：使键KeyName的值为KeyValue ---- 应用之一：让自己的程序随WIN95/98/NT 的启动而运行 当然，你可以在＂启动＂程序组中加入程序的快捷方式，但这样做好象不大明智，因为大多数程序在安装时不会这样做，而是在通过在注册表增加键值，让WIN95/98/NT 在启动时运行自己的程序。如果打开注册表，找到HKEY_LOCAL_MACHINE \Software \Microsoft\Windows \CurrentVersion \Run，就会发现这个秘密了，原来许多自动运行的程序都在这里。你也可以在这里增加一个键，让你的程序也随着 WIN95/98/NT 的启动而自己运行，成为WINDOWS 下的TSR 程序。实现方法如下： 首先，在Uses 中加上Registry 单元 然后，写下面代码。 {将程序strExeFileName置为自动启动 } function StartUpMyProgram ( strPrompt,strExeFileName : string ) : boolean; var registerTemp : TRegistry; begin registerTemp := TRegistry.Create; //建立一个Registry实例 with registerTemp do begin RootKey:=HKEY_LOCAL_MACHINE; //设置根键值为HKEY_LOCAL_MACHINE //找到Software\Microsoft\Windows\CurrentVersion\Run if OpenKey('Software\Microsoft\Windows\CurrentVersion\Run',True) then //写入自己程序的快捷方式信息 begin WriteString( strPrompt, strExeFileName ); result := true; end else result := false; //善后处理 CloseKey; Free; end; end; {调用StartUpMyProgram, 使Delphi随WINDOWS启动而自动运行 } procedure TForm1.Button1Click(Sender: TObject); begin memo1.lines.add('开始'); if StartUpMyProgram('delphi','C:\Program Files\borland\delphi3\bin\delphi32.exe') then memo1.lines.add('成功') else memo1.lines.add('失败') end; ---- 应用之二：实现文件关联 当MS WORD 安装在你的系统中时，它会把.DOC 文件与自己关联，当你双击一个DOC 文件，就会启动MS WORD，打开你指定的DOC文件。你也可以把一个文件类型与一个程序关联起来，其秘密还是在注册表中。如果打开注册表，找到HKEY_CLASSES_ROOT，就会发现这里已经有很多文件类型。 你也可以在这里增加一个键，建立自己的文件关联。 建立文件关联，一般应有两个步骤： （１）根据文件类型的扩展名，指定对应的键名（如doc 文件对应的键为doc_auto_file） 该键及其子键的值，将定义该类型的文件的类型说明和操作（如打开、编辑）说明 （２）在指定的键名下，建立子键，指明文件类型说明和操作对应的程序信息 例如，我们可以为.DBF 文件建立文件关联，其文件类型说明为＂xBase 数据表＂，使其打开（Open）文件的操作对应程序C:\ProgramFiles\Borland\DBD\DBD32.EXE。首先，应在注册表的根键HKEY_CLASSES_ROOT 下建立一个键，键名为.DBF，默认值为DBF_Auto_File，表示DBF 类型文件的关联操作信息记录在键HKEY_CLASSES_ROOT\DBF_Auto_File 下；然后，建立键 HKEY_CLASSES_ROOT\DBF_Auto_File，并设其默认值为＂xBase 数据表＂，表示文件类型说明；再建立键HKEY_CLASSES_ROOT\DBF_Auto_File\Shell\open\command，设置其默认值为C:\Program Files\Borland\DBD\DBD32.EXE %1（其中＂%1 ＂为命令行参数），表示打开操作对应的程序信息。 具体实现如下：同样，在Uses 中加上Registry 单元, 然后，写下面代码。 {将文件类型strFileExtension与程序 strExeFileName相关联,strDiscription为文件类型说明 } function AssignToProgram(strFileExtension,strDiscription,strExeFileName : string ) : boolean; var registerTemp : TRegistry; begin registerTemp := TRegistry.Create; //建立一个Registry实例 with registerTemp do begin RootKey:=HKEY_CLASSES_ROOT; //设置根键值为HKEY_CLASSES_ROOT //根据文件类型的扩展名，创建或打开对应的键名.FileExt,如DBF对应'.DBF' if OpenKey( '.' + strFileExtension, true ) then begin result := false; exit; end; //设置键.FileExt默认值为FileExt_Auto_File,如'.DBF'对应'DBF_Auto_File' WriteString('',strFileExtension + '_Auto_File'); CloseKey; //写入自己程序的信息 //根据文件类型的扩展名，创建或打开对应的键名 FileExt_Auto_File //'.DBF'对应'DBF_Auto_File' if OpenKey(strFileExtension + '_Auto_File', true ) then begin result := false; exit; end; //设置默认值文件类型说明,如DBF可对应'xBase数据表' WriteString('',strDiscription); CloseKey; //创建或打开键名FileExt_Auto_File\Shell\open\command,该键为表示操作为'打开' //'.DBF'对应'DBF_Auto_File\shell\open\command' if OpenKey(strFileExtension + '_Auto_File\shell\open\command', true ) then begin result := false; exit; end; //设置该键的默认值为打开操作对应的程序信息 //如DBF可对应'C:\Program Files\Borland\DBD\DBD32.EXE' WriteString('',strExeFileName + ' %1'); CloseKey; Free; end; end; {调用AssignToProgram,使DBF文件与DBD32.EXE关联 } procedure TForm1.Button3Click(Sender: TObject); begin memo1.lines.add('开始'); if AssignToProgram('DBF','xBase数据表','C:\Program Files\borland\dbd\dbd32.exe') then memo1.lines.add('成功') else memo1.lines.add('失败') end; ---- 应用之三：检测Win95/98/NT 系统中是否安装了Borland Database Engine 当你的应用程序是一个基于BDE 的数据库应用程序时，如果运行在一个没有安装BDE 的Win95/98/NT 中，会出现让用户迷惑不解的错误。你可能需要在程序正常运行之前，检查系统中是否安装了BDE。由于 BDE 安装后会在注册表进行注册，你可以通过查询注册表来确定系统中是否安装了BDE，然后决定下一步采取什么行动。BDE 在注册表中的位置为： HKEY_LOCAL_MACHINE\Software\Borland\Database Engine，该键存在说明 BDE 已经安装。 具体的例子如下。 同样，在Uses 中加上Registry 单元 然后，写下面代码。 {检测系统中是否安装了BDE } function IsBDEInstalled : boolean; var registerTemp : TRegistry; begin registerTemp := TRegistry.Create; //建立一个Registry实例 with registerTemp do begin RootKey:=HKEY_LOCAL_MACHINE; //设置根键值为HKEY_LOCAL_MACHINE //查询Software\Borland\Database Engine result := OpenKey('Software\Borland\Database Engine',false); //善后处理 CloseKey; Free; end; end; {调用IsBDEInstalled,检测系统中是否安装了BDE } procedure TForm1.Button4Click(Sender: TObject); begin memo1.lines.add('开始'); if IsBDEInstalled then memo1.lines.add('已安装了BDE') else memo1.lines.add('未安装BDE') end; ---- 应用之四：在桌面建立程序的快捷方式 当你的WIN95/98/NT 桌面上整齐地排列着各种程序的快捷方式时，也许你会体会到快捷方式的方便。你也可将自己设计的程序的快捷方式放在别人的桌面上。 桌面上的一个快捷方式，对应Windows 目录下Destop 子目录中的一个ShellLink 文件(.LNK)，你只要在这个目录下增加一个.LNK 文件就可以了。 我们的任务，主要是利用TRegistry 从注册表中获取Desktop 的实际路径，默认为Windows 目录下的Desktop 子目录，如C:\PWIN98\Desktop。在注册表中Desktop 的实际路径对应的键为HKEY_CURRENT_USER \Software\MicroSoft \Windows \CurrentVersion \Explorer \Shell Folders \Desktop。 同样，在Uses 中加上Registry 单元 然后，写下面代码。 {为程序strExeFileName在桌面建立快捷方式,运行参数为strParameters } function CreateShortcutOnDesktop( strExeFileName, strParameters : string ) : boolean; var registerTemp : TRegistry; strDesktopDirectory : widestring; shelllinkTemp : IShellLink; persistfileTemp : IPersistFile; begin registerTemp := TRegistry.Create; //建立一个Registry实例 with registerTemp do begin RootKey:=HKEY_CURRENT_USER; //设置根键值为HKEY_CURRENT_USER //找到Software\MicroSoft\Windows\CurrentVersion\Explorer\Shell Folders if not OpenKey('Software\MicroSoft\Windows\CurrentVersion\Explorer\Shell Folders',True) then //写入自己程序的信息 begin result := false; exit; end; //读取项目Desktop的值，即Desktop的实际路径 strDesktopDirectory := ReadString('Desktop'); //善后处理 CloseKey; Free; end; //设置快捷方式的参数 shelllinkTemp := IShellLink( CreateComObject(CLSID_ShellLink)); with shelllinkTemp do begin SetPath( PChar( strExeFileName ) ); //设置程序文件全名 SetArguments( PChar( strParameters) ); //设置程序的命令行参数 //设置程序的工作目录 SetWorkingDirectory( Pchar( ExtractFilePath( strExeFileName ) ) ); end; //构造快捷方式的文件名(.LNK) strDesktopDirectory := strDesktopDirectory + '\' + ExtractFileName( strExeFileName ); strDesktopDirectory := copy( strDesktopDirectory, 1, length( strDesktopDirectory ) - length( ExtractFileExt( strExeFileName ) ) ) + '.LNK'; //保存快捷方式的文件 persistfileTemp := shelllinkTemp as IPersistFile; if S_OK = persistfileTemp.Save( PWChar( strDesktopDirectory ) , false ) then result := true //保存成功，返回True else result := false; end; {调用CreateShortcutOnDesktop,为Delphi在桌面上建立快捷方式 } procedure TForm1.Button2Click(Sender: TObject); begin memo1.lines.add('开始'); if CreateShortcutOnDesktop('C:\Program Files\borland\delphi3\bin\delphi32.exe','%1') then memo1.lines.add('成功') else memo1.lines.add('失败') end; 【结语】：上面几个应用只是TRegistry 一些简单的应用，有了这些知识，你就可以根据自己的需要来定制和改善Winodws 系统了。 ---- 以上程序在PWin98+Delphi3.0 下调试和通过。 2003-11-20 12:21:25 备份部分注册表的代码Procedure ExportRegistryBranch (rootsection : Integer; regroot:String; filename:String); implementation Function dblBackSlash(t:string):string; var k:longint; begin result:=t; {Strings are not allowed to have} for k:=length(t) downto 1 do {single backslashes} if result[k]='\' then insert('\',result,k); end; Procedure ExportRegistryBranch (rootsection : Integer; regroot:String; filename:String); var reg:tregistry; f:textfile; p:PCHAR; Procedure ProcessBranch(root:string); {recursive sub-procedure} var values, keys:tstringlist; i,j,k:longint; s,t:string; {longstrings are on the heap, not on the stack!} begin writeln(f); {write blank line} case rootsection of HKEY_CLASSES_ROOT : s := 'HKEY_CLASSES_ROOT'; HKEY_CURRENT_USER : s := 'HKEY_CURRENT_USER'; HKEY_LOCAL_MACHINE : s := 'HKEY_LOCAL_MACHINE'; HKEY_USERS : s := 'HKEY_USERS'; HKEY_PERFORMANCE_DATA: s := 'HKEY_PERFORMANCE_DATA'; HKEY_CURRENT_CONFIG : s := 'HKEY_CURRENT_CONFIG'; HKEY_DYN_DATA : s := 'HKEY_DYN_DATA'; end; Writeln(f,'['+s+'\'+root+']'); {write section name in brackets} reg.OpenKey(root,false); values := tstringlist.create; keys:=tstringlist.create; reg.getvaluenames (values); {get all value names} reg.getkeynames (keys); {get all sub-branches} for i:=0 to values.count-1 do {write all the values first} begin s := values[i]; t := s; {s=value name} if s= ''then s:='@' {empty means "default value", write as @} else s:='"' + s + '"'; {else put in quotes} write(f,dblbackslash(s)+ '=' ); {write the name of the key to the file} Case reg.Getdatatype(t) of {What type of data is it?} rdString, rdExpandString: {String-type} Writeln(f,'"' + dblbackslash(reg.readstring(t) + '"')); rdInteger: {32-bit unsigned long integer} Writeln(f,'dword:' + inttohex(reg.readinteger(t),8)); { write an array of hex bytes if data is "binary." Perform a line feed after approx. 25 numbers so the line length stays within limits } rdBinary : begin write(f,'hex:'); j := reg.getdatasize(t); {determine size} getmem(p,j); {Allocate memory} reg.ReadBinaryData(t,p^,J); {read in the data, treat as pchar} for k:=0 to j-1 do begin Write(f,inttohex(byte(p[k]),2)); {Write byte as hex} if k<>j-1 then {not yet last byte?} begin write(f,','); {then write Comma} if (k>0) and ((k mod 25)=0) then {line too long?} writeln(f,'\'); {then write Backslash + lf} end; {if} end; {for} freemem(p,j); {free the memory} writeln(f); {Linefeed} end; ELSE writeln(f,'""'); {write an empty string if datatype illegal/unknown} end; {case} end; {for} reg.closekey; {value names all done, no longer needed} values.free; {Now al values are written, we process all subkeys} {Perform this process RECURSIVELY...} for i := 0 to keys.count -1 do ProcessBranch(root+'\'+keys[i]); keys.free; {this branch is ready} end; begin if regroot[length(regroot)]='\' then {No trailing backslash} setlength(regroot,length(regroot)-1); Assignfile(f,filename); {create a text file} rewrite(f); IF ioresult<>0 then EXIT; Writeln(f,'REGEDIT4'); {"magic key" for regedit} reg:=tregistry.create; try reg.rootkey:=rootsection; ProcessBranch(regroot); {Call the function that writes the branch and all subbranches} finally reg.free; {ready} close(f); end; end; end. 2003-11-20 12:22:54 读写网络上其他计算机注册表的代码procedure NetReg; var R: TRegistry; S: TStringList; begin R:=TRegistry.Create; S:=TStringList.Create; WriteLn(R.RegistryConnect('\\OtherPC')); WriteLn(R.OpenKeyReadOnly('Software')); R.GetKeyNames(S); WriteLn(S.CommaText); S.Free; R.Free; end; 2003-11-20 12:27:06 关于查看注册表的程序unit regform; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Registry; type TForm1 = class(TForm) ListSub: TListBox; ListValues: TListBox; ComboKey: TComboBox; Label1: TLabel; Label2: TLabel; Label3: TLabel; Label4: TLabel; ComboLast: TComboBox; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure ListSubClick(Sender: TObject); procedure ComboKeyChange(Sender: TObject); procedure ComboLastChange(Sender: TObject); private Reg: TRegistry; public procedure UpdateAll; end; var Form1: TForm1; implementation {$R *.DFM} procedure TForm1.FormCreate(Sender: TObject); begin Reg := TRegistry.Create; Reg.OpenKey ('\', False); UpdateAll; // select the current root（选择当前的根目录） ComboKey.ItemIndex := 1; ComboLast.Items.Add('\'); /////// ComboLast.ItemIndex := 0; end; //更新 procedure TForm1.UpdateAll; begin Caption := Reg.CurrentPath; if Caption = ' then Caption := '[Root]'; if Reg.HasSubKeys then Reg.GetKeyNames(ListSub.Items) else ListSub.Clear; Reg.GetValueNames(ListValues.Items); end; procedure TForm1.FormDestroy(Sender: TObject); begin Reg.CloseKey; Reg.Free; end; procedure TForm1.ListSubClick(Sender: TObject); var NewKey, Path: string; nItem: Integer; begin // get the selection（获取选择项） NewKey := ListSub.Items [ListSub.ItemIndex]; Reg.OpenKey (NewKey, False); // save the current path (eventually adding a \)（在不列出于列表时保存路径） // only if the it is not already listed Path := Reg.CurrentPath; if Path < '\' then Path := '\' + Path; nItem := ComboLast.Items.IndexOf (Path); if nItem < 0 then begin ComboLast.Items.Insert (0, Path); ComboLast.ItemIndex := 0; end else ComboLast.ItemIndex := nItem; UpdateAll; end; procedure TForm1.ComboKeyChange(Sender: TObject); begin case ComboKey.ItemIndex of 0: Reg.RootKey := HKEY_CLASSES_ROOT; 1: Reg.RootKey := HKEY_CURRENT_USER; 2: Reg.RootKey := HKEY_LOCAL_MACHINE; 3: Reg.RootKey := HKEY_USERS; 4: Reg.RootKey := HKEY_CURRENT_CONFIG; 5: Reg.RootKey := HKEY_DYN_DATA; end; Reg.OpenKey ('\', False); UpdateAll; ComboLast.Items.Clear; end; procedure TForm1.ComboLastChange(Sender: TObject); begin Reg.OpenKey (ComboLast.Text, False); UpdateAll; end; end. 2003-11-20 13:30:00 获得注册表项下的所有值Var Reg : TRegistry; list : TStrings; i : Integer; Begin Reg:=TRegistry.Create; Reg.RootKey:='HKEY_LOCAL_MACHINE'; If Reg.OpenKey('\Software\Microsoft\CurrentVersion\Run', false) then Begin List:=TStringList.Create; Reg.GetValueNames(List); For i:=0 to list.Count-1 do If Reg.ValueExists(List[i]) then Begin Case Reg.GetDataType(List[i]) of rdInteger: Reg.ReadInteger(List[i]); rdBinary: Reg.ReadBinaryData(List[i]); else Reg.ReadString(List[i]); End; End; End; 2003-11-20 13:38:19 利用Windows API 函数和注册表获取系统信息 在开发应用程序时，增加一项显示计算机系统信息的功能，例如已安装的软盘、硬盘、光驱、网络驱动器，硬盘的容量和剩余空间，显示器分辨率、键盘类型、鼠标的键数，内存大小、CPU 类型，Windows 的版本号、产品标识、注册用户单位名和用户名、当前操作用户名等( 见运行图示)，当然还有更多的信息，这样会使你的程序更友好。其实，有很多应用程序就是这样做的。 通过调用Windows 的API 函数和访问Windows 注册表，可以获取大量的系统信息。Delphi 为绝大多数Windows API 函数提供了调用接口( 可参见DELPHI3\SOURCE\RTL\WIN\windows.pas 文件)，并提供了一个功能全面的TRegistry 类，使我们可以方便的调用Windows API 函数和访问注册表，例如： 1、function GetDriveType(lpRootPathName: PChar): UINT; 返回指定驱动器的类型。 2、function GetDiskFreeSpace(lpRootPathName: PChar; var lpSectorsPerCluster, lpBytesPerSector, lpNumberOfFreeClusters, lpTotalNumberOfClusters: DWORD): BOOL; 返回指定驱动器的总簇数、剩余簇数及每簇扇区数、每扇区字节数，从而可以计算出总容量和剩 余空间。 3、function GetSystemMetrics(SM_CXSCREEN或 SM_CYSCREEN): Integer; 返回显示器分辨率。 4、function GetSystemMetrics(SM_CMOUSEBUTTONS): Integer; 返回鼠标的按键数目。 5、在windows 注册表的HKEY_LOCAL_MACHINE\software\microsoft\windows\currentversion \RegisteredOwner 主键下存放着Windows 安装时输入的用户名, 可用以下语句读取。 myreg:=Tregistry.Create; //必须在程序单元的uses部分加入Registry myreg.RootKey:=HKEY_LOCAL_MACHINE; if myreg.openkey('software\microsoft\windows\currentversion',false) then memo1.lines.add(' 注册用户名:'+myreg.readstring('RegisteredOwner')); myreg.closekey; 以上仅举几例，获取其他一些信息的方法与此类似，详见源程序。 本程序在Pwin95、Delphi3 下调试通过。 【附】： 源程序清单。 unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,Registry; type TForm1 = class(TForm) Button1: TButton; Memo1: TMemo; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} procedure TForm1.Button1Click(Sender: TObject); var i,x,y:integer; ch:char; //驱动器字符'A'~'Z' buffer:string; cpuinfo:TSYSTEMINFO; //存放系统信息的记录类型,在Windows.pas中查到详细内容。 meminfo:TMemoryStatus; //存放系统内存信息的记录类型。 computername,username:pchar; //计算机名称、用户名 spc,bps,nofc,tnoc:longint; //用于存放磁盘容量的变量 myreg:Tregistry; //用于访问注册表的TRegistry变量 begin memo1.Lines.Clear; for ch:='A' to 'Z' do begin i:=getdrivetype(pchar(ch+':\')); buffer:=' '+ch+': '; case i of DRIVE_UNKNOWN : buffer:=buffer+'未知类型'; DRIVE_REMOVABLE: buffer:=buffer+'软盘'; DRIVE_FIXED : begin buffer:=buffer+'硬盘'; if getdiskfreespace(pchar(ch+':\'),spc,bps,nofc,tnoc) then begin buffer:=buffer+'总容量:'+inttostr((spc*bps*tnoc) div (1024*1024))+'MB'; buffer:=buffer+'剩余:'+inttostr((spc*bps*nofc) div (1024*1024))+'MB'; end; end; DRIVE_REMOTE : buffer:=buffer+'网络驱动器'; DRIVE_CDROM :buffer:=buffer+'CD-ROM驱动器'; DRIVE_RAMDISK:buffer:=buffer+'RAM虚拟驱动器'; end; if (ch >'D') and (i=1) then break; if i< >1 then memo1.Lines.Add(buffer); end; case getkeyboardtype(0) of //获取键盘类型 1: buffer:=' 键盘: IBM PC/XT或兼容类型(83键)'; 2: buffer:=' 键盘: Olivetti "ICO"(102键)'; 3: buffer:=' 键盘: IBM PC/AT(84键)'; 4: buffer:=' 键盘: IBM增强型(101或102键)'; 5: buffer:=' 键盘: Nokia 1050'; 6: buffer:=' 键盘: Nokia 9140'; 7: buffer:=' 键盘: Japanese'; end; memo1.lines.add(buffer); //获取键盘功能键数目 memo1.lines.add(' 功能键数目:'+inttostr(getkeyboardtype(2))); memo1.Lines.add('显示器分辨率:'+inttostr(getsystemmetrics(SM_CXSCREEN)) +'x'+inttostr(getsystemmetrics(SM_CYSCREEN))); //获取鼠标按键数目 memo1.Lines.add(' 鼠标:'+inttostr(getsystemmetrics(SM_CMOUSEBUTTONS))+'键'); globalmemorystatus(meminfo); //获取系统内存数量 memo1.lines.add(' 物理内存:'+inttostr(meminfo.dwTotalPhys div 1024)+' KB'); i:=getsystemmetrics(SM_CLEANBOOT); case i of 0:buffer:='系统启动模式:正常模式'; 1:buffer:='系统启动模式:保护模式'; 2:buffer:='系统启动模式:网络保护模式'; end; memo1.lines.add(buffer); x:=getsystemmetrics(SM_ARRANGE); //获取系统最小化窗口的起始位置和排列方式 y:=x; x:=x and 3; y:=y and 12; case x of ARW_BOTTOMLEFT : buffer:=' 最小化窗口:自左下角'; ARW_BOTTOMRIGHT : buffer:=' 最小化窗口:自右下角'; ARW_TOPLEFT : buffer:=' 最小化窗口:自左上角'; ARW_TOPRIGHT : buffer:=' 最小化窗口:自右上角'; end; case y of ARW_LEFT : buffer:=buffer+'横向排列'; ARW_UP : buffer:=buffer+'纵向排列'; ARW_HIDE : buffer:=buffer+'隐藏'; end; memo1.lines.add(buffer); getmem(computername,255); //获取计算机名称和用户名 getmem(username,255); i:=255; getcomputername(computername,i); memo1.lines.add(' 计算机名称: '+computername); getusername(username,i); memo1.lines.add(' 用户名: '+username); freemem(computername); freemem(username); getsysteminfo(cpuinfo); //获取CPU类型 case cpuinfo.dwProcessorType of 386 : buffer:=' CPU类型: 386'; 486 : buffer:=' CPU类型: 486'; 586 : buffer:=' CPU类型: Pentium'; end; memo1.Lines.add(buffer); //从注册表中获取CPU标识，Windows版本，产品标识，注册单位名称及用户名 myreg:=Tregistry.Create; myreg.RootKey:=HKEY_LOCAL_MACHINE; if myreg.OpenKey('hardware\description\system\centralprocessor\0',false) then memo1.lines.add(' CPU标识:'+myreg.ReadString('VendorIdentifier')); myreg.closekey; if myreg.openkey('software\microsoft\windows\currentversion',false) then begin memo1.lines.add(' windows版本:'+myreg.ReadString('Version')); memo1.lines.add(' 版本号:'+myreg.ReadString('VersionNumber')+''+myreg.ReadString('Subversionnumber')); memo1.lines.add(' 产品标识:'+myreg.Readstring('ProductID')); memo1.lines.add('注册单位名称:'+myreg.readstring('RegisteredOrganization')); memo1.lines.add(' 注册用户名:'+myreg.readstring('RegisteredOwner')); end; myreg.CloseKey; myreg.Free; end; end. 2003-11-20 13:44:20 注册表配置ODBC的详细例子【思路】：先在ODBC中配置然后到注册表中去看有什么增加,然后照样写进去就可以了,但是这样做有一个问题,SQL Server默认是用命名管道,如果要用TCP/IP协议请在注册表中找1433,就能找到它是在那里.照样写进去就OK了。 var reg : TRegistry; begin reg := TRegistry.Create; //建立一个Registry实例 with reg do begin RootKey:=HKEY_LOCAL_MACHINE; //设置根键值为HKEY_LOCAL_MACHINE //找到Software\ODBC\ODBC.INI\ODBC Data Sources if OpenKey('Software\ODBC\ODBC.INI\ODBC Data Sources' True) then begin //注册一个DSN名称 WriteString( 'DSN' 'SQL Server' ); end else begin //创建键值失败 ShowMessage('增加ODBC数据源失败'); exit; end; CloseKey; //找到或创建Software\ODBC\ODBC.INI\masdsn 写入DSN配置信息 if OpenKey('Software\ODBC\ODBC.INI\DSN' True) then begin WriteString( 'Driver' 'C:\Windows\System\sqlsrv32.dll' ); WriteString( 'LastUser' 'Username' ); WriteString( 'Password' 'password' ); WriteString( 'Server' 'ServerName' ); end else //创建键值失败 begin Showmessage('增加ODBC数据源失败'); exit; end; CloseKey; Free; ShowMessage('增加ODBC数据源成功'); end; //以上程序是写到system里的,当然同样可以写到当前用户里！ 2003-11-20 13:50:20 通过注册表读取设置字体unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Registry; type TForm1 = class(TForm) Button1: TButton; Button2: TButton; procedure WriteFontToRegistry(Sender: TObject); procedure FormCreate(Sender: TObject); procedure ReadFontFromRegistry(Sender: TObject); procedure FormDestroy(Sender: TObject); private { Private-Deklarationen } Font : TFont; public { Public-Deklarationen } end; var Form1: TForm1; implementation {$R *.DFM} type TFontRegData = record Name : string[100]; Size : integer; Color : TColor; Style : set of TFontStyle; Charset : byte; Height : integer; Pitch : TFontPitch; PixelsPerInch : integer; end; // Before writing font data to the registry you have to copy all needed data to a record of fixed size procedure PrepareFontDataForRegistry(Font : TFont;var RegData : TFontRegData); begin { Copy font data to record for saving to registry } //复制字体数据到记录并保存到注册表中 with RegData do begin Name:=Font.Name; Size:=Font.Size; Color:=Font.Color; Style:=Font.Style; Charset:=Font.Charset; Height:=Font.Height; Pitch:=Font.Pitch; PixelsperInch:=Font.PixelsPerInch; end; end; procedure PrepareFontfromRegData(Font : TFont;RegData : TFontRegData); begin { Set font data to values read from registry } //设置来自注册表的字体数据的值 with Font do begin Name:=RegData.Name; Size:=RegData.Size; Color:=RegData.Color; Style:=RegData.Style; Charset:=RegData.Charset; Height:=RegData.Height; Pitch:=RegData.Pitch; PixelsperInch:=RegData.PixelsPerInch; end; end; //初始化 procedure TForm1.FormCreate(Sender: TObject); begin Font:=TFont.Create; Font.Name:='Arial'; end; //写入注册表 procedure TForm1.WriteFontToRegistry(Sender: TObject); var rd : TFontRegData; reg : TRegistry; begin PrepareFontDataForRegistry(Font,rd); Reg:=TRegistry.Create; Reg.OpenKey('Software\Test',true); Reg.WriteBinaryData('FontData',rd,Sizeof(rd)); reg.Free; end; //从注册表中读取字体设置值 procedure TForm1.ReadFontFromRegistry(Sender: TObject); var rd : TFontRegData; reg : TRegistry; begin Reg:=TRegistry.Create; Reg.OpenKey('Software\Test',true); if Reg.ValueExists('FontData') then Reg.ReadBinaryData('FontData',rd,Sizeof(rd)); reg.Free; PrepareFontFromRegData(Font,rd); end; procedure TForm1.FormDestroy(Sender: TObject); begin Font.Free; end; end. 2003-11-20 13:56:06 系统注册表读写操作的例子代码 操作注册表需要认识到注册表的六个根键。看看DELPHI的定义: const { Reserved Key Handles. } {$EXTERNALSYM HKEY_CLASSES_ROOT} HKEY_CLASSES_ROOT = DWORD($80000000); {$EXTERNALSYM HKEY_CURRENT_USER} HKEY_CURRENT_USER = DWORD($80000001); {$EXTERNALSYM HKEY_LOCAL_MACHINE} HKEY_LOCAL_MACHINE = DWORD($80000002); {$EXTERNALSYM HKEY_USERS} HKEY_USERS = DWORD($80000003); {$EXTERNALSYM HKEY_PERFORMANCE_DATA} HKEY_PERFORMANCE_DATA = DWORD($80000004); {$EXTERNALSYM HKEY_CURRENT_CONFIG} HKEY_CURRENT_CONFIG = DWORD($80000005); {$EXTERNALSYM HKEY_DYN_DATA} HKEY_DYN_DATA = DWORD($80000006); 它们必须在TRegistry变量的RootKey属性中指定。 要取得某一个路径的某个键值,必须找到某一个主键,例如有如下一个路径存放着WORD97存放的程序路径: \Software\Microsoft\Office\8.0\Word\InstallRoot\Path 其中,PATH是键,在它前面的便是主键(键的路径),而这些键又是放在HKEY_LOCAL_MACHINE这个根键中的。当然,我们想要的是PATH对应的数据,而不是想知道有PATH这个键存在。PATH的类型是一个字符串,所以需要一个字符串变量存放它,例程中使用直接显示的方法表达它。 因此,读出PATH键数据的过程就应该是,确定根键,进入主键(路径),读出键的数据值。为了体现对注册表的写操作,我们还特意创建一个主键\Software\3hsoft和里面一个字符串的键MyData。 下面是一小段关于此过程的程序,虽然内容不多,但基本上已经将读写的操作表现出来了。 unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Registry; // 记得要加入这个红色的。 type TForm1 = class(TForm) Button1: TButton; procedure Button1Click(Sender: TObject); end; var Form1: TForm1; implementation {$R *.DFM} procedure TForm1.Button1Click(Sender: TObject); Const FPath = '\Software\Microsoft\Office\8.0\Word\InstallRoot'; FKey = 'Path'; FMyPath = '\Software\3hSoft'; FMyKey = 'MyData'; Var Reg : TRegistry; begin Reg := TRegistry.Create; try Reg.RootKey := HKEY_LOCAL_MACHINE; If Reg.OpenKey(FPath, False) then ShowMessage(Reg.ReadString(FKey)); // 读出的 WinWord 的路径就显示出来了。 Reg.CreateKey(FMyPath); // 创建我们的主键 Reg.OpenKey(FMyPath, True); // 进入我们自己的主键中 Reg.WriteString(FMyKey, 'This is a registry operation test program.'); // 写进键值。 finally Reg.Free; // 用 Try..Finally 结构确保 REG 变量能够释放。 end; end; end. 2003-11-20 14:02:11 用注册表对Delphi程序进行加密 本加密方法分三部分: 1. 根据对注册表的搜索结果判定设置对话框的内容。 2. 若初次使用,则设新密码;若是已经设置密码,则进行验证。 3. 一个密码变换小程序(比原来的复杂得多)。当然,如果需要修改密码的功能,只要将设置密码部分改动一下即可。 一、程序启动时,通过搜索注册表,判断是否已有密码,来确定窗口的显示内容。不过事先应有以下的声明然后才能使用: 在user中加入TRegistry,在var声明中加入以下几个窗体变量: var TheReg: TRegistry; KeyName,ValueStr,tempStr:String; procedure TfrmPass.FormShow(Sender: TObject); begin TheReg := TRegistry.Create; try TheReg.RootKey := HKEY-LOCAL-MACHINE; KeyName := ′SOFTWARE\Mypassword′; //有该键则打开,没有则创建 if TheReg.OpenKey(KeyName, True) then begin tempStr:=ExtractFileName(Application.ExeName); //读取密码 ValueStr:=TheReg.ReadString(tempStr); //密码不为空则修改窗体为验证密码 if ValueStr<>′′ then begin edit2.Visible:=false; frmPass.Caption:=′验证密码′; edit1.SetFocus; OK.Caption:=′确定′; end //密码为空则修改窗体为设置密码对话框 else begin showmessage(′第一次使用请设置密码!′); edit2.Visible:=true; frmPass.Caption:=′请设置新密码′; edit1.SetFocus; OK.Caption:=′设置′; end; TheReg.CloseKey; end; finally TheReg.Free; end; end; 二、按钮的响应代码:包括新设密码和验证密码。 procedure TfrmPass.OKClick(Sender: TObject); begin //根据Edit2的显示与否判断已有密码,进行验证 if edit2.Visible=false then begin if pass(edit1.text)=ValueStr then begin showmessage(′密码正确!′); end else begin showmessage(′密码不正确!无权操作!′); halt; end; end //无密码,设置新密码 else begin if edit1.text=edit2.text then begin TheReg := TRegistry.Create; TheReg.RootKey := HKEY-LOCAL-MACHINE; KeyName := ′SOFTWARE\Mypassword′; if TheReg.OpenKey(KeyName, True) then TheReg.WriteString(tempStr,pass(edit1.text)); TheReg.CloseKey; end else begin showmessage(′再次键入的密码不一致,请重输!′); edit1.text:=′′; edit2.text:=′′; edit1.SetFocus; end; //进行下一步操作... end; end; 三、密码变换程序:注意要预先定义。 这个变换小程序在笔者看来还不算很复杂,只进行了两次变换,不过,想要破译也是得费点劲。读者还可以采用其他的数学函数进行更为复杂的变换。 function pass(pstr:string):string; var str,str1:string; i,j:integer; begin str:=pstr; for i:=1 to length(str) do begin //进行第一次变换 j:=(i＊i＊i mod (i+20))+(i＊i mod (i+10))+i＊2+1; str1:=str1+chr(ord(str[i])+j); //第二次变换 j:=(i＊i＊i mod (i+10))+(i＊i mod (i+20))+i＊2+1; str1:=str1+chr(ord(str[i])+j); end; pass:=str1; end; 2003-11-20 14:06:55 使Delphi程序记忆参数的设置 【王伟】 我们平时用的很多软件都具有一些记忆功能，如foxmail和TheBat等等。这些软件能在启动时自动的保持上一次关闭软件时的一些状态，如窗口的初始位置，用户在软件中设置的一些特性（如窗口风格，横相排列还是竖相排列等等），如果能让我们的程序也具有这样的一些功能可以使我们程序看起来更专业性一些:) 这里我就来讲一下怎样使应用程序能记住上一次关闭时的窗口位置，并在下一次启动时和上一次的位置一样。 既然要保留信息，就一定要涉及到存贮的问题。数据的存贮有好几种办法，可以写.ini 或.inf文件，还可以用Delphi提供的文件类来自定义一个文件，还可以用数据库接口（如ODBC） 引入一种数据库文件，foxpro 的.dbf和Access的.mdb比较常用，还可以直接往Windows的注册表里写。写.ini和.inf文件没有任何的安全性，且不适合win95，还记得在94,95年时用中文的Windows3.2中大量的用到了.ini文件,但Windows95出现后，微软建议尽可能的把信息写到注册表中。用ODBC的话会给程序带来很多不必要的麻烦，如会使程序更加复杂，需要相应的DBMS的驱动程序的支持，如果没有相应数据源的驱动程序，则该数据源就不能使用，还有安全性问题也不能很好的解决。 在这里推荐使用写注册表的方法。因为这种方法很方便，不需太多额外的开销，程序比较简 单，对一般的用户来说在注册表里找到有用的信息比打开.ini文件要麻烦的多。所以注册表的安全性比.ini文件要略强一些。 使应用程序能记住上一次关闭时的窗口位置，并在这一次启动时和上一次的位置一样。总体 思路是这样的：在关闭程序时要记录下本次程序结束时的信息，写入注册表中，在下次程序启动 时读注册表中相应信息，并赋给程序。 对于我们这个程序来说主要需要记录的信息是窗口关闭时的Top,Left,Height,Width。 注意：要想使Delphi可以操作注册表，必须包括registry单元。 以下是源程序和相关注释： unit Unit1; interface uses Windows, Messages,. . . . . . . ,registry; //包括registry单元 type TForm1 = class(TForm) public ww:TRegistry; //声明一个TRegistry对象，我们就通过ww来实现对注册表的操作 //启动窗口时要做的一些工作 procedure TForm1.FormCreate(Sender: TObject); begin ww:=TRegistry.Create; //创建ww对象 ww.RootKey :=HKEY_CURRENT_USER; //注意：通过修改RootKey可以把信息写到注册表的每一个角落 ww.OpenKey('software',FALSE); //打开键software,可以看到Borland，Netscape，还有Microsoft也在这个software键中 ww.CreateKey( '王伟'); //在software键中创建一个名为“王伟“的键值，使自己的名字和Borland,Netscape, //Microsoft并排在一起，是不是很Cool啊:) ww.OpenKey( '王伟',FALSE); //打开键"王伟" ww.CreateKey('XX单位XX管理系统'); //创建应用程序的名称 ww.OpenKey('XX单位XX管理系统',TRUE); ww.CreateKey('位置'); //创建应用程序中某一个要存贮的项目的名称，便于管理 ww.OpenKey('位置',TRUE); if (ww.ReadString('first')<>'1')then //这是值得注意的一个地方，通过“first“来判断程序是否 begin //是第一次写注册表,如果是第一次写则用程序给的默认值来 ww.WriteString('first','1'); //设置窗口的位置和大小。如果不是第一次启动应用程序则说明 Form1.WindowState:=(wsNormal); //注册表中已经写了位置信息，就读这些信息并赋给Form。 Form1.Top:=10; form1.Left:=10; form1.Height:=100; form1.Width:=100; end else begin if(ww.ReadString('max')='y') then //判断上次关闭程序时，窗口是否是最大化的。如果是的话，则 Form1.WindowState:=(wsMaximized) //继续使窗口拥有这一特征。 else begin Form1.top:=StrToInt(ww.ReadString('top')); //如果不是最大化，则取位置和大小数据赋给From Form1.left:=StrToInt(ww.ReadString('left')); Form1.height:=StrToInt(ww.ReadString('height')); Form1.width:=StrToInt(ww.ReadString('width')); end; end; end; //关闭窗口时要做的一些工作 procedure TForm1.FormDestroy(Sender: TObject); begin ww.OpenKey('位置',FALSE); //打开“位置”键 if Form1.WindowState=(wsMaximized) then //如果当前程序是最大化，则把这一信息写入注册表， ww.WriteString('max','y') //便于下一次时使用。 else begin ww.WriteString('max','n'); //如果不是最大化，则把窗口的位置和大小数据写入注册表中。 ww.WriteString('top',IntToStr(Form1.top)); ww.WriteString('left',IntToStr(Form1.left)); ww.WriteString('height',IntToStr(Form1.Height)); ww.writeString('width',IntToStr(Form1.Width)); end; end; 【需要注意的几点】： 1：因为程序不可能在第一次使用时，就从注册表里读数据，所以第一次必须由程序赋一个 初值。然后做上标记，表示已经有过第一次了，以后只要判断出不是第一次了，就可以读数据 了。（这点最重要,由这一点还可以引出一个话题，那就是可以做一个Demo版的软件，每次启动时往注册表里加个1,当>10时，就不许用该软件了，cool吧） 2：往注册表里可以写string型数据，也可以写Integer型数据，但在注册表中的Integer型数据是以16进制形式存在的，而我们在程序中用的都是10进制数，所以干脆写string型，然后用StrToInt或IntToStr转换。 3：写注册表并不是很安全的，它的内容可以用RegEdit一览无佘的看到，所以千万不能将一些重要的信息(如密码)不经加密而直接写入注册表，这样做是非常危险的！！ 2003-11-20 14:22:10 在DELPHI程序中动态设置ODBC数据源（使用注册表） 【编辑者说】： 这个咚咚写得不错，比上面的那个更加详细，如果上面的那个看不明白就看这个吧，应该能看懂的吧，要不然.... 在DELPHI数据库应用程序中，我们访问数据库通常有两种方法．一种是通过BDE数据库搜索引擎，即利用DELPHI自带的数据库驱动程序，这种方法的优点是速度快，但应用范围有限，当数据库版本更新时，有可能不能用于操作新的数据库；另一种方法是通过ODBC，这种方法的优点是可以随操作系统(如WINDOWS)提供，作为标准接口能适应多种数据库，缺点是速度慢．在编程时，我们可以根据需要选择其中的一种方法． 在利用ODBC访问数据库时，通常的方法时是在ODBC管理面板中设置一个ODBC系统数据源 (系统DSN)，然后在DBD中或在程序中设置一个数据库别名(Alias)对应该DSN，这样就可以如愿以偿地操作数据库了．相信用DELPHI做过数据库应用的程序员对这方面已经很熟悉了，笔者就不多说了．在实际应用中，笔者曾遇到过这样的情况，我们的数据库应用程序是依靠ODBC系统数据源访问和操作数据库的，应用程序运行一直良好，直到某一天，一个对WINDOWS系统较为熟悉但又不太精通的用户不慎修改或删除了我们预先设置的系统DSN...... 于是，笔者就开始研究怎么在程序中动态地设置ODBC系统DSN的内容，这样就可以增加自己程序的坚固性了．经过整整一天对WINDOWS注册表的研究，终于找到了ODBC管理程序设置DSN的秘密（＂天地自有公道，付出总会回报！＂，不是做广告！），现写出来与大家共享，也请高手指教． ODBC管理程序设置DSN的秘密在注册表中，不信可以到HKEY_LOCAL_MACHINE\Software\ODBC 去看看，肯定让你感觉已经成功了一半． 首先来看看系统中已安装的ODBC数据库驱动程序．在HKEY_LOCAL_MACHINE\Software\ODBC\ ODBCInst.INI中，存放着已经安装了的ODBC数据库驱动程序的信息，从这里可以查到已安装的 ODBC数据库驱动程序对应的DLL文件等信息．在ODBCInst.INI\ODBC Drivers的各个键值中，键名是驱动程序名称(如Microsoft Access Driver(*.mdb))，键值为“Installed”，表示驱动程序已安装．在 ODBCInst.INI\DriverName(DriverName为一个驱动程序名称，如Microsoft Access Driver(*.mdb)) 中，有驱动程序的详细信息，我们主要从这里获得ODBC驱动程序对应的DLL文件的路径和文件名，即键名Driver的键值，一般为"C:\WINDOWS\SYSTEM\FileName.DLL"． 然后来看系统DSN的注册信息，在HKEY_LOCAL_MACHINE\Software\ODBC\ODBC.INI中，存放着系统 DSN的注册信息，我们在ODBC管理面板设置的DSN参数就在这里． 下面来看看创建一个ODBC系统DSN的步骤，即我们在ODBC管理面板中完成参数设置后，ODBC 管理程序是怎么在注册表中注册DSN信息的．以创建一个名称为MyAccess的Ms Access97类型的系统DSN为例，我们指定的参数主要有数据库类型(Microsoft Access Driver(*.mdb))、数据源名称(MyAccess)、数据源描述(我的ACCESS)、数据库路径(C:\Inetpub\wwwroot\Test.mdb)，其它参数如用户名称、用户密码、独占、只读、系统数据库、默认目录、缓冲区大小、扫描行数、页超时等采用系统缺省参数．这时，注册系统DSN一般应有以下几个步骤： 1.在HKEY_LOCAL_MACHINE\Software\ODBC\ODBC.INI\ODBC Data Sources中增加一个字符串 键值，为MyAccess = Microsoft Access Driver(*.mdb)，其中分别为数据源名称和数据库类型． 这是在注册表中注册一个系统DSN名称． 2.在HKEY_LOCAL_MACHINE\Software\ODBC\ODBC.INI中创建一个子键(SubKey)MyAccess，即 创建一个键为HKEY_LOCAL_MACHINE\Software\ODBC\ODBC.INI\MyAccess，然后在其下创建一些键值，详细描述一个系统DSN的配置信息，主要信息有([]中的内容为笔者注释)： DBQ=C:\Inetpub\wwwroot\Test.mdb [字符串，表示数据库路径] Description=我的ACCESS [字符串，表示数据库描述] Driver=C:\PWIN98\System\odbcjt32.dll [字符串，表示驱动程序，可见ODBCINST.INI] DriverId=0x00000019(25) [数字，表示驱动程序标识，不能改变] FIL=Ms Access; [字符串，可能与过滤Filter有关] SafeTransaction=0x00000000 [数字，可能表示支持事务性操作的个数] UID="" [字符串，表示用户名称，此处为空字符串] 3.在HKEY_LOCAL_MACHINE\Software\ODBC\ODBC.INI\MyAccess中创建一个子键(SubKey) Engines， 再在其下创建子键(SubKey)Jet，即创建一个键为 HKEY_LOCAL_MACHINE\Software \ODBC\ODBC.INI\MyAccess\Engines\Jet，然后在其下创建一些 键值，详细描述一个系统DSN的数据库引擎配置信息，主要信息有([]中的内容为笔者注释)： ImplicitCommitSync=Yes [字符串，可能表示是否立即反映数据修改] MaxBufferSize=0x00000200(512) [数字，表示缓冲区大小] PageTimeout=0x00000005(5) [数字，表示页超时] Threads=0x00000003(3) [数字，可能表示支持的最大线程数目] UserCommitSync=Yes [字符串，可能表示是否立即将数据修改反映到用户] 以上是建立一个系统DSN的基本信息(其它信息如选项或高级选项等信息也在这里设置， 只不过因采用默认信息，注册表里没有列出)，我们在程序中按上述步骤操作注册表，同样也能增加一个系统DSN或修改其配置．在下面的例子程序中，将按以上步骤建立一个系统DSN，请注意程序中的注释． {******************************************************* 在本程序中，将创建一个ODBC系统数据源(DSN)， 数据源名称：MyAccess 数据源描述：我的新数据源 数据库类型:ACCESS97 对应数据库：C:\Inetpub\wwwroot\test.mdb *******************************************************} { 注意应在USES语句中包含Registry } procedure TForm1.Button1Click(Sender: TObject); var registerTemp : TRegistry; bData : array[ 0..0 ] of byte; begin registerTemp := TRegistry.Create; //建立一个Registry实例 with registerTemp do begin RootKey:=HKEY_LOCAL_MACHINE; //设置根键值为HKEY_LOCAL_MACHINE //找到Software\ODBC\ODBC.INI\ODBC Data Sources if OpenKey('Software\ODBC\ODBC.INI\ODBC Data Sources',True) then begin //注册一个DSN名称 WriteString( 'MyAccess', 'Microsoft Access Driver (*.mdb)' ); end else begin//创建键值失败 memo1.lines.add('增加ODBC数据源失败'); exit; end; CloseKey; //找到或创建Software\ODBC\ODBC.INI\MyAccess,写入DSN配置信息 if OpenKey('Software\ODBC\ODBC.INI\MyAccess',True) then begin WriteString( 'DBQ', 'C:\inetpub\wwwroot\test.mdb' );//数据库目录 WriteString( 'Description','我的新数据源' );//数据源描述 WriteString( 'Driver', 'C:\PWIN98\SYSTEM\odbcjt32.dll' );//驱动程序DLL文件 WriteInteger( 'DriverId', 25 ); //驱动程序标识 WriteString( 'FIL', 'Ms Access;' ); //Filter依据 WriteInteger( 'SafeTransaction', 0 ); //支持的事务操作数目 WriteString( 'UID', '' );//用户名称 bData[0] := 0; WriteBinaryData( 'Exclusive', bData, 1 ); //非独占方式 WriteBinaryData( 'ReadOnly', bData, 1 ); //非只读方式 end else//创建键值失败 begin memo1.lines.add('增加ODBC数据源失败'); exit; end; CloseKey; //找到或创建Software\ODBC\ODBC.INI\MyAccess\Engines\Jet //写入DSN数据库引擎配置信息 if OpenKey('Software\ODBC\ODBC.INI\MyAccess\Engines\Jet',True) then begin WriteString( 'ImplicitCommitSync', 'Yes' ); WriteInteger( 'MaxBufferSize', 512 );//缓冲区大小 WriteInteger( 'PageTimeout', 10 );//页超时 WriteInteger( 'Threads', 3 );//支持的线程数目 WriteString( 'UserCommitSync', 'Yes' ); end else//创建键值失败 begin memo1.lines.add('增加ODBC数据源失败'); exit; end; CloseKey; memo1.lines.add('增加新ODBC数据源成功'); Free; end; end; 以上程序在PWIN98+DELPHI3.0下调试通过． 下面是创建常见数据库类型的DSN需要设置的信息([]为注释内容，除特殊注释外，各参数可见前面说明)： １．Access(Microsoft Access Driver(*.mdb)) DBQ、Description、Driver[odbcjt32.dll]、DriverID[25]、FIL[Ms Access;]、SafeTransaction[默认为0]、UID[默认为空]、Engines\Jet\ImplicitCommitSync[默认为Yes]、Engines\Jet\MaxBufferSize[默认512]、Engines\Jet\PageTimeout[默认为512]、Engines\Jet\Threads[默认为3]、Engines\Jet\UserCommitSync[默认为Yes] 可选设置：SystemDb[字符串，系统数据库的路径]、ReadOnly[二进制，是否以只读方式打开，1为是，默认为0]、Exclusive[二进制，是否以独占方式打开，1为是，默认为0]、PWD[字符串，用户密码] ２．EXCEL(Microsoft Excel Driver(*.xls)) DBQ[Excel97(=path\xxx.xls)、5.0/7.0(=path\xxx.xls)、4.0(=path)、3.0(=path)]、Description、Driver[odbcjt32.dll]、DefaultDir[Excel97(< >DBQ)、5.0/7.0(< >DBQ)、4.0(=DBQ)、3.0(=DBQ)]、DriverID[790(Excel97)、22(5.0/7.0)、278(4.0)、534(3.0)]、FIL[Excel5.0;]、ReadOnly、SafeTransaction、UID、Engines\Excel\ImplicitCommitSync、 Engines\Excel\MaxScanRows[数字，扫描行数，默认为8]、Engines\Excel\Threads、Engines\Excel\UserCommitSync、Engines\Excel\FirstRowHasName[二进制，第一行是否是域名，1表示是，默认为1] 【注】： Excel97和Excel7.0/5.0的DBQ对应一个XLS文件，而Excel4.0和Excel3.0则对应一个目录；DefaultDir对应一个目录，在Excel97和Excel7.0/5.0中是DBQ所对应的路径，而在Excel4.0和Excel3.0下则与DBQ相同；各个版本的DriverID不同． ３．dBase(Microsoft dBase Driver(*.dbf)) DefaultDir[字符串，数据库文件所在目录]、Description、Driver[odbcjt32.dll]、 DriverID[277(IV)、533(5.0)]、FIL[dbase III;]、SafeTransaction、UID、Engines\Xbase\ImplicitCommitSync、Engines\Xbase\Collating[字符串，排序依据，可为ASCII、International、Norwegian-Danish、Swedish-Finnish]、Engines\Xbase\Deleted[二进制，是否不显示被软删除的记录，0表示显示，默认为1]、Engines\Xbase\PageTimeout[默认为600]、Engines\Xbase\UserCommitSync、Engines\Xbase\Threads、Engines\Xbase \Statistics[二进制，是否用大约的行数，1为是，默认0] 【注】：(dBaseIV和dBase5.0两个版本的DriverId有不同) ４．Foxpro(Microsoft Foxpro Driver(*.dbf)) DefaultDir[数据库文件所在目录]、Description、Driver[odbcjt32.dll]、DriverID[536(2.6)、280(2.5)]、FIL[Foxpro 2.0;]、SafeTransaction、UID、Engines\Xbase\Collating[字符串，排序依据，可为ASCII、International]、Engines\Xbase\Deleted[二进制，是否不显示 被软删除的记录，0表示显示，默认为1]、Engines\Xbase\PageTimeout[默认为600]、Engines\Xbase\UserCommitSync、Engines\Xbase\Threads、Engines\Xbase\Statistics[二进制，是否用大约的行数，1为是，默认0] 【注】：(Foxpro2.5和Foxpro2.6两个版本的DriverId有不同) 把上面程序做成一个COM或ActiveX控件吧，在很多高级程序设计语言如DELPHI、 C++Buider、VB、VC、PB中都能用到的 2003-11-20 14:30:46 如何在注册表中注册BDE【编者语】： 上面讲了几个注册ODBC的例子，这回我们来说说怎样注册BDE 只拷贝BDE文件是不行的，还要写注册表： 必需的注册表项目包括： 1. BDE动态连接库文件位置设置 Key : "HKEY_LOCAL_MACHINE\Software\Borland\Database Engine" Item : "DLLPATH" Value : BDE动态连接库文件所在位置，如"C:\Program Files\Borland\Common Files\BDE" (打开"C:\Program Files\Borland\Common Files\BDE\BDE32.hlp"，查找"Core Files"即可了解BDE各动态连接库文件的作用) 2. BDE语言驱动文件路径设置 Key : "HKEY_LOCAL_MACHINE\Software\Borland\BLW32" Item : "BLAPIPATH" Value : BDE语言驱动文件所在路径，如"C:\Program Files\Borland\Common Files\BDE" (BDE语言驱动就是那些*.BLL文件) 3. 指定可用的BDE语言驱动文件 Key : "HKEY_LOCAL_MACHINE\Software\Borland\BLW32" Item : "LOCALE_LIB#" (#表示数字, 如"LOCALE_LIB1"、"LOCALE_LIB3"等) Value : 指定各BDE语言驱动文件，如"C:\Program Files\Borland\Common Files\BDE\USA.BLL" (一般必需的语言驱动文件有"USA.BLL","EUROPE.BLL"和"FAREAST.BLL"，为保险起见，建议将所有语言驱动都设置上。在安装了Delphi3的机器上，用Regedit打开注册表，一看你就明白了怎么设了) 2003-11-20 14:37:11 用DEPHI为应用软件建立注册机制【编者语】： 上面给了一个“使用DELPHI给程序加密的方法”，想对这个方法做一些补充说明，因为资料较老，请酌情参考。 如何保护自己的软件不被非授权盗用的问题，始终困扰着每一个程序员。当前世界上保护 软件的方法有很多，主要是采用加密（如加软件狗）方式或软件注册方式。使用软件狗等加密方 法，虽然其保护最有效，但对授权用户的正常使用有一定的影响，而且软件发放比较复杂，在实 际运用中比较少被采用。而注册登记方式则是当前最流行、运用最广泛的方法，虽然有许多通用 软件其注册码可以很容易地被发烧友们所解，但对于独立程序员为某特定应用设计的应用软件而 言，采用注册机制显得最经济、最方便，而且在一定的范围内非常有效。笔者在实际工作中，广 泛使用了软件注册方法，有效地维护了软件的权益。 DEPHI软件的功能极为强大，深受程序员喜欢。用DEPHI开发的软件，可以很方便地加入注册机制。下面笔者就如何在DEPHI开发的软件中加入注册机制与朋友们交流心得。 要实现软件注册机制，需解决以下几个问题： 1、如何加入注册检测，判断软件是否注册； 2、如何隐藏注册码，及是否注册的标志； 3、在软件不注册情况下，如何限制软件的使用时间或次数； 4、对正常用户而言，不应造成使用不便。 对于以上四个问题，如何隐藏注册码及是否注册的标志是关键。在WINDOWS95中，WIN95本身及大多数的应用软件都将其各种参数放入注册表中，因而注册表内的数据显得极为庞大和复杂。如果将注册标志隐藏在注册表的某一角落中，想要找到它并理解它是极其困难的事。因此我们可以利用这一点，在注册表的某个分支上设置一个从名称上看毫无特殊意义的关键字，将自己软件的注册标志数据存放在这里。 整个注册机制主要由两个部分组成：检查和注册。通过检查标志值，得出软件是否已注册；若没有注册，则要看它允许使用的次数是否已达到；若可使用的次数已用完，则应提示用户输入注册码，进行注册；只有用户输入的注册码正确时，才让用户继续使用软件，同时将标志置为已注册，让用户永久性使用；否则允许使用的次数未达到，应将次数加一； 若用户注册输入的注册码错误或拒绝注册，则直接关闭软件，拒绝其继续使用。当然，在软件允 许使用次数未达到时，也应通过菜单项为用户提供机会进行注册登记。以下是笔者在实际开发 中，建立注册机制的程序代码及注释。 假设软件的主程序窗口为FORM1，则将该段代码置放在FORM1.CREATE事件中。代码如下： procedure TForm1.form1create(Sender: TObject); var re_id:integer; registerTemp : TRegistry; inputstr,get_id:string; dy,clickedok:boolean; begin dy:=false; //软件是否已到注册期、及是否允许继续使用的标志，当值为FALSE是为允许使 用。 registerTemp := TRegistry.Create; //准备使用注册表 with registerTemp do begin RootKey:=HKEY_LOCAL_MACHINE; //存放在此根下 if OpenKey('Software\Microsoft\Windows\CurrentVersion\Mark',True) then // 建一目录，存放标志值。当然也可以存放在已存在的目录下。怎么样，很难发现吧？ begin if valueexists('gc_id') then begin //用gc_id的值作为标志，首先判断其存在否？ re_id:=readinteger('gc_id');//读出标志值 if (re_id<>0) and (re_id<>100) then begin //若标志值为0，则说明已注册。 //若不为0且值不到100,说明虽未注册，但允许使用的次数尚未达到。 re_id:=re_id+5; //允许标志的最大值为100，每次加5，则最多只可用20次。 Writeinteger('gc_id',re_id);//将更新后的标志值写入注册表中。 end; if re_id=100 then dy:=true; //假如值已到100，则应注册。 end else Writeinteger('gc_id',5);//建立标志，并置初始标志值。 end; if dy then begin //若dy值为TRUE，则应提示用户输入注册码，进行注册。 clickedok:=InputQuery('您使用的是非注册软件,请输入注册码：',' ',inputstr); if clickedok then begin get_id:=inttostr(27593758*2);//注册码为55187516，当然可加入更杂的算法。 if get_id=inputstr then begin Writeinteger('gc_id',0); //若输入的注册码正确，则将标志值置为0,即已注册。 CloseKey; Free; end else begin //若输入的注册码错误，应作出提示并拒绝让其继续使用 application.messagebox('注册码错误!请与作者联系!','警告框',mb_ok); CloseKey; Free; application.terminate; //中止程序运行，拒绝让其继续使用 end; end else begin //若用户不输入注册码，也应作出提示并拒绝让其继续使用 application.messagebox('请与作者联系，使用注册软件!','警告框',mb_ok); CloseKey; Free; application.terminate; end; end; end; end; （注：通过菜单进行注册的方法同本段提示用户进行注册的内容雷同，这里不提供代码。） 以上程序代码已在DEPHI3.0/WIN95环境中运行通过，并在实际运用中得到验证。对合法用户而言，这样的机制，只要其录入注册码一次就可以，不增加其日常使用的负担；而对非法用户而言，除非他得到注册码或重装WINDOWS95，否则超过使用次数后，将无法继续使用。当然在实际应用中还有许多地方可以进一步加强反破解能力，欢迎朋友们提出批评和指导。 2003-11-20 14:39:14 通过对注册表进行修改，可以删除资源管理器上下文件菜单中对某类文件的处理命令【问题】： 通过对注册表进行修改，可以删除资源管理器上下文件菜单中对某类文件的处理命令程序例如下： procedure FileTDelAction(key, name: String); //key:关联键值为后缀的描述键值，如.tst对应testfile,则key:=testfile //name:命令名称 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[1] = '.' then begin if myReg.KeyExists(key) then //首先看注册表中是否有此键,有则取出 begin myReg.OpenKey(key, false); key:=myReg.ReadString (''); end else key:= copy(key,2,maxint)+'_auto_file'; end; if key[Length(key)-1] <> '\' then key:=key+'\'; myReg.OpenKey('\'+key+'shell\', true); if myReg.KeyExists(name) then myReg.DeleteKey(name); myReg.CloseKey; myReg.Free; end; 调用例子： Example: FileTDelAction('test','edit'); 原理说明： 将注册表中对应的键值删除就可以了。 2003-11-20 14:47:34 用Delphi实现壁纸更换（适用于Windows95/98） 在Windows95/98中，都是使用注册表对系统数据进行管理,有关壁纸的设置数据保存在 Hkey_Current_User\Control Panel\Desktop的Wallpaper和TileWallpaper 等键值中,只要成功修改了这两个键值,然后发消息给Windows即可更换壁纸。在本例的程序中,使用了一个Tform;两个Tspeedbutton(Speedbutton1用于接受用户的浏览命令,Speedbutton2用于接受用户的更换壁纸命令);一个Timage(用于显示图片)。另外，还用到一组文件控件： Tfilelistbox,Tdrivecombobox,Tdirectorylistbox,用于选择图片文件，可以设置FileListBox的mask属性，筛选显示在FileListBox 中的文件类型(如只显示.bmp文件)。下面的两个程序段是实现浏览图片和更换壁纸的关键代码。 Procedure Tform1.SpeedButton1Click(Sender:Tobject); Begin If (filelistbox1.FileName=′′) Then {判断Filelistbox1中文件有没有被选中} Messagedlg(′请先选择一幅位图′,mtInformation,[mbOK],0) Else Image1.Picture.LoadFormFile(Filelistbox1.FileName);{加载图片文件并显示} End; ProcedureTform1.SpeedButton2Click(Sender:TObject); Var Reg:Tregistry; {Tregistry 对象在Registry 单元中声明，需用Uses令引用Registry单元} } Begin If (Filelistbox1.FileName=′′) Then Messagedlg(′请先选择一幅位图′,mtinformation,[mbOK],0) Else Begin Reg:=Tregistry.Create;{创建Tregistry对象的实例} Reg.Rootkey:= Hkey_Current_User;{设置根键名称} Reg.OpenKey′Control Panel\Desktop′,False); {打开Control Panel\Desktop路径对应的主键} Reg.WriteString (′TileWallPaper′, ′0′); Reg.WriteString ′Wallpaper′，filelistbox1.FileName); {向TileWallpaper 和Wallpaper串覆盖写入新值} Systemparametersinfo(SPI_SETDESKWallpaper,0,Nil,SPIF_SendChange); {向Windows发送消息，通知Windows更换壁纸} Reg.CloseKey;{将更改内容写入注册表并关闭} Reg.Free;{释放对象} End; End; 代码中用到的一些函数可以察看Delphi的联机帮助。需要注意的是:调用打开子键的函数OpenKey时，第二个参数一定要设为False。 通过对注册表进行修改，可以在资源管理器上下文菜单中增加对某类文件的处理命令程序例如下： procedure FileTAddAction(key, name, display, action: String); //key:关联键值为后缀的描述键值，如.tst对应testfile,则key:=testfile //name:命令名称 //display:在上下文件菜单上显示的提示信息 //action:对应的命令 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[1] = '.' then begin if myReg.KeyExists(key) then //首先看注册表中是否有此键,有则取出 begin myReg.OpenKey(key, false); key:=myReg.ReadString (''); end else key:= copy(key,2,maxint)+'_auto_file'; end; if key[Length(key)-1] <> '\' then key:=key+'\'; if name[Length(name)-1] <> '\' then 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; 调用例子： Example: FileTAddAction('testfile','edit','Edit',Application.ExeName+'-e "%1"'); 原理说明： 如.txt对应的描述键值为testfile 则在testfile的键值下面，增加动作子键 如： testfile\shell\ '', Edit testfile\shell\Command\ '', 'c:\testfile -e "%1"' 2003-11-20 15:07:49 如何创建程序快捷方式实现原理： 通过OLE Interface 来实现，通时要处理注册表。 对于快捷方式的存储位置可以指定为桌面，开始菜单，发送到等，这样首先通过对系统注册 表的读取，获取相应的真正地址，将用于保存快捷方式文件。 使用三个接口：IUnknown, IShellLink, IPersistFile IUnknown取得一般性的com 对象 IShellLink取得对快捷方式的处理，可以设置执行文件名，快捷键，描述，参数等 IPersistFile对生成的快捷方式进行保存 程序如下： //加入如下单元 uses Registry, ShlObj, ActiveX, ComObj; //定义快捷方式存放位置桌面，发送，开始菜单 type ShortcutType = (_DESKTOP, _QUICKLAUNCH, _SENDTO, _STARTMENU); procedure CreateShortcut( FileName: string; //执行文件名，全路径 description: string; //快捷方式描述 arguments: string; //参数 Location: ShortcutType //存放位置 ); var MyObject : IUnknown; MySLink : IShellLink; MyPFile : IPersistFile; Directory, LinkName : string; WFileName : WideString; MyReg, QuickLaunchReg : TRegIniFile; begin MyObject := CreateComObject(CLSID_ShellLink); //创建com对象 MySLink := MyObject as IShellLink; //转化为IShellLink接口 MyPFile := MyObject as IPersistFile; //转化为IPersistFile接口 MySLink.SetPath(PChar(FileName)); //设置执行文件名 MySLink.SetArguments(PChar(arguments)); //设置执行参数 MySLink.SetDescription(PChar(Description)); //设置描述 MySLink.SetWorkingDirectory(PChar(ExtractFilePath(application.exename))); //设置工作路径为执行程序所在目录 //下面开始取存放位置的实际目录 MyReg :=TRegIniFile.Create('Software\MicroSoft\Windows\CurrentVersion\Explorer'); try LinkName := ChangeFileExt(FileName, '.lnk'); //生成快捷方式文件名 LinkName := ExtractFileName(LinkName); //取文件主名 case Location of _DESKTOP : Directory := MyReg.ReadString('Shell Folders','Desktop', ''); _STARTMENU : Directory := MyReg.ReadString('Shell Folders','Start Menu', ''); _SENDTO : Directory := MyReg.ReadString('Shell Folders','SendTo', ''); _QUICKLAUNCH: begin QuickLaunchReg := TRegIniFile.Create('Software\MicroSoft\Windows\CurrentVersion\GrpConv'); try Directory := QuickLaunchReg.ReadString('MapGroups', 'Quick Launch', ''); finally QuickLaunchReg.Free; end; end; end; if Directory <> '' then begin WFileName := Directory + '\' + LinkName; //合成存放快捷方式文件全路径名 MyPFile.Save(PWChar(WFileName), False); //保存快捷文件 end; finally MyReg.Free; end; end; 【注】：关于更详细的IShellLink的说明可以查看相关的帮助文档。如果要删除快捷方式，则将.LNK文件删除即可。 Delphi 4.0 [Help]->[MS SDK Help Files]->《Win32 Developer's References》 2003-11-20 15:13:50 问：如何让我的程序像“Explorer”一样，系统重启后能恢复到系统关闭时的状态？【答】： 其实是注册表在作怪，你可能已经注意到，让自己的程序随着Windows的启动而启动是在“HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run”下注册，而要达到你的目的就是在“..\RunOnce”下注册即可。当然，余下的问题就是在什么时候写入这个信息？如果你小心的话，就会发现Delphi本身附带了一个例子（Tregistry下）。说到这里，我们又要提到Windows的消息了，只是限于篇幅，就这个问题这里就不再赘述了，我个人建议大家注意一下Delphi的Messages.pas单元中关于WM_XXX的定义及Windows API的帮助。 uses Windows, Messages,..., Registry; private procedure WMEndSession(var Msg:TWMEndSession); message WM_ENDSESSION; procedure TForm1.WMEndSession(var Message: TWMEndSession); var Reg: TRegistry; begin Reg := TRegistry.Create; try Reg.RootKey := HKEY_CURRENT_USER; if Reg.OpenKey('\Software\Microsoft\Windows\CurrentVersion\RunOnce', True) then Reg.WriteString('MyApp','"' + ParamStr(0) + '"'); finally Reg.CloseKey; Reg.Free; inherited; end; end; 2003-11-20 15:17:41 通过对注册表进行修改，可以在资源管理器上下文件菜单中的新建子菜单中增加新的命令 同时请参考“通过对注册表进行修改，可以删除资源管理器上下文件菜单中对某类文件的处理命令”的文章。 程序例如下： type TFileNewType = (ftNullFile, ftFileName, ftCommand); procedure FileTAddNew(ft, param: String; newType: TFileNewType); //fp:文件后缀键值，如.tst //param:传递参数 //newType:新建的类型，有空文件， 文件名， 命令 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; 调用例子： Example: FileTAddNew('.tst','', ftNullFile); 原理说明： 在后缀键的下面增加子键ShellNew。如在上下文菜单中增加新建.tst文件的命令 在.tst键值下面增加子键 .tst\ShellNew 'NullFile', '' 2003-12-15 15:22:56 如何用DELPHI搜索注册表的全部项、鍵unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Grids, Registry, StdCtrls, ExtCtrls, ComCtrls; type TForm1 = class(TForm) StatusBar1: TStatusBar; Panel1: TPanel; StringGrid1: TStringGrid; btnStart: TButton; btnRemove: TButton; edKey: TEdit; edTime: TEdit; edValueName: TEdit; edValue: TEdit; btnStop: TButton; procedure btnStartClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure FormShow(Sender: TObject); procedure btnRemoveClick(Sender: TObject); procedure StringGrid1SelectCell(Sender: TObject; Col, Row: Integer; var CanSelect: Boolean); procedure btnStopClick(Sender: TObject); private { Private declarations } fRegistry: TRegistry; fRowCount: Integer; fCurrentKeyValue: String; fStopFlag: Boolean; fNoSelection: Boolean; procedure DoAnalyzeRegistry; procedure DoAnalyzeBranch; procedure DoAnalyzeKey(const Key: String); function DoAnalyzeValue(const Key, Value: String): Boolean; public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} const Root : Array[0..3] of Char = ('A', ':', '\', #0); const nKeyName = 0; nFileTime = 1; nValueName = 2; nValueString = 3; procedure NormalizeRegistryPath(var Path: String); begin if (Path = '') or (Path[1] <> '\') then Path := '\' + Path; end; procedure TForm1.btnStartClick(Sender: TObject); begin btnStop.Enabled := TRUE; fRowCount := 1; StringGrid1.RowCount := 2; StringGrid1.Cells[nKeyName, 1] := ''; StringGrid1.Cells[nFileTime, 1] := ''; StringGrid1.Cells[nValueName, 1] := ''; StringGrid1.Cells[nValueString, 1] := ''; DoAnalyzeRegistry; end; procedure TForm1.FormCreate(Sender: TObject); begin fRegistry := TRegistry.Create; end; procedure TForm1.FormDestroy(Sender: TObject); begin fRegistry.Free; end; procedure TForm1.DoAnalyzeRegistry; begin fStopFlag := FALSE; fNoSelection := TRUE; if not fStopFlag then begin fCurrentKeyValue := 'HKEY_CURRENT_USER'; fRegistry.RootKey := HKEY_CURRENT_USER; fRegistry.OpenKey('\', FALSE); DoAnalyzeBranch(); end; if not fStopFlag then begin fCurrentKeyValue := 'HKEY_USERS'; fRegistry.RootKey := HKEY_USERS; fRegistry.OpenKey('\', FALSE); DoAnalyzeBranch(); end; if not fStopFlag then begin fCurrentKeyValue := 'HKEY_LOCAL_MACHINE'; fRegistry.RootKey := HKEY_LOCAL_MACHINE; fRegistry.OpenKey('\Software', FALSE); DoAnalyzeBranch(); end; StringGrid1.RowCount := fRowCount; StatusBar1.SimpleText := 'Number of invalid references: '+IntToStr(fRowCount - 1); btnStop.Enabled := FALSE; if fRowCount = 1 then begin MessageDlg('No invalid references detected.',mtInformation,[mbOK],0); btnRemove.Enabled := FALSE; end else begin btnRemove.Enabled := TRUE; end; end; procedure TForm1.DoAnalyzeBranch; var I: Integer; Keys: TStringList; Path: String; begin Keys := TStringList.Create; try Path := fRegistry.CurrentPath; fRegistry.GetKeyNames(Keys); for I := 0 to Keys.Count - 1 do begin if fRegistry.OpenKey(Keys[I], FALSE) then begin DoAnalyzeKey(Keys[I]); if fStopFlag then Break; if fRegistry.HasSubKeys then DoAnalyzeBranch; end; if fStopFlag then Break; NormalizeRegistryPath(Path); if not fRegistry.OpenKey(Path, FALSE) then raise exception.Create('Can not open key '+Path); end; finally Keys.Free; end; end; procedure TForm1.DoAnalyzeKey(const Key: String); var I: Integer; Values: TStringList; DataType: TRegDataType; StringValue: String; RegKeyInfo: TRegKeyInfo; SystemTime: TSystemTime; StringDate: String; begin Values := TStringList.Create; try fRegistry.GetValueNames(Values); for I := 0 to Values.Count - 1 do begin DataType := fRegistry.GetDataType(Values[I]); if (DataType = rdString) or (DataType = rdExpandString) then begin StatusBar1.SimpleText := 'Analyzing: '+Key; { Let the applocation to process messages, so the text would be on the status bar while we are still in the loop } Application.ProcessMessages; if fStopFlag then Break; StringValue := fRegistry.ReadString(Values[I]); if (not DoAnalyzeValue(Key, Values[I])) or (not DoAnalyzeValue(Key, StringValue)) then begin if StringGrid1.RowCount = fRowCount then StringGrid1.RowCount := fRowCount + 10; fRegistry.GetKeyInfo(RegKeyInfo); FileTimeToSystemTime(RegKeyInfo.FileTime, SystemTime); DateTimeToString(StringDate, 'mm/dd/yyyy hh:mmAM/PM', SystemTimeToDateTime(SystemTime)); StringGrid1.Cells[nKeyName, fRowCount] := fCurrentKeyValue + ': ' +fRegistry.CurrentPath; StringGrid1.Cells[nFileTime, fRowCount]:= StringDate; StringGrid1.Cells[nValueName, fRowCount] := Values[I]; StringGrid1.Cells[nValueString, fRowCount] := StringValue; { If there is no rows selected yet then select the first one } if fNoSelection then begin fNoSelection := FALSE; StringGrid1.Selection := TGridRect(Rect(0, 1, 4, 1)); end; Inc(fRowCount); end; end; end; finally Values.Free; end; end; function TForm1.DoAnalyzeValue(const Key, Value: String): Boolean; var DriveType: UINT; Path: String; FileName: String; begin Result := TRUE; { Verify if the string can be treated as path (and file name)} if Length(Value) < 3 then Exit; if not (UpCase(Value[1]) in ['C'..'Z']) then Exit; if Pos(';', Value) > 0 then Exit; if Pos(',', Value) > 0 then Exit; if Pos(' ', Value) > 0 then Exit; if (Value[2] <> ':') or (Value[3] <> '\') then Exit; Root[0] := Value[1]; DriveType := GetDriveType(Root); if (DriveType = DRIVE_FIXED) then begin if (ExtractFileExt(Value) = '') then begin { No extension, try to treat the value as path } Path := Value; if (Path[Length(Path)] <> '\') then Path := Value + '\'; if not SetCurrentDirectory(PChar(Path)) then begin Result := FALSE; Exit; end; end else begin Path := ExtractFilePath(Value); if not SetCurrentDirectory(PChar(Path)) then begin Result := FALSE; Exit; end; FileName := ExtractFileName(Value); if (GetFileAttributes(PChar(Value)) = -1) then begin Result := FALSE; Exit; end; end; end; end; procedure TForm1.FormShow(Sender: TObject); begin StringGrid1.Cells[nKeyName, 0] := 'Registry Key'; StringGrid1.Cells[nFileTime, 0] := 'Last Modification'; StringGrid1.Cells[nValueName, 0] := 'String Value'; StringGrid1.Cells[nValueString, 0] := 'File/Path reference'; fRowCount := 1; btnRemove.Enabled := FALSE; btnStop.Enabled := FALSE; fNoSelection := TRUE; end; procedure TForm1.btnRemoveClick(Sender: TObject); var I: Integer; Msg: String; Count: Integer; Selection: TGridRect; RootKey: Longint; Path: String; procedure ParseKeyValue(const S: String); var I: Integer; Key: String; begin I := Pos(':', S); Key := Copy(S, 1, I-1); Path := Copy(S, I+2 , Length(S)); NormalizeRegistryPath(Path); if Key = 'HKEY_CURRENT_USER' then RootKey := HKEY_CURRENT_USER else if Key = 'HKEY_USERS' then RootKey := HKEY_USERS else if Key = 'HKEY_LOCAL_MACHINE' then RootKey := HKEY_LOCAL_MACHINE; end; begin Selection := StringGrid1.Selection; Count := Selection.Bottom - Selection.Top + 1; if Count = 1 then Msg := 'Are you sure you want to remove selected entry from the Registry?' else Msg := 'Are you sure you want to remove ' + IntToStr(Selection.Bottom - Selection.Top + 1) + ' selected entries from the Registry?'; if MessageDlg(Msg, mtWarning, [mbYes,mbNo], 0) = mrYes then begin for I := Selection.Top to Selection.Bottom do begin ParseKeyValue(StringGrid1.Cells[nKeyName, I]); fRegistry.RootKey := RootKey; if not fRegistry.OpenKey(Path, FALSE) then raise Exception.Create('Error opening registry key '+Path); fRegistry.DeleteValue(StringGrid1.Cells[nValueName, I]); end; { Initiate re-scanning } btnStartClick(self); end; end; procedure TForm1.StringGrid1SelectCell(Sender: TObject; Col, Row: Integer; var CanSelect: Boolean); begin { Display values in the edit controls only when there is any data in the grid } if not (fNoSelection) then begin edKey.Text := StringGrid1.Cells[nKeyName, Row]; edTime.Text := StringGrid1.Cells[nFileTime, Row]; edValueName.Text := StringGrid1.Cells[nValueName, Row]; edValue.Text := StringGrid1.Cells[nValueString, Row]; end; end; procedure TForm1.btnStopClick(Sender: TObject); begin { Set the stop flag, so the registry scanning process can stop } fStopFlag := TRUE; end; end. 2003-12-15 16:21:10 这个程序可以获得注册表下的全部值(另外一种方法) Var Reg : TRegistry; list : TStrings; i : Integer; Begin Reg:=TRegistry.Create; Reg.RootKey:='HKEY_LOCAL_MACHINE'; If Reg.OpenKey('\Software\Microsoft\CurrentVersion\Run', false) then Begin List:=TStringList.Create; Reg.GetValueNames(List); For i:=0 to list.Count-1 do If Reg.ValueExists(List[i]) then Begin Case Reg.GetDataType(List[i]) of rdInteger: Reg.ReadInteger(List[i]); rdBinary: Reg.ReadBinaryData(List[i]); else Reg.ReadString(List[i]); End; End; End; End; 另外，ReadBinaryData可以读取二进制键值
本文来源：http://blog.csdn.net/cqingling/archive/2007/08/09/1733773.aspx
|
||||||||||
| 文章录入：admin 责任编辑：admin | ||||||||||
| 【发表评论】【加入收藏】【告诉好友】【打印此文】【关闭窗口】 | ||||||||||
站内文章搜索