[Vayrus]

Приветствую, по указанной выше ссылке собрал тестовый проект, немного модифицировав, но он так и не заработал, эксперты, ткните плиз носом в ошибки

Код:

unit shellextmain;

interface

uses
  Windows, Forms, StdCtrls, ShellApi, SysUtils, Classes, Controls,
  ComServ, ComObj, ShlObj, ActiveX;

//const
var
  CLSID_MainContextMenu: TGUID;
  ID: String;
    //= '{F169D961-B907-11D0-B8FA-A85800C10000}';//Генерировать уникальный

type
  TMainContextMenu = class( TComObject,
                                IShellExtInit, IContextMenu )
  private
    FFileName: string;
  public
    // IShellExtInit Methods
    // Use a Method Resolution Clause because Initialize is
    // defined as a virtual method in TComObject
    function IShellExtInit.Initialize = ShellInit;
    function ShellInit( Folder: PItemIDList;
                        DataObject: IDataObject;
                        ProgID: HKEY ): HResult; stdcall;

    // IContextMenu Methods
    function QueryContextMenu( Menu: HMENU;
                               Index, CmdFirst, CmdLast,
                               Flags: UINT ): HResult; stdcall;
    function GetCommandString( Cmd, Flags: UINT;
                               Reserved: PUINT; Name: LPSTR;
                               MaxSize: UINT ): HResult; stdcall;
    function InvokeCommand( var CommandInfo: TCMInvokeCommandInfo ):
      HResult; stdcall;
  end;

implementation

uses
  Registry;

{==================================}
{== TFormViewContextMenu Methods ==}
{==================================}

function TMainContextMenu.ShellInit( Folder: PItemIDList;
                                         DataObject: IDataObject;
                                         ProgID: HKEY ): HResult;
var
  Medium: TStgMedium;
  FE: TFormatEtc;
begin
  if DataObject = nil then
  begin
    Result := E_FAIL;
    Exit;
  end;

  with FE do
  begin
    cfFormat := CF_HDROP;
    ptd := nil;
    dwAspect := DVASPECT_CONTENT;
    lindex := -1;
    tymed := TYMED_HGLOBAL;
  end;

  // Transfer the data referenced by the IDataObject reference to
  // an HGLOBAL storage medium in CF_HDROP format.
  Result := DataObject.GetData( FE, Medium );
  if Failed( Result ) then
    Exit;
  try
    // If only one file is selected, retrieve the file name and
    // store it in FileName. Otherwise fail.
    if DragQueryFile( Medium.hGlobal, $FFFFFFFF, nil, 0) = 1 then
    begin
      SetLength( FFileName, MAX_PATH );
      DragQueryFile( Medium.hGlobal, 0, PChar(FFileName), MAX_PATH);
      Result := NOERROR;
    end
    else
      Result := E_FAIL;
  finally
    ReleaseStgMedium( Medium );
  end;
end;

function TMainContextMenu.QueryContextMenu( Menu: HMENU;
                   Index, CmdFirst, CmdLast, Flags: UINT ): HResult;
var
  MenuText: string;
  AddMenuItem: Boolean;
begin
  AddMenuItem := True;
  if ( Flags and $000F ) = CMF_NORMAL then
    MenuText := 'Сканировать с помощью UnMaskFile'
  else if ( Flags and CMF_VERBSONLY ) <> 0 then
    MenuText := 'Сканировать с помощью UnMaskFile'
  else if ( Flags and CMF_EXPLORE ) <> 0 then
    MenuText := 'Сканировать с помощью UnMaskFile'
  else
    AddMenuItem := False;

  if AddMenuItem then
  begin
    InsertMenu( Menu, Index, mf_String or mf_ByPosition,
                CmdFirst, PChar( MenuText ) );
    Result := 1;            // Return number of menu items added
  end
  else
    Result := NOERROR;
end; {= TMainContextMenu.QueryContextMenu =}

function TMainContextMenu.GetCommandString( Cmd, Flags: UINT;
  Reserved: PUINT; Name: LPSTR; MaxSize: UINT ): HResult;
begin
  case Cmd of
    0:
    begin
      if Flags = GCS_HELPTEXT then
      begin
        // Return the string to be displayed in the Explorer
        // status bar when the menu item is selected
        StrCopy(Name, 'Сканировать выбранные файлы с помощью UnMaskFile');
      end;
      Result := NOERROR;
    end;

    else                                    // Invalid menu item
      Result := E_INVALIDARG;
  end;
end; {= TMainContextMenu.GetCommandString =}


function GetViewerPath: string;
var
  R: TRegIniFile;
begin
  R := TRegIniFile.Create( '\Software\PAV Team\UnMaskFile' );
  try
    Result := R.ReadString( 'Program', 'Path', '' );
    Result := '"' + Result + '" "%s"';
  finally
    R.Free;
  end;
end;

function GetGUID: string;
var
  R: TRegIniFile;
begin
  R := TRegIniFile.Create( '\Software\PAV Team\UnMaskFile' );
  try
    Result := R.ReadString( 'Program', 'GUID', '' );
    //Result := '"' + Result + '" "%s"';
  finally
    R.Free;
  end;
end;

procedure WriteGUID(Val: String);
var
  R: TRegIniFile;
