Antivirus API

Материал из DRKB


Microsoft Antivirus API позволяет создавать приложения для сканирования документов MS Office перед их открытием (а также сканирование закачек IE, содержащих код).

unit msoav;

interface

uses Windows, SysUtils, ActiveX, ComObj, Classes;

const
  IID_IOfficeAntiVirus : TGUID =    '{56FFCC30-D398-11d0-B2AE-00A0C908FA49}';
  //DEFINE_GUID(IID_IOfficeAntiVirus,
  //0x56ffcc30, 0xd398, 0x11d0, 0xb2, 0xae, 0x0, 0xa0, 0xc9, 0x8, 0xfa, 0x49);

  CATID_MSOfficeAntiVirus : TGUID = '{56FFCC30-D398-11d0-B2AE-00A0C908FA49}';
  //DEFINE_GUID(CATID_MSOfficeAntiVirus,
  //0x56ffcc30, 0xd398, 0x11d0, 0xb2, 0xae, 0x0, 0xa0, 0xc9, 0x8, 0xfa, 0x49);


type
  TInfoStruct = record
    fIsFile: Boolean;
    fIsReadOnly: Boolean;
    fIsInstalled: Boolean;
    fIsHTTPDownload: Boolean;
  end;

// Contains information about the file to be scanned.
{
* cbSize      - Integer value that specifies the size of an MSOAVINFO structure.
* hWnd        - Handle to the parent window of the Microsoft® Office 2000 application.
* pwzFullPath - Address of a wide character string that contains the full
                path of the file about to be opened.
* lpStg       - Address of the OLE storage location of the file about to be opened.
* pwzHostName - Address of a wide character string that contains the host
                application name for the antivirus scanner user interface.
* pwzOrigURL  - Address of a wide character string that contains the URL of the
                origin of a downloaded file.
}

  TMsoavinfo = record
    cbSize: Integer;
    info: ULONG;
    wnd: HWND;
    FullPath: Pointer;
    pwzHostName: PWChar;
    pwzOrigURL: PWChar;
  end;

  // This is the interface an antivirus scanner uses to interact with a host application.
  IOfficeAntiVirus = interface(IUnknown)
  ['{56FFCC30-D398-11d0-B2AE-00A0C908FA49}']
     function Scan(pmsoavinfo: PChar): HResult; stdcall;
  end;

function TestBit(const Value: Cardinal; const Bit: Byte): Boolean;
procedure GetRegisteredAntiviruses(ProgIDs: TStrings);


implementation

function TestBit(const Value: Cardinal; const Bit: Byte): Boolean;
begin
  Result := (Value and (1 shl (Bit mod 32))) <> 0;
end;

procedure GetRegisteredAntiviruses(ProgIDs: TStrings);
var
  CatInformation: ICatInformation;
  Enum: IEnumGUID;
  CLSID: TGUID;
  nFetched: Cardinal;
  CatId: TGUID;
begin
  CatInformation := CreateComObject(CLSID_StdComponentCategoryMgr) as ICatInformation;
  CatId := CATID_MSOfficeAntiVirus;
  OleCheck(CatInformation.EnumClassesOfCategories(1, @CatId, 0, nil, Enum));
  ProgIDs.BeginUpdate;
  try
    ProgIDs.Clear;
    while (Enum.Next(1, CLSID, nFetched) = S_OK) do
    begin
      ProgIDs.Add(GuidToString(clsid));
    end;
  finally
    ProgIDs.EndUpdate;
  end;
end;

end.


Now I will show a small example how to use IOfficeAntiVirus interface to implement own antivirus program for Microsoft Office.

library msoavtest;

uses
  ComServ,
  msoav,
  umsoavtest;

exports
  DllGetClassObject,
  DllCanUnloadNow,
  DllRegisterServer,
  DllUnregisterServer;

begin
end.


unit umsoavtest;

interface

uses
  Windows, ActiveX, ComObj, ShlObj, Dialogs, msoav;

type
  TMSOTest = class(TComObject, IOfficeAntiVirus)
  protected
    function Scan(pmsoavinfo: PChar): HResult; stdcall;
  end;


