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

Вниз

Поиск в подключенном реестре   Найти похожие ветки 

 
nivea ©   (2008-01-14 17:29) [0]

Доброго времени суток.

Итак, у меня есть прога написанная на Делфи.

Она имеет способность искать определенную инфу в нужных ветках и выдавать эту ифну на экран.
Так же в ней есть вкладка, где можно осуществлять обычные поиск по реестру.
Реализовано через технологию TRegistry (Tregisters, TReg).

Дак вот, высад в том, что она ищет всю инфу в текущем реестре. Т.е. в реестре винды, под которой мы сидим.
А моя-то основная цель, это написать такую прогу, которая бы искала, как раз не в текущеем активном реестре, а в выбранных файлах реестра.
пока не нашел как инструментом TRegistry подключать файл другого реестра и искать в нем. Мне подсказали, что возможно есть модуль уже написанный (хз на чем)
который умеет переключаться на другой реестр (загружать другой реестр, загржуать файл другого реестра, другой винды) распознавать структуру. И уже там искать нужные параметры.

Вот, найти нужно возможность подключения файла реестра. поиска в нем.
могу выложить сурсы проги если надо.
Заранее спасибо


 
nivea ©   (2008-01-14 17:30) [1]

1 Часть
unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, registry, StdCtrls, ComCtrls, ExtCtrls, ImgList;

type
   TUsbItem = class(TObject)
       id1:string;
       id2:string;
       DeviceDescr:String;
       LocationInformation:string;
       ClassGUID:string;
       _Class:string;
       Driver:string;
       Mfg:string;
       Service:string;
end;

type
 TForm1 = class(TForm)
   PageControl2: TPageControl;
   TabSheet3: TTabSheet;
   TabSheet4: TTabSheet;
   Panel1: TPanel;
   PageControl1: TPageControl;
   TabSheet1: TTabSheet;
   ListView1: TListView;
   TabSheet2: TTabSheet;
   Memo1: TMemo;
   Panel2: TPanel;
   Label1: TLabel;
   Edit1: TEdit;
   Label2: TLabel;
   ComboBox1: TComboBox;
   Label3: TLabel;
   Edit2: TEdit;
   Label4: TLabel;
   ProgressBar1: TProgressBar;
   Button1: TButton;
   PageControl3: TPageControl;
   TabSheet5: TTabSheet;
   TabSheet6: TTabSheet;
   Memo2: TMemo;
   Panel3: TPanel;
   Button2: TButton;
   ListView2: TListView;
   ImageList1: TImageList;
   Memo3: TMemo;
   save: TButton;
   print: TButton;
   SaveDialog1: TSaveDialog;
   PrintDialog1: TPrintDialog;
   RichEdit1: TRichEdit;
   procedure Button1Click(Sender: TObject);
   procedure FormKeyDown(Sender: TObject; var Key: Word;
     Shift: TShiftState);
   procedure FormCreate(Sender: TObject);
   procedure Button2Click(Sender: TObject);
   procedure FormClose(Sender: TObject; var Action: TCloseAction);
   procedure ListView2Click(Sender: TObject);
   procedure saveClick(Sender: TObject);
   procedure printClick(Sender: TObject);

 private
   { Private declarations }
 public
   procedure FindTextInRegistry(r:TRegistry; text:string);
   procedure FindUSBInRegistry(r:TRegistry; text:string; level: integer; usb_list_data:TList;num_item:integer);
   procedure StopSearch();
   function generateTXT():TStringList;
   { Public declarations }
 end;

var
 Form1: TForm1;
 reg:TRegistry;
 stop:boolean;
 start_scan_vid:boolean=false;
 start_get_vid_params:boolean=false;

 ccs_enum_usb_list:Tlist;
 num_item:integer=0;
 item: TUsbItem;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
ccs_enum_usb_list:=TList.Create;

stop:=false;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
ccs_enum_usb_list.Free;
end;

//######################################################

