avatar

function  GetSystemDefaultLangID: LANGID;

返回值可能有…
0×0000 Language Neutral
0x007f The language for the invariant locale (LOCALE_INVARIANT). See MAKELCID.
0×0400 Process or User Default Language
0×0800 System Default Language
0×0436 Afrikaans
0x041c Albanian
0×0401 Arabic (Saudi Arabia)
0×0801 Arabic (Iraq)
0x0c01 Arabic (Egypt)
0×1001 Arabic (Libya)
0×1401 Arabic (Algeria)
0×1801 Arabic (Morocco)
0x1c01 Arabic (Tunisia)
0×2001 Arabic (Oman)
0×2401 Arabic (Yemen)
0×2801 Arabic (Syria)
0x2c01 Arabic (Jordan)
0×3001 Arabic (Lebanon)
0×3401 Arabic (Kuwait)
0×3801 Arabic (U.A.E.)
0x3c01 Arabic (Bahrain)
0×4001 Arabic (Qatar)
0x042b Windows 2000/XP: Armenian. This is Unicode only.
0x042c Azeri (Latin)
0x082c Azeri (Cyrillic)
0x042d Basque
0×0423 Belarusian
0×0402 Bulgarian
0×0455 Burmese
0×0403 Catalan
0×0404 Chinese (Taiwan)
0×0804 Chinese (PRC)
0x0c04 Chinese (Hong Kong SAR, PRC)
0×1004 Chinese (Singapore)
0×1404 Windows 98/Me, Windows 2000/XP: Chinese (Macau SAR)
0x041a Croatian
0×0405 Czech
0×0406 Danish
0×0465 Windows XP: Divehi. This is Unicode only.
0×0413 Dutch (Netherlands)
0×0813 Dutch (Belgium)
0×0409 English (United States)
0×0809 English (United Kingdom)
0x0c09 English (Australian)
0×1009 English (Canadian)
0×1409 English (New Zealand)
0×1809 English (Ireland)
0x1c09 English (South Africa)
0×2009 English (Jamaica)
0×2409 English (Caribbean)
0×2809 English (Belize)
0x2c09 English (Trinidad)
0×3009 Windows 98/Me, Windows 2000/XP: English (Zimbabwe)
0×3409 Windows 98/Me, Windows 2000/XP: English (Philippines)
0×0425 Estonian
0×0438 Faeroese
0×0429 Farsi
0x040b Finnish
0x040c French (Standard)
0x080c French (Belgian)
0x0c0c French (Canadian)
0x100c French (Switzerland)
0x140c French (Luxembourg)
0x180c Windows 98/Me, Windows 2000/XP: French (Monaco)
0×0456 Windows XP: Galician
0×0437 Windows 2000/XP: Georgian. This is Unicode only.
0×0407 German (Standard)
0×0807 German (Switzerland)
0x0c07 German (Austria)
0×1007 German (Luxembourg)
0×1407 German (Liechtenstein)
0×0408 Greek
0×0447 Windows XP: Gujarati. This is Unicode only.
0x040d Hebrew
0×0439 Windows 2000/XP: Hindi. This is Unicode only.
0x040e Hungarian
0x040f Icelandic
0×0421 Indonesian
0×0410 Italian (Standard)
0×0810 Italian (Switzerland)
0×0411 Japanese
0x044b Windows XP: Kannada. This is Unicode only.
0×0457 Windows 2000/XP: Konkani. This is Unicode only.
0×0412 Korean
0×0812 Windows 95, Windows NT 4.0 only: Korean (Johab)
0×0440 Windows XP: Kyrgyz.
0×0426 Latvian
0×0427 Lithuanian
0×0827 Windows 98 only: Lithuanian (Classic)
0x042f FYRO Macedonian
0x043e Malay (Malaysian)
0x083e Malay (Brunei Darussalam)
0x044e Windows 2000/XP: Marathi. This is Unicode only.
0×0450 Windows XP: Mongolian
0×0414 Norwegian (Bokmal)
0×0814 Norwegian (Nynorsk)
0×0415 Polish
0×0416 Portuguese (Brazil)
0×0816 Portuguese (Portugal)
0×0446 Windows XP: Punjabi. This is Unicode only.
0×0418 Romanian
0×0419 Russian
0x044f Windows 2000/XP: Sanskrit. This is Unicode only.
0x0c1a Serbian (Cyrillic)
0x081a Serbian (Latin)
0x041b Slovak
0×0424 Slovenian
0x040a Spanish (Spain, Traditional Sort)
0x080a Spanish (Mexican)
0x0c0a Spanish (Spain, International Sort)
0x100a Spanish (Guatemala)
0x140a Spanish (Costa Rica)
0x180a Spanish (Panama)
0x1c0a Spanish (Dominican Republic)
0x200a Spanish (Venezuela)
0x240a Spanish (Colombia)
0x280a Spanish (Peru)
0x2c0a Spanish (Argentina)
0x300a Spanish (Ecuador)
0x340a Spanish (Chile)
0x380a Spanish (Uruguay)
0x3c0a Spanish (Paraguay)
0x400a Spanish (Bolivia)
0x440a Spanish (El Salvador)
0x480a Spanish (Honduras)
0x4c0a Spanish (Nicaragua)
0x500a Spanish (Puerto Rico)
0×0430 Sutu
0×0441 Swahili (Kenya)
0x041d Swedish
0x081d Swedish (Finland)
0x045a Windows XP: Syriac. This is Unicode only.
0×0449 Windows 2000/XP: Tamil. This is Unicode only.
0×0444 Tatar (Tatarstan)
0x044a Windows XP: Telugu. This is Unicode only.
0x041e Thai
0x041f Turkish
0×0422 Ukrainian
0×0420 Windows 98/Me, Windows 2000/XP: Urdu (Pakistan)
0×0820 Urdu (India)
0×0443 Uzbek (Latin)
0×0843 Uzbek (Cyrillic)
0x042a Windows 98/Me, Windows NT 4.0 and later: Vietnamese

