Sources
Delphi Russian Knowledge Base
DRKB - база знаний по Дельфи в рунете, составленная Виталием Невзоровым

Microsoft Antivirus API

01.01.2007
p0s0l

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.
Previous page:
Доступ к COM-серверам Microsoft Office из Delphi 5 (Статья)
Top:
DRKB
Next page:
Microsoft Binder