11-12-2010, 08:14 PM
السلام عليكم
بالتوفيق.
كود :
uses
Registry;
procedure SetRegistryData(RootKey: HKEY; Key, Value: string;
RegDataType: TRegDataType; Data: variant);
var
Reg: TRegistry;
s: string;
begin
Reg := TRegistry.Create(KEY_WRITE);
try
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));
finally
Reg.Free;
end;
end;
function BinToStr(const S: string): string;
var pInput : PChar;
pOutput: ^Byte;
N, LenInput: integer;
const
AtBin : array['0'..'1'] of byte = (0,1);
begin
LenInput := Length(S);
SetLength(result, LenInput shr 3);
LenInput := Length(result);
pInput := PChar(S);
pOutput := @result[1];
for N := 1 to LenInput do
begin
pOutput^ := 0;
pOutput^ := byte( (AtBin[pInput[0]] shl 7) or
(AtBin[pInput[1]] shl 6) or
(AtBin[pInput[2]] shl 5) or
(AtBin[pInput[3]] shl 4) or
(AtBin[pInput[4]] shl 3) or
(AtBin[pInput[5]] shl 2) or
(AtBin[pInput[6]] shl 1) or
AtBin[pInput[7]]
);
inc(pInput, 8);
inc(pOutput);
end;
end;