avatar

unit SMTP_Connections;
//——————————————
//定义单元
//———————————————
interface
uses
Classes, StdCtrls;
const
WinSock = ’wsock32.dll’;
Internet = 2;
Stream  = 1;
fIoNbRead = $4004667F;
WinSMTP = $0001;
LinuxSMTP = $0002;
type
TWSAData = packed record
  wVersion: Word;
  wHighVersion: Word;
  szDescription: array[0..256] of Char;
  szSystemStatus: array[0..128] of Char;
  iMaxSockets: Word;
  iMaxUdpDg: Word;
  lpVendorInfo: PChar;
end;
PHost = ^THost;
THost = packed record
  Name: PChar;
  aliases: ^PChar;
  addrtype: Smallint;
  Length: Smallint;
  addr: ^Pointer;
end;
TSockAddr = packed record
  Family: Word;
  Port: Word;
  Addr: Longint;
  Zeros: array[0..7] of Byte;
end;

function WSAStartup(Version:word; Var Data:TwsaData):integer; stdcall; far; external winsock;
function socket(Family,Kind,Protocol:integer):integer; stdcall; far; external winsock;
function shutdown(Socket,How:Integer):integer; stdcall; far; external winsock;
function closesocket(socket:Integer):integer; stdcall; far; external winsock;
function WSACleanup:integer; stdcall; far; external winsock;
function bind(Socket:Integer; Var SockAddr:TSockAddr; AddrLen:integer):integer; stdcall; far; external winsock;
function listen(socket,flags:Integer):integer; stdcall; far; external winsock;
function connect(socket:Integer; Var SockAddr:TSockAddr; AddrLen:integer):integer; stdcall; far; external winsock;
function accept(socket:Integer; Var SockAddr:TSockAddr; Var AddrLen:Integer):integer; stdcall; far; external winsock;
function WSAGetLastError:integer; stdcall; far; external winsock;
function recv(socket:integer; data:pchar; datalen,flags:integer):integer; stdcall; far; external winsock;
function send(socket:integer; var data; datalen,flags:integer):integer; stdcall; far; external winsock;
function gethostbyname(HostName:PChar):PHost; stdcall; far; external winsock;
function WSAIsBlocking:boolean; stdcall; far; external winsock;
function WSACancelBlockingCall:integer; stdcall; far; external winsock;
function ioctlsocket(socket:integer; cmd: Longint; var arg: longint): Integer; stdcall; far; external winsock;
function gethostname(name:pchar; size:integer):integer; stdcall; far; external winsock;

procedure _authSendMail(MailServer,uname,upass,mFrom,mFromName,mToName,Subject:string;mto,mbody:TStringList);
function ConnectServer(mhost:string;mport:integer):integer;
function ConnectServerwin(mhost:string;mport:integer):integer;
function DisConnectServer:integer;
function Stat: string;
function SendCommand(Command: String): string;
function SendData(Command: String): string;
function SendCommandWin(Command: String): string;
function ReadCommand: string;
function encryptB64(s:string):string;

