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.(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.