Windows registry çoklu dize (multi string) değeri okuma ve yazma

Yazdığınız makaleleri ve üyelerimizin işine yarayacağını düşündüğünüz kodlarınızı gönderebilirsiniz. Bu foruma soru sormayın!
Cevapla
Kullanıcı avatarı
sabanakman
Kıdemli Üye
Mesajlar: 3014
Kayıt: 17 Nis 2006 07:11
Konum: Ah bi Antalya olaydı keşke (Ankara)

Windows registry çoklu dize (multi string) değeri okuma ve yazma

Mesaj gönderen sabanakman » 21 Kas 2018 12:25

İ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 :mrgreen: ). untRegistryHelper.pas isimli aşağıdaki gibi bir dosya oluşturup uses'a bu uniti eklemek gerekli yeteneği kazanmaya yeterli olacaktır.

Kod: Tümünü seç

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.

Kod: Tümünü seç

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.
Şaban Şahin AKMAN
_________________
Derin olan kuyu değil kısa olan iptir. - .

Cevapla