var
mconnHandle: Integer;
mFin, mFOut: Textfile;
EofSock: Boolean;
mactive: Boolean;
mSMTPErrCode: Integer;
mSMTPErrText: string;
mMemo: TMemo;

implementation

uses
SysUtils, Sockets, IdBaseComponent,
IdCoder, IdCoder3to4, IdCoderMIME, IniFiles,Unit1;

var
mClient: TTcpClient;

procedure _authSendMail(MailServer, uname, upass, mFrom, mFromName,
mToName, Subject: string; mto, mbody: TStringList);
var
tmpstr: string;
cnt: Integer;
mstrlist: TStrings;
RecipientCount: Integer;
begin
if ConnectServerWin(Mailserver, 25) = 250 then
begin
  Sendcommandwin(’AUTH LOGIN ’);
  SendcommandWin(encryptB64(uname));
  SendcommandWin(encryptB64(upass));
  SendcommandWin(’MAIL FROM: ’ + mfrom);
  for cnt := 0 to mto.Count – 1 do
    SendcommandWin(’RCPT TO: ’ + mto[cnt]);
  Sendcommandwin(’DATA’);
  SendData(’Subject: ’ + Subject);
  SendData(’From: “’ + mFromName + ’“ 〈’ + mfrom + ’〉’);
  SendData(’To: ’ + mToName);
  SendData(’Mime-Version: 1.0’);
  SendData(’Content-Type: multipart/related; boundary=“Esales-Order“;’);
  SendData(’     type=“text/html“’);
  SendData(’’);
  SendData(’–Esales-Order’);
  SendData(’Content-Type: text/html;’);
  SendData(’        charset=“iso-8859-9“’);
  SendData(’Content-Transfer-Encoding: QUOTED-PRINTABLE’);
  SendData(’’);
  for cnt := 0 to mbody.Count – 1 do
    SendData(mbody[cnt]);
  Senddata(’’);
  SendData(’–Esales-Order–’);
  Senddata(’ ’);
  mSMTPErrText := SendCommand(crlf + ’.’ + crlf);
  try
    mSMTPErrCode := StrToInt(Copy(mSMTPErrText, 1, 3));
  except
  end;
  SendData(’QUIT’);
  DisConnectServer;
end;
end;

function Stat: string;
var
s: string;
begin
s := ReadCommand;
Result := s;
end;

function EchoCommand(Command: string): string;
begin
SendCommand(Command);
Result := ReadCommand;
end;

function ReadCommand: string;
var
tmp: string;
begin
repeat
  ReadLn(mfin, tmp);
  if Assigned(mmemo) then
    mmemo.Lines.Add(tmp);
until (Length(tmp) 〈 4) or (tmp[4] 〈〉 ’-’);
Result := tmp
end;

function SendData(Command: string): string;
begin
Writeln(mfout, Command);
end;

function SendCommand(Command: string): string;
begin
Writeln(mfout, Command);
Result := stat;
end;

