Mega Code Archive

 
Categories / Delphi / Games
 

Tüm registry tiplerini okuyup yazbilecek bir fonksiyon

//Adamlar Yazmışlar... Bulduğumda sizlerle de paylaşmak istedim. //Ancak Windows 2000 için biraz geliştirilmesi gerekiyor. Biz de onu yapalım //Yorumlarınızı bekliyorum. //Fonksiyonların Yazarı: Ernesto D'Spirito //http://www.latiumsoftware.com/download/delphi-2.zip unit regunit; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,registry, Dialogs, StdCtrls; type TForm1 = class(TForm) Button1: TButton; Edit1: TEdit; Button2: TButton; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); private { Private declarations } public end; var Form1: TForm1; deger: string; implementation //Her Türlü Registry tipini ouyan bir fonksiyon. function GetRegistryData(RootKey: HKEY; Key, Value: string): variant; var Reg: TRegistry; RegDataType: TRegDataType; DataSize, Len: integer; s: string; deger:string; label cantread; begin Reg := nil; try Reg := TRegistry.Create(KEY_QUERY_VALUE); Reg.RootKey := RootKey; if Reg.OpenKeyReadOnly(Key) then begin try RegDataType := Reg.GetDataType(Value); if (RegDataType = rdString) or (RegDataType = rdExpandString) then Result := Reg.ReadString(Value) else if RegDataType = rdInteger then Result := Reg.ReadInteger(Value) else if RegDataType = rdBinary then begin DataSize := Reg.GetDataSize(Value); if DataSize = -1 then goto cantread; SetLength(s, DataSize); Len := Reg.ReadBinaryData(Value, PChar(s)^, DataSize); if Len <> DataSize then goto cantread; Result := s; end else cantread: raise Exception.Create(SysErrorMessage(ERROR_CANTREAD)); except s := ''; Reg.CloseKey; raise; end; Reg.CloseKey; end else raise Exception.Create(SysErrorMessage(GetLastError)); except Reg.Free; raise; end; Reg.Free; end; //Her Türlü Registry tipi istenilen yere yazılabiliyor. procedure SetRegistryData(RootKey: HKEY; Key, Value: string; RegDataType: TRegDataType; Data: variant); var Reg: TRegistry; s: string; begin Reg := nil; try Reg := TRegistry.Create(KEY_WRITE); Reg.RootKey := RootKey; if Reg.OpenKey(Key, True) then begin try if RegDataType = rdUnknown then RegDataType := Reg.GetDataType(Value); if RegDataType = rdString then Reg.WriteString(Value, Data) else if RegDataType = rdExpandString then Reg.WriteExpandString(Value, Data) else if RegDataType = rdInteger then Reg.WriteInteger(Value, Data) else if RegDataType = rdBinary then begin s := Data; Reg.WriteBinaryData(Value, PChar(s)^, Length(s)); end else raise Exception.Create(SysErrorMessage(ERROR_CANTWRITE)); except Reg.CloseKey; raise; end; Reg.CloseKey; end else raise Exception.Create(SysErrorMessage(GetLastError)); except Reg.Free; raise; end; Reg.Free; end; {$R *.DFM} procedure TForm1.Button1Click(Sender: TObject); begin Edit1.text:=GetRegistryData(HKEY_LOCAL_MACHINE,'\system\currentcontrolset\control\timezoneinformation\','ActiveTimeBias'); deger:=Edit1.Text; end; procedure TForm1.Button2Click(Sender: TObject); begin if deger='^ÿÿÿÿ' then begin SetRegistryData(HKEY_LOCAL_MACHINE,'\system\currentcontrolset\control\timezoneinformation\','ActiveTimeBias', rdBinary, 'Lÿÿÿÿ');//if Edit1.Text:='Lÿÿÿÿ' then end else if deger='Lÿÿÿÿ' then begin SetRegistryData(HKEY_LOCAL_MACHINE,'\system\currentcontrolset\control\timezoneinformation\','ActiveTimeBias', rdBinary, '^ÿÿÿÿ');//if Edit1.Text:='Lÿÿÿÿ' then end end; end.