импорт файла реестра

[bogus]

необходимо програмно сделать импорт файла реестра, без сообщения об этом пользователю. Желательно через regEdit. Можно и другие варианты

[LAngel]

интересная задачка...
парсинг много места убил, а так - все довольно просто:
импорт рег.файлов версии REGEDIT4. Имя файла передается в качество параметра.

Код: Выделить всё

program RegImport;
uses
  Classes, Registry, SysUtils, Windows, StrUtils, Dialogs;
Var
  Reg: TStringList;
  Line: Integer;
  S: String;
  WinReg: TRegistry;
  procedure ProcessSection(Open: Boolean=True);
  begin
    if Open then
    begin
      S := copy(S, 2, Length(S)-2);
      WinReg := TRegistry.Create;
      if pos('HKEY_CURRENT_USER', UpperCase(S)) = 1 then WinReg.RootKey := HKEY_CURRENT_USER;
      if pos('HKEY_LOCAL_MACHINE', UpperCase(S)) = 1 then WinReg.RootKey := HKEY_LOCAL_MACHINE;
      if pos('HKEY_USERS', UpperCase(S)) = 1 then WinReg.RootKey := HKEY_USERS;
      if pos('HKEY_PERFORMANCE_DATA', UpperCase(S)) = 1 then WinReg.RootKey := HKEY_PERFORMANCE_DATA;
      if pos('HKEY_CURRENT_CONFIG', UpperCase(S)) = 1 then WinReg.RootKey := HKEY_CURRENT_CONFIG;
      if pos('HKEY_DYN_DATA', UpperCase(S)) = 1 then WinReg.RootKey := HKEY_DYN_DATA;
      if pos('HKEY_CLASSES_ROOT', UpperCase(S)) = 1 then WinReg.RootKey := HKEY_CLASSES_ROOT;
      S := copy(S, pos('\', S), Length(S)-pos('\', S)+1);
      WinReg.OpenKey(S, True);
    end else WinReg.Free;
  end;
  procedure ProceedLine;
    function HexToInt(S: String): Integer;
    Var i: Integer;
    begin
      Result := 0;
      for i := 1 to Length(S) do
      case S[i] of
        '0'..'9' : Result := Result * 16 + StrToInt(S[i]);
        'A'..'F' : Result := Result * 16 + 10 + ord(S[i])-ord('A');
        'a'..'f' : Result := Result * 16 + 10 + ord(S[i])-ord('a');
      end;
    end;
  var KeyName: String;
      KeyVal: String;
      KeyType: String;
      i: Integer;
  begin
    KeyName := copy(S, 1, pos('=', S)-1);
    KeyName := copy(KeyName, 2, Length(KeyName)-2);
    S := copy(S, pos('=', S)+1, Length(S)-pos('=', S));
    if (S[1] = '"') and (S[Length(S)] = '"') then
    begin
      KeyType := 'STRING';
      S := copy(S, 2, Length(S)-2);
      KeyVal := '';
      for i := 1 to Length(S) do
      if not (S[i] in ['\', '"']) then KeyVal := KeyVal + S[i]
      else if S[i+1] = '"' then KeyVal := KeyVal + '"'
      else if S[i+1] = '\' then KeyVal := KeyVal + '\';
    end else if pos('DWORD:', UpperCase(S))=1 then
    begin
      KeyType := 'DWORD';
      KeyVal := IntToStr(HexToInt(copy(S, 7, Length(S)-6)));
    end else if pos('HEX:', UpperCase(S))=1 then
    begin
      KeyType := 'HEX';
      KeyVal := ''; S := copy(S, 5, Length(S)-4);
      while Length(S) > 1 do
      begin
        KeyVal := KeyVal + chr(HexToInt(LeftStr(S, 2)));
        if S[3] = ',' then S := RightStr(S, Length(S)-3) else S := '@';
      end;
    end;
    Case KeyType[1] of
      'S' : WinReg.WriteString(KeyName, KeyVal);
      'D' : WinReg.WriteInteger(KeyName, StrToInt(KeyVal));
      'H' : WinReg.WriteBinaryData(KeyName, KeyVal[1], Length(KeyVal));
    end;
  end;
begin
  If ParamCount = 0 then ShowMessage('Отсутствует необходимый параметр.')
  else if not FileExists(ParamStr(1)) then ShowMessage('Файл не существует.')
  else begin
    Reg := TStringList.Create;
    try
      Reg.LoadFromFile(ParamStr(1));
      Line := 0;
      while Line+1 <= Reg.Count do
      begin
        S := Trim(Reg.Strings[Line]);
        if S = '' then else
        if (pos('[', S) = 1) and (pos(']', S) = Length(S))
        then begin
          ProcessSection;
          while (S <> '') and (Line+1 <= Reg.Count) do
          begin
            inc(Line);
            S := Trim(Reg.Strings[Line]);
            if (S <> '') and (S[Length(S)] = '\') then
              while S[Length(S)] = '\' do
              begin
                inc(Line);
                S := LeftStr(S, Length(S)-1);
                S := S + Trim(Reg.Strings[Line]);
              end;
            if (S <> '') and (S[1] <> '[') then ProceedLine;
          end;
          ProcessSection(False);
        end;
        inc(Line);
      end;
    finally
      Reg.Free;
    end;
  end;
end.