function SendCommandWin(Command: string): string;
begin
Writeln(mfout, Command + #13);
Result := stat;
end;

function FillBlank(Source: string; number: Integer): string;
var
a: Integer;
begin
Result := ’’;
for a := Length(trim(Source)) to number do
  Result := Result + ’ ’;
end;

function IpToLong(ip: string): Longint;
var
x, i: Byte;
ipx: array[0..3] of Byte;
v: Integer;
begin
Result := 0;
Longint(ipx) := 0;
i := 0;
for x := 1 to Length(ip) do
  if ip[x] = ’.’ then
  begin
    Inc(i);
    if i = 4 then Exit;
  end
else
begin
  if not (ip[x] in [’0’..’9’]) then Exit;
  v := ipx[i] * 10 + Ord(ip[x]) – Ord(’0’);
  if v 〉 255 then Exit;
  ipx[i] := v;
end;
Result := Longint(ipx);
end;

function HostToLong(AHost: string): Longint;
var
Host: PHost;
begin
Result := IpToLong(AHost);
if Result = 0 then
begin
  Host := GetHostByName(PChar(AHost));
  if Host 〈〉 nil then Result := Longint(Host^.Addr^^);
end;
end;

function LongToIp(Long: Longint): string;
var
ipx: array[0..3] of Byte;
i: Byte;
begin
Longint(ipx) := long;
Result       := ’’;
for i := 0 to 3 do Result := Result + IntToStr(ipx[i]) + ’.’;
SetLength(Result, Length(Result) – 1);
end;

procedure Disconnect(Socket: Integer);
begin
ShutDown(Socket, 1);
CloseSocket(Socket);
end;

function CallServer(Server: string; Port: Word): Integer;
var
SockAddr: TSockAddr;
begin
Result := socket(Internet, Stream, 0);
if Result = -1 then Exit;
FillChar(SockAddr, SizeOf(SockAddr), 0);
SockAddr.Family := Internet;
SockAddr.Port := swap(Port);
SockAddr.Addr := HostToLong(Server);
if Connect(Result, SockAddr, SizeOf(SockAddr)) 〈〉 0 then
begin
  Disconnect(Result);
  Result := -1;
end;
end;

function OutputSock(var F: TTextRec): Integer; far;
begin
if F.BufPos 〈〉 0 then
begin
  Send(F.Handle, F.BufPtr^, F.BufPos, 0);
  F.BufPos := 0;
end;
Result := 0;
end;

function InputSock(var F: TTextRec): Integer; far;
var
Size: Longint;
begin
F.BufEnd := 0;
F.BufPos := 0;
Result := 0;
repeat
  if (IoctlSocket(F.Handle, fIoNbRead, Size) 〈 0) then
  begin
    EofSock := True;
    Exit;
  end;
until (Size 〉= 0);
F.BufEnd := Recv(F.Handle, F.BufPtr, F.BufSize, 0);
EofSock  := (F.Bufend = 0);
end;

function CloseSock(var F: TTextRec): Integer; far;
begin
Disconnect(F.Handle);
F.Handle := -1;
Result   := 0;
end;

function OpenSock(var F: TTextRec): Integer; far;
begin
if F.Mode = fmInput then
begin
  EofSock := False;
  F.BufPos := 0;
  F.BufEnd := 0;
  F.InOutFunc := @InputSock;
  F.FlushFunc := nil;
end
else
begin
  F.Mode := fmOutput;
  F.InOutFunc := @OutputSock;
  F.FlushFunc := @OutputSock;
end;
F.CloseFunc := @CloseSock;
Result := 0;
end;

procedure AssignCrtSock(Socket:integer; Var Input,Output:TextFile);
begin
with TTextRec(Input) do
begin
  Handle := Socket;
  Mode := fmClosed;
  BufSize := SizeOf(Buffer);
  BufPtr := @Buffer;
  OpenFunc := @OpenSock;
end;
with TTextRec(Output) do
begin
  Handle := Socket;
  Mode := fmClosed;
  BufSize := SizeOf(Buffer);
  BufPtr := @Buffer;
  OpenFunc := @OpenSock;
end;
Reset(Input);
Rewrite(Output);
end;

function ConnectServer(mhost: string; mport: Integer): Integer;
var
tmp: string;
begin
mClient := TTcpClient.Create(nil);
mClient.RemoteHost := mhost;
mClient.RemotePort := IntToStr(mport);
mClient.Connect;
mconnhandle := callserver(mhost, mport);
if (mconnHandle〈〉-1) then
begin
  AssignCrtSock(mconnHandle, mFin, MFout);
  tmp := stat;
  tmp := SendCommand(’HELO bellona.com.tr’);
  if Copy(tmp, 1, 3) = ’250’ then
  begin
    Result := StrToInt(Copy(tmp, 1, 3));
  end;
end;
end;

function ConnectServerWin(mhost: string; mport: Integer): Integer;
var
tmp: string;
begin
mClient := TTcpClient.Create(nil);
mClient.RemoteHost := mhost;
mClient.RemotePort := IntToStr(mport);
mClient.Connect;
mconnhandle := callserver(mhost, mport);
if (mconnHandle〈〉-1) then
begin
  AssignCrtSock(mconnHandle, mFin, MFout);
  tmp := stat;
  tmp := SendCommandWin(’HELO bellona.com.tr’);
  if Copy(tmp, 1, 3) = ’250’ then
  begin
    Result := StrToInt(Copy(tmp, 1, 3));
  end;
end;
end;

function DisConnectServer: Integer;
begin
closesocket(mconnhandle);
mClient.Disconnect;
mclient.Free;
end;

function encryptB64(s: string): string;
var
hash1: TIdEncoderMIME;
p: string;
begin
if s 〈〉 ’’ then
begin
  hash1 := TIdEncoderMIME.Create(nil);
  p := hash1.Encode(s);
  hash1.Free;
end;
Result := p;
end;
end.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
//------------------------------------------
// 怎么使用定义好得相关单元
//---------------------------------------------
unit Unit1;
interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;
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}
uses
 SMTP_Connections;

procedure TForm1.Button1Click(Sender: TObject);
var
 mto, mbody: TStringList;
 MailServer, uname, upass, mFrom, mFromName,
 mToName, Subject: string;
