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 下调试和通过。
备份部分注册表的代码
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;
本站仅提供存储服务，所有内容均由用户发布，如发现有害或侵权内容，请
点击举报。
