Как показать информацию AutoRun

Код приложения:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, registry, ShlObj, ActiveX;

const
IID_IPersistFile: TGUID =
  (D1:$0000010B;D2:$0000;D3:$0000;D4:($C0,$00,$00,$00,$00,$00,$00,$46));

type
  TForm1 = class(TForm)
    TreeView1: TTreeView;
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

  procedure AddWinINICalls(Tree: TTreeView);
  procedure AddAllFilesToRunView(Hndl: THandle; Tree: TTreeView;
        MainKey, MiddleKey, EndKey: String);
  procedure AddAllRegToRunView(Tree: TTreeView; MainKey, MiddleKey: String); 
  procedure AddRegToRunView(Tree: TTreeView; MainKey, MiddleKey, EndKey: String); 
  procedure ShowAutoRunInformation(Hndl: THandle; TreeView: TTreeView);
  function  GetLinkInfo(WinhWnd: HWND; LnkObj: string): String;

implementation

{$R *.dfm}

procedure TForm1.FormShow(Sender: TObject);
begin
  TreeView1.Items.BeginUpdate; 
  TreeView1.Items.Clear;
  ShowAutoRunInformation(Form1.Handle,TreeView1); 
  TreeView1.FullExpand; 
  TreeView1.Items.EndUpdate;
end;

procedure ShowAutoRunInformation(Hndl:THandle;TreeView:TTreeView); 
begin
  AddRegToRunView(TreeView, 'HKEY_LOCAL_MACHINE',
      '\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon', 'Userinit');
  AddAllRegToRunView(TreeView, 'HKEY_LOCAL_MACHINE', 
      '\SOFTWARE\Microsoft\Windows\CurrentVersion\RunOnce'); 
  AddAllRegToRunView(TreeView,'HKEY_LOCAL_MACHINE', 
      '\SOFTWARE\Microsoft\Windows\CurrentVersion\RunOnceEx'); 
  AddRegToRunView(TreeView,'HKEY_CURRENT_USER', 
      '\Software\Microsoft\Windows NT\CurrentVersion\Windows', 'Run'); 
  AddAllRegToRunView(TreeView, 'HKEY_LOCAL_MACHINE', 
      '\SOFTWARE\Microsoft\Windows\CurrentVersion\Run'); 
  AddAllRegToRunView(TreeView, 'HKEY_CURRENT_USER',
      '\Software\Microsoft\Windows\CurrentVersion\Run'); 
  AddAllFilesToRunView(Hndl, TreeView, 'HKEY_LOCAL_MACHINE', 
      '\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders',
      'Common Startup'); 
  AddAllFilesToRunView(Hndl,TreeView, 'HKEY_LOCAL_MACHINE', 
      '\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders',
      'Common AltStartup'); 
  AddAllFilesToRunView(Hndl, TreeView, 'HKEY_CURRENT_USER', 
      '\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders',
      'Startup'); 
  AddRegToRunView(TreeView,'HKEY_LOCAL_MACHINE', 
      '\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Windows', 'Load'); 
  AddRegToRunView(TreeView,'HKEY_CURRENT_USER',
      '\Software\Microsoft\Windows NT\CurrentVersion\Windows', 'Load'); 
  AddAllRegToRunView(TreeView, 'HKEY_LOCAL_MACHINE', 
      '\SOFTWARE\Microsoft\Windows\CurrentVersion\RunServices'); 
  AddAllRegToRunView(TreeView, 'HKEY_LOCAL_MACHINE', 
      '\SOFTWARE\Microsoft\Windows\CurrentVersion\RunServicesOnce'); 
  AddAllRegToRunView(TreeView, 'HKEY_CURRENT_USER', 
      '\Software\Microsoft\Windows\CurrentVersion\RunServices');
  AddAllRegToRunView(TreeView, 'HKEY_CURRENT_USER', 
      '\Software\Microsoft\Windows\CurrentVersion\RunServicesOnce'); 
  AddRegToRunView(TreeView, 'HKEY_CURRENT_USER',
      '\Software\Microsoft\Windows NT\CurrentVersion\Winlogon',
      'Userinit'); 
  AddAllRegToRunView(TreeView, 'HKEY_CURRENT_USER', 
      '\Software\Microsoft\Windows\CurrentVersion\RunOnce'); 
  AddAllRegToRunView(TreeView, 'HKEY_CURRENT_USER', 
      '\Software\Microsoft\Windows\CurrentVersion\RunOnceEx'); 
  AddWinINICalls(TreeView); 
end; 

procedure AddRegToRunView(
        Tree:TTreeView;MainKey,MiddleKey,EndKey:String); 
var
  reg: TRegistry; 
  Node: TTreeNode; 
  s: String; 