procedure TForm1.Button1Click(Sender: TObject);
begin
if (edit1.text<>"") AND (edit2.text<>"") then
   begin
   Button1.Enabled:=false;

   memo1.lines.add("Start");
   reg:=TRegistry.Create();
   reg.RootKey:=LongWord(ComboBox1.ItemIndex)+$80000000;

   ProgressBar1.Position:=0;
   ProgressBar1.Max:=1000;

   FindTextInRegistry(reg,"\"+Edit2.text);

   ProgressBar1.Position:=ProgressBar1.max;

   stop:=false;

   reg.Free;
   end;
end;

procedure TForm1.FindTextInRegistry(r: TRegistry; text: string);
var
 i: integer;
 Keys: TStringList;
 s:string;

 li:TListItem;
begin
if (stop) then
   begin
   StopSearch();
   exit;
   end;

Keys := TStringList.Create;
r.OpenKey(text, False);
r.GetValueNames(Keys);

for i := 0 to Keys.Count - 1 do
   begin
   if (stop) then break;
   
   memo1.lines.Add(Keys.Strings[i]);

   if (pos(edit1.text, Keys.Strings[i])>0) OR (pos(LowerCase(edit1.text), LowerCase(Keys.Strings[i]))>0) then
       begin
       li:=ListView1.Items.Add;
       li.Caption:=Keys.Strings[i];
       li.SubItems.Add(text)
       end;
   end;

r.GetKeyNames(Keys);
r.CloseKey;

for i := 0 to Keys.Count - 1 do
   begin
   if (stop) then break;

   s:=text + "\" + Keys.Strings[i] + "\";
   s:=StringReplace(s,"\\","\",[rfReplaceAll]);
   memo1.lines.Add("[" + s + "]");

   Application.ProcessMessages;
   ProgressBar1.Position:=ProgressBar1.Position+1;
   if (ProgressBar1.Position=ProgressBar1.max) then ProgressBar1.Position:=0;

   FindTextInRegistry(r, s );
   Application.ProcessMessages;
   end;

keys.Free;
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
 Shift: TShiftState);
begin
if key=VK_ESCAPE then
 begin
 stop:=true;
 StopSearch();
 end;
end;

procedure TForm1.StopSearch();
begin
Button1.Enabled:=true;
end;


 
nivea ©   (2008-01-14 17:31) [2]

2 часть
//##############################################################################
//##############################################################################

procedure TForm1.FindUSBInRegistry(r: TRegistry; text: string; level: integer; usb_list_data:TList; num_item:integer);
var
 i: integer;
 Keys: TStringList;
 s:string;

begin
if (r.OpenKey(text, False)) then
   begin
   Keys := TStringList.Create;
   r.GetValueNames(Keys);

   for i := 0 to Keys.Count - 1 do
       begin
       memo2.lines.Add(Keys.Strings[i]);
       if (level=3) AND not start_scan_vid AND start_get_vid_params then
           begin

               try
               if (item<>nil) then
                   begin
                   if (Keys.Strings[i]="DeviceDescr") then         item.DeviceDescr:=r.ReadString(Keys.Strings[i]);
                   if (Keys.Strings[i]="LocationInformation") then item.LocationInformation:=r.ReadString(Keys.Strings[i]);
                   if (Keys.Strings[i]="ClassGUID") then           item.ClassGUID:=r.ReadString(Keys.Strings[i]);
                   if (Keys.Strings[i]="Class") then               item._Class:=r.ReadString(Keys.Strings[i]);
                   if (Keys.Strings[i]="Driver") then              item.Driver:=r.ReadString(Keys.Strings[i]);
                   if (Keys.Strings[i]="Mfg") then                 item.Mfg:=r.ReadString(Keys.Strings[i]);
                   if (Keys.Strings[i]="Service") then             item.Service:=r.ReadString(Keys.Strings[i]);
                   end;

               except
               end;

           end;
       end;

   if (item<>nil) AND (level=3) AND not start_scan_vid AND start_get_vid_params then
       begin
       start_get_vid_params:=false;
       usb_list_data.Add(item);
       end;

   r.GetKeyNames(Keys);
   r.CloseKey;

   for i := 0 to Keys.Count - 1 do
       begin
       s:=text + "\" + Keys.Strings[i] + "\";
       s:=StringReplace(s,"\\","\",[rfReplaceAll]);
       memo2.lines.Add("[" + s + "]");

       if (level=1) AND (pos("Vid_",Keys.Strings[i])>0) then
           begin
           item:=TUsbItem.Create;
           inc(num_item);

           if (item is TUsbItem) AND (item<>nil) then
               begin
               memo2.lines.add("###"+Keys.Strings[i]+"###");
               start_scan_vid:=true;

               item.id1:=Keys.Strings[i];
               end;
           end;

       if (level=2) AND start_scan_vid then
           begin
              //if item<>nil then
               begin
               memo2.lines.add("@@@"+Keys.Strings[i]+"@@@");
               start_scan_vid:=false;
               start_get_vid_params:=true;

               item.id2:=Keys.Strings[i];
               end;
           end;

       inc(level);
       FindUSBInRegistry(r, s, level, usb_list_data,num_item);
       dec(level);

       Application.ProcessMessages;
       end;

   keys.Free;
   end
       else
   begin
   memo2.lines.add("Ошибка: "+text);
   end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
   r2:TRegistry;
   i:integer;
   li:TListItem;
   s:string;

begin
memo3.Clear;

if (ccs_enum_usb_list.count>0) then
   begin
   for i:=0 to ccs_enum_usb_list.Count-1 do
       TUsbItem(ccs_enum_usb_list.items[i]).Free;

   ccs_enum_usb_list.Clear;
   end;

ccs_enum_usb_list:=TList.Create;
if (ListView2.Items.Count>0) then
   begin
   {for i:=0 to ListView2.Items.Count-1 do
       if (listview2.items.Item[i].Data<>nil) then
           TUsbItem(listview2.items.Item[i].Data).free;}

   ListView2.Items.Clear;
   end;

r2:=TRegistry.Create;
r2.RootKey:=HKEY_LOCAL_MACHINE;
r2.Access:=KEY_READ;

FindUSBInRegistry(r2,"\SYSTEM\CurrentControlSet\Enum\USB",1, ccs_enum_usb_list, num_item);

for i:=0 to ccs_enum_usb_list.Count-1 do
   begin
   li:=ListView2.Items.add;

   s:="";
   if (TUsbItem(ccs_enum_usb_list.Items[i]).LocationInformation<>"") then
     s:=TUsbItem(ccs_enum_usb_list.Items[i]).LocationInformation
   else
     s:=TUsbItem(ccs_enum_usb_list.Items[i]).mfg;

   li.Caption:=s;
   li.Data:=ccs_enum_usb_list.Items[i];
   end;

r2.free;

if (ccs_enum_usb_list.Count>0) then
 begin
 print.Enabled:=true;
 save.Enabled:=true;
 end;
end;

procedure TForm1.ListView2Click(Sender: TObject);
var
   usbitem:tusbitem;
begin
if (listview2.items.count>0) then
   begin
   if (ListView2.Selected<>nil) then
       begin
       usbitem:=TUsbItem(ListView2.Selected.Data);
       memo3.Clear;
       memo3.lines.add("ID: "+usbitem.id1+"\"+usbitem.id2);
       memo3.lines.add("DeviceDescr: "+usbitem.DeviceDescr);
       memo3.lines.add("LocationInformation: "+usbitem.LocationInformation);
       memo3.lines.add("ClassGUID: "+usbitem.ClassGUID);
       memo3.lines.add("Class: "+usbitem._Class);
       memo3.lines.add("Driver: "+usbitem.Driver);
       memo3.lines.add("Mfg: "+usbitem.Mfg);
       memo3.lines.add("Service: "+usbitem.Service);
       end;
   end;
end;

procedure TForm1.saveClick(Sender: TObject);
var

 txt:TStringList;

begin
if (SaveDialog1.Execute) then
 begin
 txt:=generateTXT();
 txt.SaveToFile(SaveDialog1.FileName);
 txt.free;
 end;
end;

function TForm1.generateTXT:TStringList;
var
 txt:TStringList;
 i:integer;
  s:string;
begin
 txt:=TStringList.Create;

 for i:=0 to ccs_enum_usb_list.Count-1 do
     begin
     s:="";
     if (TUsbItem(ccs_enum_usb_list.Items[i]).LocationInformation<>"") then
       s:=TUsbItem(ccs_enum_usb_list.Items[i]).LocationInformation
     else
       s:=TUsbItem(ccs_enum_usb_list.Items[i]).mfg;

     txt.add("["+s+"]");
     txt.add("Class: "+TUsbItem(ccs_enum_usb_list.Items[i])._Class);
     if (TUsbItem(ccs_enum_usb_list.Items[i]).Service<>"") then txt.add("Service: "+TUsbItem(ccs_enum_usb_list.Items[i]).Service);
     if (TUsbItem(ccs_enum_usb_list.Items[i]).DeviceDescr<>"") then txt.add("DeviceDescr: "+TUsbItem(ccs_enum_usb_list.Items[i]).DeviceDescr);
     txt.add("ClassGUID: "+TUsbItem(ccs_enum_usb_list.Items[i]).ClassGUID);
     txt.add("Driver: "+TUsbItem(ccs_enum_usb_list.Items[i]).Driver);
     txt.add("Mfg: "+TUsbItem(ccs_enum_usb_list.Items[i]).Mfg);
     if (i<ccs_enum_usb_list.Count) then begin txt.add("----------------------------------------------");txt.add("");end;
     end;

result:=txt;
end;

procedure TForm1.printClick(Sender: TObject);
begin
if (PrintDialog1.Execute) then
 begin
 RichEdit1.Lines.Text:=generateTXT.Text;
 RichEdit1.Print("USB Devices List");
 end;
end;

end.


 
Сергей М. ©   (2008-01-15 08:33) [3]


> найти нужно возможность подключения файла реестра


А что ее искать ?
Она прямо перед носом - TRegystry.LoadKey



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

Форум: "WinAPI";
Текущий архив: 2008.11.16;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.5 MB
Время: 0.005 c
15-1221096677
Дуб
2008-09-11 05:31
2008.11.16
Игорь Шевченко - С Днем Рождения, дружище!


2-1223399808
MZG
2008-10-07 21:16
2008.11.16
Помогите пожалуйста с запросом


2-1223539684
aslanbek
2008-10-09 12:08
2008.11.16
Регистрация расширения в реестре


2-1223031850
workbench
2008-10-03 15:04
2008.11.16
выделение текста


6-1193484373
nemo
2007-10-27 15:26
2008.11.16
ошибка при отправке почты через smtp EIdProtocolReplyError





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
Английский Французский Немецкий Итальянский Португальский Русский Испанский