Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2006.08.20;
Скачать: CL | DM;

Вниз

Как прочитать "мультистроковый параметр" с регистра.   Найти похожие ветки 

 
slaga ©   (2006-07-07 18:43) [0]

Добрый день, вопрос собственно: Как прочитать "мультистроковый параметр" с регистра.

Тоесть TMP := Reg.ReadString("Tools") не подходит,

ругается "Invalid data type for "Tools".

Как правильно ?


 
slaga ©   (2006-07-07 18:56) [1]

сделал вот так, но незнаю как получить дальше строки из буфера

var Reg: TRegistry;
    XMLstring: TStrings;
    Size: integer;
    Buffer: Pointer;
begin
  Reg := TRegistry.Create;
  try
   Reg.RootKey := HKEY_LOCAL_MACHINE;
   if Reg.OpenKey("SOFTWARE\Welcash\ScanerFrnt\Tools", False) then
    Reg.ReadBinaryData("Tools.xml", Buffer, Reg.GetDataSize("Tools.xml"));


 
PSPF2003 ©   (2006-07-07 19:31) [2]

Если я правильно понял мультистроковый это StringList?
Есть примерчик который показывает список введенных адресов в IE

private
 ValueNames : TStrings;

procedure LoadValues;
var
 Reg : TRegistry;
 Index  : Integer;
begin
 Reg  := TRegistry.Create;
 try
 if Reg.OpenKey("\SOFTWARE\Microsoft\Internet Explorer\TypedURLs", FALSE) then
   begin
    Reg.GetValueNames(ValueNames);
     for Index := 0 to ValueNames.Count -1 do
     begin
   CurrentList.Items.Add(Reg.ReadString(ValueNames.Strings[Index]));
     end;
   end
   else
   begin
  MessageDlg("Windows registry error, continue not possible", mtError, [mbOK], 0);
     OkButton.Enabled := FALSE;
   end;
 finally
   Reg.Free;
 end;
end

Могу дать весь пример.


 
Gero ©   (2006-07-07 19:34) [3]

procedure TGrRegistry.ReadMultiString(const Name: string; List: TStrings);
var
 BufSize: DWORD;
 DataType: TGrRegDataType;
 i: Integer;
 Buffer: PChar;
 S: string;
begin
 BufSize := GetDataSize(Name);
 if BufSize < 1 then Exit;
 Buffer := AllocMem(BufSize);
  try
    if Buffer = nil then Exit;
    DataType := REG_NONE;
    if RegQueryValueEx(CurrentKey, PChar(Name), nil, @DataType, PByte(Buffer), @BufSize) <> ERROR_SUCCESS then
      raise ERegistryException.CreateResFmt(@SRegGetDataFailed, [Name]);
    if DataType <> REG_MULTI_SZ then
      raise ERegistryException.CreateResFmt(@SInvalidRegType, [Name]);
    List.Clear;
    S := "";
    for i := 0 to BufSize - 2 do
      begin
        if Buffer[i] = #0 then
          begin
            List.Add(S);
            S := "";
          end { if }
        else
          S := S + Buffer[i];
    end; { for }
  finally
    FreeMem(Buffer);
  end; { try..finally }
end;


 
Gero ©   (2006-07-07 19:35) [4]

Да, TGrRegistry = class(TRegistry)


 
slaga ©   (2006-07-10 10:31) [5]

Спасибо за помощь но:

to PSPF2003: мне не надо получить значения всех ключей в одной папке,
мне нужно получить значения одного ключа который содержит набор строк.

to Gero: возможно я что-то не то делаю, но у меня все строки выдаются как Buffer[i] = #0.

Что можите посоветовать еще ?


 
Чапаев ©   (2006-07-10 13:30) [6]

unit RegistryEx;

interface

uses
 Registry,
 Classes;

type
 TRegDataTypeEx = (rdUnknown, rdString, rdExpandString, rdInteger, rdBinary, rdMultiString);

 TRegistryEx=class(TRegistry)
 protected
   function GetDataEx(const Name: string; Buffer: Pointer;
     BufSize: Integer; var RegData: TRegDataTypeEx): Integer;
   procedure PutDataEx(const Name: string; Buffer: Pointer;
     BufSize: Integer; RegData: TRegDataTypeEx);
 public
   function ReadMultiString(const Name:string):string;overload;
   procedure ReadMultiString(const Name:string; const Result:TStrings);overload;
   procedure WriteMultiString(const Name,Value:string);overload;
   procedure WriteMultiString(const Name:string; const Value:TStrings);overload;
 end;

