Delphi Read/Write REG_MULTI_SZ

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;

以下为源代码！

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.