Delphi Can

İyi günler. Delphi TRegistry sınıfı için bir çok tipte okuma ve yazma metotu varken çoklu dize (multi string) değeri okuma ve yazma işlemini destekleyen direkt metotlar bulunmamaktadır (varsada gözüme ilişmedi şimdiye kadar  ). untRegistryHelper.pas isimli aşağıdaki gibi bir dosya oluşturup uses'a bu uniti eklemek gerekli yeteneği kazanmaya yeterli olacaktır.

unit untRegistryHelper;

interface

uses Classes, Registry;

type
 TRegistryHelper=class helper for TRegistry
 public
   function ReadMultiStrings(const Name: String): String;
   function WriteMultiStrings(const Name: String;const sList:TStrings): Boolean;overload;
   function WriteMultiStrings(const Name:String;Values: String;const isLineBreak:Boolean=True): Boolean;overload;
   function WriteMultiStrings(const Name:String;const Values:array of String):Boolean;overload;
 end;

implementation

uses Windows, SysUtils, StrUtils;

function TRegistryHelper.ReadMultiStrings(const Name: String): String;
var rdiBilgi:TRegDataInfo; DataType, iLen:Integer;
{$IF CompilerVersion<18.0}
function Trim(const S: string): string;
var
  I, L: Integer;
begin
  Result:=S;
  L := Length(S) - 1;
  I := 0;
  if (L > -1) and (S[I] > ' ') and (S[L] > ' ') then Exit;
  while (I <= L) and (S[I] <= ' ') do Inc(I);
  if I > L then begin
    Result:='';
    Exit;
  end;
  while S[L] <= ' ' do Dec(L);
  Result := Copy(S, I , L - I + 1);
end;
{$IFEND}
begin
 Result:='';
 if GetDataInfo(Name, rdiBilgi) then begin
   iLen:=Round(rdiBilgi.DataSize / SizeOf(Char));
   SetLength(Result, iLen);
   DataType:=REG_MULTI_SZ{=7};
   if RegQueryValueEx(CurrentKey, PChar(Name), nil, @DataType, Pointer(Result), @rdiBilgi.DataSize)=ERROR_SUCCESS then begin
     Result:=ReplaceText(Trim(Result), #0, sLineBreak);
   end;
 end;
end;

function TRegistryHelper.WriteMultiStrings(const Name: String; const Values: array of String): Boolean;
var sVal:String; iPos:Integer;
begin
 sVal:='';
 for iPos := Low(Values) to High(Values) do
  sVal:=sVal+Values[iPos]+#0;
 Result:=WriteMultiStrings(Name, sVal, False);
end;

function TRegistryHelper.WriteMultiStrings(const Name: String; Values: String; const isLineBreak: Boolean): Boolean;
begin
 if isLineBreak then
  Values:=ReplaceText(Trim(Values), sLineBreak, #0)+#0;
 Result:=(RegSetValueEx(CurrentKey, PChar(Name), 0, REG_MULTI_SZ {=7}, PChar(Values), Length(Values) * SizeOf(Char)))=ERROR_SUCCESS;
end;

function TRegistryHelper.WriteMultiStrings(const Name: String; const sList: TStrings): Boolean;
begin
 Result:=WriteMultiStrings(Name, ReplaceText(Trim(sList.Text), sList.LineBreak, #0)+#0, False);
end;

end.

Bu örneğe bağlı olarak sistemde yüklü olan (32 ve 64 bit) SQL Server hizmetlerinin InstanceName değerlerini elde eden şöyle bir kod yazabiliriz artık.

uses untRegistryHelper;

procedure TForm1.BitBtn1Click(Sender: TObject);
const
{$IF CompilerVersion<18.0}
 KEY_WOW64_32KEY        = $0200;
 KEY_WOW64_64KEY        = $0100;
{$IFEND}
 SQLPath='\SOFTWARE\Microsoft\Microsoft SQL Server';
 SQLInstanceRegName='InstalledInstances';
var Reg:TRegistry; sDeger:String;
begin
 sDeger:='';
 try
   Reg:=TRegistry.Create;
   Reg.RootKey:=HKEY_LOCAL_MACHINE;
   Reg.Access:=KEY_READ or KEY_WOW64_32KEY;
   if Reg.OpenKey(SQLPath, False) then
    sDeger:=Reg.ReadMultiStrings(SQLInstanceRegName);
   Reg.Access:=KEY_READ or KEY_WOW64_64KEY;
   if Reg.OpenKey(SQLPath, False) then
    sDeger:=Trim(sDeger+sLineBreak+Reg.ReadMultiStrings(SQLInstanceRegName));
 finally
   Reg.Free;
 end;
 ShowMessage(sDeger);
end;

İyi çalışmalar.

Not : Kodlarda eski sürüm Delphi üzerinde de çalışması için bazı uyarlamalar yapıldı ve buna dikkat çekmek için {$IF CompilerVersion<18.0} şartına bağlı olarak derleyici direktifi içine alındı. Kodları (doğru) çalıştıramayan diğer delphi sürümlerinde bu direktiflerin kaldırması yeterli olacaktır.