implementation

uses
 Windows,
 RtlConsts,
 SysUtils;

procedure ReadError(const Name: string);
begin
 raise ERegistryException.CreateResFmt(@SInvalidRegType, [Name]);
end;

function DataTypeToRegDataEx(Value: Integer): TRegDataTypeEx;
begin
 if Value = REG_SZ then Result := rdString
 else if Value = REG_EXPAND_SZ then Result := rdExpandString
 else if Value = REG_DWORD then Result := rdInteger
 else if Value = REG_BINARY then Result := rdBinary
 else if Value = REG_MULTI_SZ then Result:=rdMultiString      
 else Result := rdUnknown;
end;

function RegDataToDataTypeEx(Value: TRegDataTypeEx): Integer;
begin
 case Value of
   rdString: Result := REG_SZ;
   rdExpandString: Result := REG_EXPAND_SZ;
   rdInteger: Result := REG_DWORD;
   rdBinary: Result := REG_BINARY;
   rdMultiString: Result:=REG_MULTI_SZ;
 else
   Result := REG_NONE;
 end;
end;

{ TRegistryEx }

function TRegistryEx.ReadMultiString(const Name: string): string;
var
 Len,I: Integer;
 RegData: TRegDataTypeEx;
 Buf:PChar;
begin
 Len := GetDataSize(Name);
 if Len > 0 then
 begin
   Buf:=StrAlloc(Len);
   GetDataEx(Name, Buf, Len, RegData);
   for I := 0 to Len-2 do
     if Buf[I]=#0
       then Result:=Result+#13#10
       else Result:=Result+Buf[I];
   StrDispose(Buf);      
 end
 else Result := "";
end;

procedure TRegistryEx.WriteMultiString(const Name, Value: string);
var
 S:TStringList;
begin
 S:=TStringList.Create;
 S.Text:=Value;
 WriteMultiString(Name,S);
 S.Free;
end;

function TRegistryEx.GetDataEx(const Name: string; Buffer: Pointer;
 BufSize: Integer; var RegData: TRegDataTypeEx): Integer;
var
 DataType: Integer;
begin
 DataType := REG_NONE;
 if RegQueryValueEx(CurrentKey, PChar(Name), nil, @DataType, PByte(Buffer),
   @BufSize) <> ERROR_SUCCESS then
   raise ERegistryException.CreateResFmt(@SRegGetDataFailed, [Name]);
 Result := BufSize;
 RegData := DataTypeToRegDataEx(DataType);
end;

procedure TRegistryEx.PutDataEx(const Name: string; Buffer: Pointer;
 BufSize: Integer; RegData: TRegDataTypeEx);
var
 DataType: Integer;
begin
 DataType := RegDataToDataTypeEx(RegData);
 if RegSetValueEx(CurrentKey, PChar(Name), 0, DataType, Buffer,
   BufSize) <> ERROR_SUCCESS then
   raise ERegistryException.CreateResFmt(@SRegSetDataFailed, [Name]);
end;

procedure TRegistryEx.ReadMultiString(const Name: string;
 const Result: TStrings);
begin
 Result.Text:=ReadMultiString(Name);
end;

procedure TRegistryEx.WriteMultiString(const Name: string;
 const Value: TStrings);
var
 Buf:PChar;
 Len,CurLen,L,I:Integer;
begin
 Len:=1;
 for I := 0 to Value.Count - 1 do
   Len:=Len+Length(Value[I])+1;
 Buf:=StrAlloc(Len);
 FillChar(Buf[0],Len,0);
 CurLen:=0;
 for I := 0 to Value.Count - 1 do begin
   L:=Length(Value[I]);
   Move(Value[I][1],Buf[CurLen],L);
   CurLen:=CurLen+L+1;
 end;
 PutDataEx(Name,@Buf[0],Len,rdMultiString);
 StrDispose(Buf);
end;

end.



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

Текущий архив: 2006.08.20;
Скачать: CL | DM;

Наверх




Память: 0.5 MB
Время: 0.048 c
3-1150286095
Nicky
2006-06-14 15:54
2006.08.20
Как написать код, чтобы открывался файл справки при инсталляции п


15-1153407874
Exception
2006-07-20 19:04
2006.08.20
Пошлость или искусство?


15-1153820130
Ling
2006-07-25 13:35
2006.08.20
Помогите найти


15-1153739936
Gydvin
2006-07-24 15:18
2006.08.20
Отдых в Баян-ауле


2-1154348555
Neket
2006-07-31 16:22
2006.08.20
IdSNMP1