begin
  R := TRegIniFile.Create( '\Software\PAV Team\UnMaskFile' );
  try
    R.WriteString( 'Program', 'GUID', Val );
    //Result := '"' + Result + '" "%s"';
  finally
    R.Free;
  end;
end;

 function MainCreateGuid: TGUID{string};
 var
   ID: TGUID;
 begin
   //Result := '';
   if {Co}CreateGuid(ID) = S_OK then
     Result := {GUIDToString(}ID{)};
 end;

function TMainContextMenu.InvokeCommand( var CommandInfo:
                                    TCMInvokeCommandInfo ): HResult;
var
  Success: Boolean;
  CmdLine: string;
  SI: TStartupInfo;
  PI: TProcessInformation;
begin
  // Make sure we are not being called by an application
  if HiWord( Integer( CommandInfo.lpVerb ) ) <> 0 then
  begin
    Result := E_FAIL;
    Exit;
  end;

  // Execute the command specified by CommandInfo.lpVerb
  case LoWord( CommandInfo.lpVerb ) of
    0:
    begin
      FillChar( SI, SizeOf( SI ), #0 );
      SI.cb := SizeOf( SI );
      SI.wShowWindow := sw_ShowNormal;
      SI.dwFlags := STARTF_USESHOWWINDOW;

      CmdLine := Format( GetViewerPath, [ FFileName ] );
      Success := CreateProcess( nil, PChar( CmdLine ), nil, nil,
                                True, 0, nil, nil, SI, PI );
      if not Success then
      begin
        MessageBox( CommandInfo.hWnd,
                    'Ошибка запуска UnMaskFile',
                    'Ошибка', mb_IconError or mb_OK );
      end;
      Result := NOERROR;
    end;

    else                                    // Invalid menu item
      Result := E_INVALIDARG;
  end; { case }
end; {= TMainContextMenu.InvokeCommand =}


initialization
  // Create a COM object factory which will be responsible for
  // creating instances of our shell extension.  ComServer is
  // declared in ComServ unit.
  ID := GetGUID;
  CLSID_MainContextMenu := StringToGUID(ID);
  if ID = '' then
  begin
    CLSID_MainContextMenu := MainCreateGuid;
    WriteGUID(GUIDToString(CLSID_MainContextMenu));
  end;

  TComObjectFactory.Create( ComServer, TMainContextMenu,
                            CLSID_MainContextMenu,
                            '', 'Сканирование файлов на наличие вредоносного ПО',
                            ciMultiInstance );
end.

...................................................................

library shellext;

uses
  ComServ,
  shellextmain in 'shellextmain.pas';

exports
  DllGetClassObject,
  DllCanUnloadNow,
  DllRegisterServer,
  DllUnregisterServer;

begin
end.

...............................................................

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses
  Registry, ShlObj;

const
  MainDllName = 'shellext.dll';

var
  MainClassID: String;

procedure WriteViewerPath;
var
  R: TRegIniFile;
begin
  R := TRegIniFile.Create('\Software\PAV Team\UnMaskFile');
  try
    R.WriteString('Program', 'Path', ParamStr(0));
  finally
    R.Free;
  end;
end;

function GetGUID: string;
var
  R: TRegIniFile;
begin
  R := TRegIniFile.Create('\Software\PAV Team\UnMaskFile');
  try
    Result := R.ReadString('Program', 'GUID', '');
    //Result := '"' + Result + '" "%s"';
  finally
    R.Free;
  end;
end;

procedure WriteGUID(Val: String);
var
  R: TRegIniFile;
begin
  R := TRegIniFile.Create('\Software\PAV Team\UnMaskFile');
  try
    R.WriteString('Program', 'GUID', Val);
    //Result := '"' + Result + '" "%s"';
  finally
    R.Free;
  end;
end;

 function MainCreateGuidString: string;
 var
   ID: TGUID;
 begin
   Result := '';
   if CreateGuid(ID) = S_OK then//CoCreateGuid(Guid) - ActiveX
     Result := GUIDToString(ID);
 end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Reg: TRegistry;
begin
  WriteViewerPath;
  //
  MainClassID := GetGUID;
  if MainClassID = '' then
  begin
    MainClassID := MainCreateGuidString;
    WriteGUID(MainClassID);
  end;
  //
  Reg := TRegistry.Create;
  try
    with Reg do
    begin
      RootKey := HKEY_CLASSES_ROOT;
      if OpenKey('\CLSID\' + MainClassID, True) then//{3430BCB6-1F4B-49E7-92C2-FFFE8FF373C2}
      begin
      WriteString('', 'UnMaskFile Context Menu Shell Extension');
      CloseKey;
      end;
      if OpenKey('\CLSID\' + MainClassID + '\InProcServer32', True) then
      begin
      WriteString('', ExtractFilePath(ParamStr(0)) + MainDllName);
      WriteString('ThreadingModel', 'Apartment');
      CreateKey('\UnMaskFile\shellex\ContextMenuHandlers\' + MainClassID);
      CloseKey;
      end;
    end;
  finally
    Reg.Free;
  end;
  SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, nil, nil);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
if ParamCount > 0 then
ShowMessage(ParamStr(1) + #13#10 + ParamStr(2));
end;

end.