const
  Class_MsoTest: TGUID = '{F56BE781-C8BE-11D7-8601-00E0184D1E9D}';

implementation

uses
  ComServ, SysUtils, ShellApi, Registry;

procedure UpdateCat(Register: Boolean; const ClassID: string);
const
  SCatImplBaseKey = 'CLSID\%s\Implemented Categories';
  SCatImplKey = SCatImplBaseKey + '\%s';

var
  CatReg: ICatRegister;
  Rslt: HResult;
  CatInfo: TCATEGORYINFO;
  Description: string;
begin
  Rslt := CoCreateInstance(CLSID_StdComponentCategoryMgr, nil,
    CLSCTX_INPROC_SERVER, ICatRegister, CatReg);
  if Succeeded(Rslt) then
  begin
    if Register then
    begin
      CatInfo.catid := CATID_MSOfficeAntiVirus;
      CatInfo.lcid := $0409;
      StringToWideChar('', CatInfo.szDescription, Length('') + 1);
      OleCheck(CatReg.RegisterCategories(1, @CatInfo));
      OleCheck(CatReg.RegisterClassImplCategories(StringToGUID(ClassID), 1, @CATID_MSOfficeAntiVirus));
    end
    else
    begin
      OleCheck(CatReg.UnRegisterClassImplCategories(StringToGUID(ClassID), 1, @CATID_MSOfficeAntiVirus));
      DeleteRegKey(Format(SCatImplBaseKey, [ClassID]));
    end;
  end
  else
  begin
    if Register then
    begin
      CreateRegKey('Component Categories\' + GUIDToString(CATID_MSOfficeAntiVirus), '409', '');
      CreateRegKey(Format(SCatImplKey, [ClassID, GUIDToString(CATID_MSOfficeAntiVirus)]), '', '');
    end
    else
    begin
      DeleteRegKey(Format(SCatImplKey, [ClassID, GUIDToString(CATID_MSOfficeAntiVirus)]));
      DeleteRegKey(Format(SCatImplBaseKey, [ClassID]));
    end;
  end;
  if Register then
  begin
    Description := GetRegStringValue('CLSID\' + ClassID, '');
    CreateRegKey('AppID\' + ClassID, '', Description);
    CreateRegKey('CLSID\' + ClassID, 'AppID', ClassID);
  end
  else
    DeleteRegKey('AppID\' + ClassID);
end;

{ TMSOTest }

function TMSOTest.Scan(pmsoavinfo: PChar): HResult;
var
  Info: TMsoavinfo;
  Struct: TInfoStruct;
  p: Pointer;
begin
  p := Pointer(pmsoavinfo);
  if not Assigned(p) then
  begin
    // no information available
    Result := S_OK;
    Exit;
  end;

  Move(P^, Info, SizeOf(Tmsoavinfo));
  if Info.cbSize <> SizeOf(Tmsoavinfo) then
  begin
    // wrong size of the structure
    Result := S_OK;
    Exit;
  end;

  Struct.fIsFile := TestBit(Info.Info, 0);
  Struct.fIsReadOnly := TestBit(Info.Info, 1);
  Struct.fIsInstalled := TestBit(Info.Info, 2);
  Struct.fIsHTTPDownload := TestBit(Info.Info, 3);
  if struct.fIsFile then
  begin
    MessageDlg(PWChar(Info.FullPath), mtWarning, [mbOK], 0);
  end;
  Result := S_OK;
end;

type
  TMSOAvFactory = class(TComObjectFactory)
  public
    procedure UpdateRegistry(Register: Boolean); override;
  end;

procedure TMSOAVFactory.UpdateRegistry(Register: Boolean);
var
  ClassID: string;
begin
  ClassID := GUIDToString(Class_MsoTest);
  if Register then
  begin
    inherited UpdateRegistry(Register);
    UpdateCat(true, ClassID);
  end
  else
  begin
    UpdateCat(false, ClassID);
    inherited UpdateRegistry(Register);
  end;
end;

initialization
  TComObjectFactory.Create(ComServer, TMsoTest, Class_MsoTest,
    'MsoTest', '', ciMultiInstance, tmApartment);
end.


Author: p0s0l
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 04469