begin
 mMemo := Memo1; // 定义相关发送服务器
 //..........................
 MailServer := ’mail.163.com’;
 uname := ’username’;
 upass := ’password’;
 mFrom :=  ’laolij@163.com;
 mFromName := ’forename surname’;
 mToName := ’’;
 Subject := ’Your Subject’;
 //..........................
 mto := TStringList.Create;
 mbody := TStringList.Create;
 try
   mto.Add(’anybody@xyz.net’);
   mbody.Add(’测试邮件’);
   //发送.................
   _authSendMail(MailServer, uname, upass, mFrom, mFromName, mToName, Subject, mto, mbody);
   //..........................
 finally
   mto.Free;
   mbody.Free;
 end;
end;
end.
avatar
1
2
3
4
5
6
7
8
9
10
11
12
Procedure MySleep(MSec: int64);
//过程说明:延时后继续后面的动作
//参数说明:
//  MSec:延时的时间(毫秒)
//Written by YGMAN
Var
 Tmp: TDateTime;
Begin
 Tmp:=Now;
 While MSecsPerDay*(Now-Tmp)<MSec Do
   Application.ProcessMessages;
End;
avatar
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
procedure TMainForm.RunDosInMemo(const DosApp: string; AMemo: TMemo);
const
{设置ReadBuffer的大小}
ReadBuffer = 2400;
var
Security: TSecurityAttributes;
ReadPipe, WritePipe: THandle;
start: TStartUpInfo;
ProcessInfo: TProcessInformation;
Buffer: PChar;
BytesRead: DWord;
Buf: string;
begin
with Security do
begin
nlength := SizeOf(TSecurityAttributes);
binherithandle := true;
lpsecuritydescriptor := nil;
end;
{创建一个命名管道用来捕获console程序的输出}
if Createpipe(ReadPipe, WritePipe, @Security, 0) then
begin
Buffer := AllocMem(ReadBuffer + 1);
FillChar(Start, Sizeof(Start), #0)
{设置console程序的启动属性}
with start do
begin
cb := SizeOf(start);
start.lpReserved := nil;
lpDesktop := nil;
lpTitle := nil;
dwX := 0;
dwY := 0;
dwXSize := 0;
dwYSize := 0;
dwXCountChars := 0;
dwYCountChars := 0;
dwFillAttribute := 0;
cbReserved2 := 0;
lpReserved2 := nil;
hStdOutput := WritePipe; //将输出定向到我们建立的WritePipe上
hStdInput := ReadPipe; //将输入定向到我们建立的ReadPipe上
hStdError := WritePipe;//将错误输出定向到我们建立的WritePipe上
dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
wShowWindow := SW_HIDE;//设置窗口为hide
end;

try
{创建一个子进程,运行console程序}
if CreateProcess(nil, PChar(DosApp), @Security, @Security, true,
NORMAL_PRIORITY_CLASS,
nil, nil, start, ProcessInfo) then
begin
{等待进程运行结束}
WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
{关闭输出...开始没有关掉它,结果如果没有输出的话,程序死掉了。}
CloseHandle(WritePipe);
Buf := ';
{读取console程序的输出}
repeat
BytesRead := 0;
ReadFile(ReadPipe, Buffer[0], ReadBuffer, BytesRead, nil);
Buffer[BytesRead] := #0;
OemToAnsi(Buffer, Buffer);
Buf := Buf + string(Buffer);
until (BytesRead < ReadBuffer);

SendDebug(Buf);
{按照换行符进行分割,并在Memo中显示出来}
while pos(#10, Buf) > 0 do
begin
AMemo.Lines.Add(Copy(Buf, 1, pos(#10, Buf) - 1));
Delete(Buf, 1, pos(#10, Buf));
end;
end;
finally
FreeMem(Buffer);
CloseHandle(ProcessInfo.hProcess);
CloseHandle(ProcessInfo.hThread);
CloseHandle(ReadPipe);
end;
end;
end;
avatar

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。
  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下,有三个字符串值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
   if OpenKey( ′Software′,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′,True) then
   WriteString(′delphi′,′C:Files.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下的数值名称的方法来进行。
  6.判断数值名称存在、数值名称改名。
  valueExists用于判断数值名称是否存在:
  function valueExists(const Name: string): Boolean;
  返回值为True表示数值名称存在。
  Renamevalue用于数值名称改名:
  procedure Renamevalue(const OldName, NewName: string);
以上是注册表常用操作所对应的TRegistry的方法和属性,其它方法和属性请参见Delphi联机帮助文件。