begin 
  reg:=TRegistry.Create; 
  try 
    if MainKey = 'HKEY_CURRENT_USER' then
      Reg.RootKey:= HKEY_CURRENT_USER else 
      if MainKey= 'HKEY_LOCAL_MACHINE' then
        Reg.RootKey:= HKEY_LOCAL_MACHINE; 
    if Reg.OpenKeyReadOnly(MiddleKey) then 
      if Reg.ValueExists(EndKey) then begin
        s:= Reg.ReadString(EndKey); 
        if s <> '' then begin 
          Node:= Tree.Items.Add(nil, MainKey+MiddleKey +
                '\' + EndKey); 
          Tree.Items.AddChild(Node, s); 
        end; 
      end; 
  finally 
    Reg.CloseKey; 
    reg.Free; 
  end;
end; 

procedure AddAllRegToRunView(
        Tree:TTreeView;MainKey,MiddleKey:String); 
var 
  reg: TRegistry; 
  Node: TTreeNode; 
  Val: TStringList; 
  n: Integer; 
  s: String; 
begin
  reg:=TRegistry.Create; 
  try 
    if MainKey = 'HKEY_CURRENT_USER' then Reg.RootKey:= HKEY_CURRENT_USER else 
      if MainKey = 'HKEY_LOCAL_MACHINE' then Reg.RootKey:= HKEY_LOCAL_MACHINE; 
    if Reg.OpenKeyReadOnly(MiddleKey) then begin 
      Val:= TStringList.Create; 
      Reg.GetValueNames(Val); 
      if Val.Count > 0 then begin 
        Node:= Tree.Items.Add(nil, MainKey + MiddleKey + '\'); 
        for n:= 0 to Val.Count - 1 do begin
          s:= Reg.ReadString(Val[n]); 
          if s <> '' then Tree.Items.AddChild(Node, s); 
        end; 
      end; 
      Val.Free; 
    end; 
  finally 
    Reg.CloseKey; 
    reg.Free; 
  end;
end; 

procedure AddAllFilesToRunView(
        Hndl: THandle; Tree: TTreeView; MainKey, MiddleKey, EndKey: String); 
var 
  reg: TRegistry; 
  Node: TTreeNode; 
  s: String; 
  sr: TSearchRec; 
begin 
  reg:= TRegistry.Create;
  try 
    if MainKey = 'HKEY_CURRENT_USER' then Reg.RootKey:= HKEY_CURRENT_USER else 
      if MainKey = 'HKEY_LOCAL_MACHINE' then Reg.RootKey:= HKEY_LOCAL_MACHINE; 
    if Reg.OpenKeyReadOnly(MiddleKey) then 
      if Reg.ValueExists(EndKey) then begin 
        s:= Reg.ReadString(EndKey); 
        if FindFirst(s + '\*.*', $00, sr) = 0 then begin 
          Node:= Tree.Items.Add(nil, s); 
          Tree.Items.AddChild(Node, sr.Name + ' -> '+ 
            GetLinkInfo(Hndl, s + '\' + sr.Name));
          while FindNext(sr) = 0 do 
            Tree.Items.AddChild(Node, sr.Name + ' -> '+ 
              GetLinkInfo(Hndl, s + '\' + sr.Name)); 
          FindClose(sr); 
        end; 
      end; 
  finally 
    Reg.CloseKey; 
    reg.Free; 
  end;
end; 

procedure AddWinINICalls(Tree: TTreeView); 
var 
  Path         : array[0..MAX_PATH] of Char; 
  sL,sR        : String; 
  Node         : TTreeNode; 
  List         : TStringList; 
  n,n1         : Integer; 
begin
  GetWindowsDirectory(Path, SizeOf(Path)); 
  if NOT FileExists(Path + '\WIN.INI') then exit; 
  List:= TStringList.create; 
  List.LoadFromFile(Path + '\WIN.INI'); 
  sL:= ''; 
  sR:= ''; 
  for n:= 0 to List.count - 1 do if UpperCase(List[n]) = '[WINDOWS]' then break; 
  for n1:= n + 1 to List.count - 1 do begin 
    if copy(List[n1], 1, 1) = '[' then break; 
    if copy(UpperCase(List[n1]), 1, length('RUN=')) = 'RUN=' then sR:= List[n1];
    if copy(UpperCase(List[n1]), 1, length('LOAD=')) = 'LOAD=' then sL:= List[n1]; 
  end; 
  list.Free; 
  if ((sL = '') AND (sR = '')) then exit; 
  Node:= Tree.Items.Add(nil,Path + '\WIN.INI'); 
  if sL <> '' then Tree.Items.AddChild(Node, sL); 
  if sR <> '' then Tree.Items.AddChild(Node, sR); 
end; 

function GetLinkInfo(
        WinhWnd: HWND; LnkObj: string): String;
var 
  hres         : HRESULT; 
  psl          : IShellLink; 
  ppf          : IPersistFile; 
  wfd          : Win32_Find_Data; 
  Path         : array[0..MAX_PATH] of Char; 
begin 
  result := '????'; 
  // Инициализация библиотеки Component Object Model(COM)
  CoInitialize(nil);
  // Вызов CoCreateInstance чтобы получить указатель на IShellLink Interface
  hres:= CoCreateInstance(CLSID_ShellLink, nil, 
                              CLSCTX_INPROC_SERVER, IID_IShellLinkA, psl); 
  if NOT SUCCEEDED(hres) then exit; 
  // IShellLink Interface поддерживает интерфейс IPersistFile 
  // Получаем указатель на него. 
  hres:= psl.QueryInterface(IID_IPersistFile, ppf); 
  if SUCCEEDED(hres) then begin 
    // Преобразовываем строку 
    // и загружаем файл.
    hres:= ppf.Load(StringToOLEStr(LnkObj), STGM_READ); 
    if SUCCEEDED(hres) then begin 
      hres:= psl.Resolve(WinhWnd, SLR_ANY_MATCH OR SLR_NO_UI); 
      if SUCCEEDED(hres) then begin 
        hres:= psl.GetPath(Path, MAX_PATH, wfd, SLGP_SHORTPATH); 
        if SUCCEEDED(hres) then result:= Path; 
      end; 
    end; 
  end;
end; 

end.