Delphi Read/Write REG_MULTI_SZ

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
unit Unit1;
 
 interface
 
 uses
      Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
      Buttons, Registry, StdCtrls;
 
type
      TExRegistry = class(TRegistry)
      public
      procedure ReadStrings(const valueName: string; strings: TStrings);
      procedure WriteStrings(const valueName: string; strings: TStrings);
      end;
 
 type
      EExRegistryException = class(ERegistryException)
      private
      fCode: Integer;
      function GetError : string;
      public
      constructor CreateLastError (const st : string);
      constructor Create (code : DWORD; const st : string);
      property Code : Integer read fCode;
      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
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
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
unit Unit1;
 
 interface
 
 uses
      Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
      Buttons, Registry, StdCtrls;
 
type
      TExRegistry = class(TRegistry)
      public
      procedure ReadStrings(const valueName: string; strings: TStrings);
      procedure WriteStrings(const valueName: string; strings: TStrings);
      end;
 
 type
      EExRegistryException = class(ERegistryException)
      private
      fCode: Integer;
      function GetError : string;
      public
      constructor CreateLastError (const st : string);
      constructor Create (code : DWORD; const st : string);
      property Code : Integer read fCode;
      end;
 
type
      TForm1 = class(TForm)
      Button1: TButton;
      Memo1: TMemo;
      procedure Button1Click(Sender: TObject);
      procedure Button2Click(Sender: TObject);
      public
      { Public declarations }
      end;
 
 var
      Form1: TForm1;
 
 implementation
 
 {$R *.DFM}
 
{ TExRegistry }
 
 procedure TExRegistry.ReadStrings(const valueName: string;
      strings: TStrings);
 var
      valueType : DWORD;
      valueLen : DWORD;
      p, buffer : PChar;
 begin
      strings.Clear;
      SetLastError (RegQueryValueEx (CurrentKey, PChar (valueName), Nil, @valueType, Nil, @valueLen));
      if GetLastError = ERROR_SUCCESS then
      if valueType = REG_MULTI_SZ then
      begin
          GetMem (buffer, valueLen);
          try
          RegQueryValueEx (CurrentKey, PChar (valueName), Nil, Nil, PBYTE(buffer), @valueLen);
          p := buffer;
          while p^ <> #0 do
          begin
          strings.Add (p);
          Inc (p, lstrlen (p) + 1)
          end
          finally
          FreeMem (buffer)
          end
      end
      else
          raise ERegistryException.Create ('String list expected')
      else
      raise EExRegistryException.CreateLastError('Unable read MULTI_SZ value')
 end;
 
 procedure TExRegistry.WriteStrings(const valueName: string;
      strings: TStrings);
 var
      p, buffer : PChar;
      i : Integer;
      size : DWORD;
 begin
      size := 0;
      for i := 0 to strings.Count - 1 do
      Inc (size, Length (strings [i]) + 1);
      Inc (size);
      GetMem (buffer, size);
      try
      p := buffer;
      for i := 0 to strings.count - 1 do
      begin
          lstrcpy (p, PChar (strings [i]));
          Inc (p, lstrlen (p) + 1)
      end;
      p^ := #0;
      SetLastError (RegSetValueEx (CurrentKey, PChar (valueName), 0, REG_MULTI_SZ, buffer, size));
      if GetLastError <> ERROR_SUCCESS then
          raise EExRegistryException.CreateLastError('Unable to write MULTI_SZ value');
      finally
      FreeMem (buffer)
      end
 end;
 
 
 { EExRegistryException }
 
 constructor EExRegistryException.Create(code: DWORD; const st: string);
 begin
      fCode := code;
      inherited Create (GetError + ':' + st);
 end;
 
 constructor EExRegistryException.CreateLastError(const st: string);
 begin
      fCode := GetLastError;
      inherited Create (GetError + ':' + st);
 end;
 
 function EExRegistryException.GetError: string;
 var
      msg : string;
 
      function GetErrorMessage (code : Integer) : string;
      var
      hErrLib : THandle;
      msg : PChar;
      flags : Integer;
 
      function MAKELANGID (p, s : word) : Integer;
      begin
          result := (s shl 10) or p
      end;
      begin
      hErrLib := LoadLibraryEx ('netmsg.dll', 0, LOAD_LIBRARY_AS_DATAFILE);
      try
          flags := FORMAT_MESSAGE_ALLOCATE_BUFFER or
          FORMAT_MESSAGE_IGNORE_INSERTS or
          FORMAT_MESSAGE_FROM_SYSTEM;
          if hErrLib <> 0 then
          flags := flags or FORMAT_MESSAGE_FROM_HMODULE;
 
          if FormatMessage (flags, pointer (hErrLib), code,
          MAKELANGID (LANG_NEUTRAL, SUBLANG_DEFAULT),
          PChar (@msg), 0, Nil) <> 0 then
          try
          result := msg;
          finally
          LocalFree (Integer (msg));
          end
      finally
          if hErrLib <> 0 then
          FreeLibrary (hErrLib)
      end
      end;
 begin
      msg := GetErrorMessage (fCode);
      if msg = '' then
      result := Format ('Error %d', [fCode])
      else
      result := Format ('Error %d : %s', [fCode, msg])
 end;
 
 
// 讀的部份
 procedure TForm1.Button1Click(Sender: TObject);
 var
      reg: TExRegistry;
 begin
      reg := TExRegistry.Create;
      try
      reg.RootKey := HKEY_LOCAL_MACHINE;
      if reg.OpenKey('SOFTWARE\Microsoft\Active Setup\InstallInfo', False) then
          reg.ReadStrings('InstalledComponents', Memo1.Lines);
      finally
      reg.Free;
      end;
 end;
 
 // 寫的部份
 procedure TForm1.Button2Click(Sender: TObject);
 var
      reg: TExRegistry;
 begin
      reg := TExRegistry.Create;
      try
      reg.RootKey := HKEY_LOCAL_MACHINE;
      if reg.OpenKey('SOFTWARE\Microsoft\Active Setup\InstallInfo', False) then
          reg.WriteStrings('Test', Memo1.Lines);
      finally
      reg.Free;
      end;
 end;
 
 end.

原创文章,转载请注明: 转载自 obaby@mars

本文标题: 《Delphi Read/Write REG_MULTI_SZ》

本文链接地址: http://h4ck.org.cn/2011/04/delphi-readwrite-reg_multi_sz/

You may also like

发表评论

电子邮件地址不会被公开。 必填项已用*标注