//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.