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;

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

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.