Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2002.02.21;
Скачать: [xml.tar.bz2];

Вниз

Как сохранить ветку системного реестр в файл   Найти похожие ветки 

 
antoniz   (2002-02-06 12:16) [0]

Как сохранить ветку системного реестр в файл с расширением reg под ОС Windows NT или Windows 2000. Метод SaveKey создает только
пустой файл без содержимого ветки. Желательно пример.


 
Sergii   (2002-02-06 15:48) [1]

Экспортирует ветк, заданную в Path в файл формата Regedit.


procedure ExportBranchToFile(RootKey: HKEY;
Path: string;
Filename: string);

var
Reg: TRegistry;
ExpFile: TextFile;
P: PCHAR; // Buffer for "bynary" data from registry

procedure ProcessBranch(root: string); {recursive sub-procedure}
var
Values, Keys: TStringList;
I, J, K: Integer;
S, T: string; {longstrings are on the heap, not on the stack!}
begin
Writeln(ExpFile); {write blank line}
Writeln(ExpFile, "[" + HKEYToString(RootKey) + "\" + root + "]");

Reg.OpenKey(Root, False);
Values := TStringList.Create;
Keys := TStringList.Create;
Reg.GetValueNames(Values); {get all value names}
Reg.GetKeyNames(Keys); {get all sub-branches}

for I := 0 to Values.Count - 1 do {write all the values first}
begin
S := values[I];
T := S; {s=value name}
if S = "" then
S := "@" {empty means "default value", write as @}
else
S := """ + S + """; {else put in quotes}
Write(ExpFile, DupBackSlash(S) + "=");
{write the name of the key to the file}

case Reg.GetDataType(T) of {What type of data is it?}

rdString, rdExpandString: {String-type}
Writeln(ExpFile, """ + DupBackSlash(Reg.ReadString(T) + """));

rdInteger: {32-bit unsigned long integer}
Writeln(ExpFile, "dword:" + IntToHex(Reg.ReadInteger(T), 8));

{write an array of hex bytes if data is "binary." Perform a line feed
after approx. 25 numbers so the line length stays within limits}

rdBinary:
begin
Write(ExpFile, "hex:");
J := Reg.GetDataSize(T); {determine size}
GetMem(P, J); {Allocate memory}
Reg.ReadBinaryData(T, P^, J); {read in the data, treat as pchar}
for K := 0 to J - 1 do
begin
Write(ExpFile, IntToHex(Byte(p[k]), 2)); {Write byte as hex}
if K <> J - 1 then {not yet last byte?}
begin
Write(ExpFile, ","); {then write Comma}
if (K > 0) and ((K mod 25) = 0) {line too long?} then
Writeln(ExpFile, "\"); {then write Backslash + lf}
end; {if}
end; {for}
FreeMem(P, J); {free the memory}
Writeln(ExpFile); {Linefeed}
end;
else
Writeln(ExpFile, """");
{write an empty string if datatype illegal/unknown}
end; {case}
end; {for}

Reg.CloseKey;

{value names all done, no longer needed}
Values.Free;

{Now al values are written, we process all subkeys}
{Perform this process RECURSIVELY...}
for I := 0 to Keys.Count - 1 do
ProcessBranch(Root + "\" + Keys[I]);

Keys.Free; {this branch is ready}
end;

begin
if Path[Length(Path)] = "\" then {No trailing backslash}
SetLength(Path, Length(Path) - 1);
AssignFile(ExpFile, FileName); {create a text file}
ReWrite(ExpFile);
if IOResult <> 0 then
EXIT;
Writeln(ExpFile, "REGEDIT4"); {"magic key" for regedit}

Reg := TRegistry.Create;
try
Reg.RootKey := RootKey;
ProcessBranch(Path);
{Call the function that writes the branch and all subbranches}
finally
Reg.Free; {ready}
Close(ExpFile);
end;
end;


 
Sergii   (2002-02-06 15:59) [2]

И еще, на всякий случай...

function HKEYToString(Key: HKEY): string;
begin
case Key of
HKEY_CLASSES_ROOT: Result := "HKEY_CLASSES_ROOT";
HKEY_CURRENT_USER: Result := "HKEY_CURRENT_USER";
HKEY_LOCAL_MACHINE: Result := "HKEY_LOCAL_MACHINE";
HKEY_USERS: Result := "HKEY_USERS";
HKEY_PERFORMANCE_DATA: Result := "HKEY_PERFORMANCE_DATA";
HKEY_CURRENT_CONFIG: Result := "HKEY_CURRENT_CONFIG";
HKEY_DYN_DATA: Result := "HKEY_DYN_DATA";
end; {case}
end;



Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2002.02.21;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.45 MB
Время: 0.004 c
1-66612
dim2001
2002-02-04 23:19
2002.02.21
как сделать shareware-версию программы


6-66639
Lamok
2001-11-29 23:40
2002.02.21
Socket


1-66589
IgoX
2002-02-05 20:37
2002.02.21
Почему так происходит


14-66666
MJH
2002-01-02 11:07
2002.02.21
чё все в ауте уже? то в новогоднюю ночь пишут, то вечером 2го никого нет....


14-66647
Pat
2001-12-28 13:47
2002.02.21
Преподы прикалываются...





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский