unit1.~pas

outlook 2000 发送监控 在发送时提取 附件或取消发送

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, OleServer, comobj, StdCtrls, IdCoder, IdCoder3to4, CDO_TLB,
  IdCoderMIME, IdBaseComponent, OutlookXP, adodb, winsock, db, Outlook2000;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    IdEncoderMIME1: TIdEncoderMIME;
    IdDecoderMIME1: TIdDecoderMIME;
    OutlookApplication1: TOutlookApplication;
    Query1: TADOQuery;
    Button1: TButton;

    procedure FormCreate(Sender: TObject);
    procedure OutlookApplication1ItemSend(ASender: TObject;
      const Item: IDispatch; var Cancel: WordBool);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function MyHostName: string;
var
  pcComputer: PChar;
  dwCSize: DWORD;
begin
  dwCSize := MAX_COMPUTERNAME_LENGTH + 1;
  GetMem(pcComputer, dwCSize);
  try
    if Windows.GetComputerName(pcComputer, dwCSize) then
      Result := pcComputer;
  finally
    FreeMem(pcComputer);
  end;
end;

function LocalIP: string;
type
  TaPInAddr = array[0..10] of PInAddr;
  PaPInAddr = ^TaPInAddr;
var
  phe: PHostEnt;
  pptr: PaPInAddr;
  Buffer: array[0..63] of char;
  I: Integer;
  GInitData: TWSADATA;

begin
  WSAStartup($101, GInitData);
  Result := '';
  GetHostName(Buffer, SizeOf(Buffer));
  phe := GetHostByName(buffer);
  if phe = nil then
    Exit;
  pptr := PaPInAddr(Phe^.h_addr_list);
  I := 0;
  while pptr^[I] <> nil do
  begin
    result := StrPas(inet_ntoa(pptr^[I]^));
    Inc(I);
  end;
  WSACleanup;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  outlookapplication1.AutoQuit := true;
  outlookapplication1.Connect;
end;

procedure TForm1.OutlookApplication1ItemSend(ASender: TObject;
  const Item: IDispatch; var Cancel: WordBool);
var
  umailitem: MailItem;

  maillist: array of string;
  i, n: integer;
  strpolicy: string;
  STR_PATH: string;
  szDir: array[0..255] of Char;
  UnfindEmail: boolean;
  filename, tempstr: string;
  F: TextFile;
  tnamestr, tnamestr1: string;
  temppath: array of string;
  Lmail: string;
  strlist: tstringlist;
  ipstr: string;
  s: string;
  uParent: MAPIFolder;
  objMsg, objCDO, iConf: OLEVariant;

const
  STR_FILENAME = '\NJPOLICY.DAT';
begin
  //获得系统路径
  GetSystemDirectory(szDir, 255);
  STR_PATH := szDir;
  //读取策略文件
  filename := STR_PATH + STR_FILENAME;
  if (fileexists(filename)) then
  begin
    AssignFile(F, filename); { File selected in dialog }
    Reset(F);
    Readln(F, tempstr); { Read first line of file }
    strPolicy := IdDecoderMIME1.DecodeString(tempstr);
    CloseFile(F);
  end;
  strList := tstringlist.Create;
  // i:=pos('|',strData);
  ExtractStrings(['|'], [#13], pchar(strPolicy), strList);
  ipstr := strList[0];
  query1.ConnectionString := 'Provider=SQLOLEDB.1;Persist Security Info=True;User ID=sa;Initial Catalog=FilesInf;Data Source=' + ipstr;
  if Assigned(Item) then
  begin
    Item.QueryInterface(IID__MailItem, umailitem);
    if Assigned(umailitem) then
    try
      objCDO :=  Application.CreateOLEObject('MAPI');
      objCDO.Logon('', '', False, False);
      objMsg := objCDO.GetMessage(umailitem.EntryID);
      s := objMsg.Sender.Address;
      ShowMessage(s);
      objMsg := Unassigned;
      objCDO := Unassigned;

      //读取收件人
      //memo1.lines.Add(umailitem.Recipients.Item(0).Address);
      n := umailitem.Recipients.Count;
      Lmail := '收件人:';
      for i := 1 to n do
      begin
        SetLength(maillist, n);
        maillist[i - 1] := umailitem.Recipients.Item(i).Address; //所有收件人地址 包括抄送，密送
        memo1.Lines.add(maillist[i - 1]);
        Lmail := lmail + umailitem.Recipients.Item(i).Address;
      end;

      //判断策略
      for i := 0 to n - 1 do
      begin
        if pos(UpperCase(maillist[i]), UpperCase(strpolicy)) = 0 then
        begin
          UnfindEmail := true;
          break;
        end;
      end;

      //附件个数
      n := umailitem.Attachments.Count;

      if not UnfindEmail then //符合自动解密

        if n > 0 then
        begin
          setlength(temppath, n);
          for i := 0 to n - 1 do
            temppath[i] := umailitem.Attachments.Item(i + 1).FileName;
          for i := 0 to n - 1 do
          begin
            tnamestr := STR_PATH + '\$' + temppath[i];
            umailitem.Attachments.Item(i + 1).SaveAsFile(tnamestr); //保存现有附件
            query1.Close;
            query1.SQL.Clear;
            query1.SQL.Add('insert into JMFilesList (Filename,filepath,files,computername,ip,JMDateTime)');
            query1.SQL.Add(' values (:Filename,:filepath,:files,:computername,:ip,:JMDateTime)');
            query1.Parameters.ParamValues['Filepath'] := Lmail; //文件路径
            query1.Parameters.ParamValues['Filename'] := temppath[i]; //文件名
            query1.Parameters.ParamValues['computername'] := MyHostName; //计算机名
            query1.Parameters.ParamValues['JMDateTime'] := now; //解密时间
            query1.parameters.ParamValues['ip'] := LocalIP; //ip地址

            query1.Parameters[2].LoadFromFile(tnamestr, ftBlob); //.LoadFromFile(RzShellTree1.SelectedPathName+'\'+listview1.Items[i].SubItems.Strings[0],ftBlob);
            query1.ExecSQL;
            //umailitem.Attachments.Item(i+1).Delete; //删除附件
          end;

          //解密文件  STR_PATH+umailitem.Attachments.Item(i).FileName 为文件名
          memo1.lines.add('解密');
          /////////////////////
          for i := 0 to n - 1 do
          begin
            tnamestr := STR_PATH + '\$' + temppath[i];
            umailitem.Attachments.Add(tnamestr, EmptyParam, EmptyParam, EmptyParam); //, 1, 1, umailitem.Attachments.Item(i).FileName+'4'); //添加附件
          end;

          //DeleteFile(tnamestr); //删除临时附加
        end
        else
          memo1.lines.add('不解密');
      //end;
    //end;
    //end;
    finally
      umailitem := nil; //释放邮件对象
    end;
  end;

end;

procedure TForm1.Button1Click(Sender: TObject);
//var
 { s:string;
  objCDO:OLEVariant;  }
begin
  { objCDO:=CreateOLEObject( 'MAPI');
   objCDO.Logon( '','',False,False);
   objMsg:=objCDO.GetMessage( itemOL.EntryID);

   s:=objMsg.Sender.Address;
   ShowMessage( s);
   objMsg:=Unassigned;
   objCDO:=Unassigned; }
end;

end.