21-11-2018, Saat: 13:27
(Son Düzenleme: 21-11-2018, Saat: 13:45, Düzenleyen: sabanakman.)
İ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.
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.
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.