mimemakerform.pas

来自「著名的SecureBlackBox控件完整源码」· PAS 代码 · 共 897 行 · 第 1/2 页

unit MimeMakerForm;
{$i MimeMaker.inc}
{$O-,D+,L+}

{.$DEFINE _RepackTest}

interface

{$warnings off}
uses
  {$IFDEF DELPHI_NET}
  System.Text,
  System.Collections,
  System.ComponentModel,
  {$ENDIF}
  // System units:
  Windows, Messages, SysUtils, {$IFDEF D_6_UP}Variants,{$ENDIF} Classes,
  // SB Unicode Library
  SBChSConvCharsets, // include all charsets
  // MIMEBlackbox units:
  SBMIMETypes,
  SBMIMEClasses,
  SBMIMEStream,
  SBMIME,
  {$IFDEF _UUE_}
  SBMIMEUUE,
  {$ENDIF}
  {$IFDEF _SMIME_}
  {$IFNDEF DELPHI_NET}
  SBChSConv,
  {$ENDIF}
  SBCustomCertStorage,
  SBSMIMECore,
  SBConstants,
  SBX509,
  SBX509Ext,
  SBRDN,
  {$ENDIF}
  {$IFDEF _PGP_}
  SBPGPMIME,
  SBPGPKeys,
  SBPGPUtils,
  {$ENDIF}
  // VCL units:
  Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, ComCtrls, Menus,
  Buttons;

{$warnings on}

const
  cDemoVersion = '2004.10.22';

type
  TMakerForm = class(TForm)
    pTop: TPanel;
    pTopL: TPanel;
    pTopLCap: TPanel;
    memoPlainText: TMemo;
    checkUsePlainText: TCheckBox;
    spTopV: TSplitter;
    pTopR: TPanel;
    pTopRCap: TPanel;
    memoHTML: TMemo;
    checkUseHTML: TCheckBox;
    StatusBar: TStatusBar;
    pBottm: TPanel;
    spH: TSplitter;
    listFileNames: TListBox;
    MainMenu: TMainMenu;
    miFile: TMenuItem;
    miAssembleandSave: TMenuItem;
    N1: TMenuItem;
    miExit: TMenuItem;
    miHelp: TMenuItem;
    miAbout: TMenuItem;
    pBottmCap: TPanel;
    lAttachments: TLabel;
    bBottmBtn: TPanel;
    btnAddAttach: TBitBtn;
    btnRemoveAttach: TBitBtn;
    OpenDialog: TOpenDialog;
    SaveDialog: TSaveDialog;
    pSubj: TPanel;
    cbAttachAsUUE: TCheckBox;
    mUUEInfo: TMemo;
    ODC: TOpenDialog;
    pLeft: TPanel;
    pFrom: TPanel;
    pTo: TPanel;
    pSubject: TPanel;
    lFrom: TLabel;
    lTo: TLabel;
    lSubj: TLabel;
    editFrom: TEdit;
    editTo: TEdit;
    editSubject: TEdit;
    pCC: TPanel;
    lCC: TLabel;
    editCC: TEdit;
    pSecurity: TPanel;
    pSecCombo: TPanel;
    cbSecurity: TComboBox;
    pSMIME: TPanel;
    pPGPMIME: TPanel;
    lCerts: TLabel;
    lvCryptCerts: TListView;
    btnCryptLoad: TBitBtn;
    btnCryptRemove: TBitBtn;
    cbEncryptMessageSMIME: TCheckBox;
    cbSignMessageSMIME: TCheckBox;
    cbEncryptMessagePGPMIME: TCheckBox;
    cbSignMessagePGPMIME: TCheckBox;
    editPublicKeyring: TEdit;
    editSecretKeyring: TEdit;
    lPubRing: TLabel;
    lSecRing: TLabel;
    btnSelectPub: TBitBtn;
    btnSelectSec: TBitBtn;
    OpenDialogKeyring: TOpenDialog;
    lvSignCerts: TListView;
    btnSignLoad: TBitBtn;
    btnSignRemove: TBitBtn;
    Label1: TLabel;
    procedure miAboutClick(Sender: TObject);
    procedure miExitClick(Sender: TObject);
    procedure miAssembleandSaveClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure spHCanResize(Sender: TObject; var NewSize: Integer;
      var Accept: Boolean);
    procedure btnAddAttachClick(Sender: TObject);
    procedure btnRemoveAttachClick(Sender: TObject);
    procedure btnCryptLoadClick(Sender: TObject);
    procedure cbSecurityChange(Sender: TObject);
    procedure btnSelectPubClick(Sender: TObject);
    procedure btnSelectSecClick(Sender: TObject);
    procedure btnCryptRemoveClick(Sender: TObject);
    procedure btnSignRemoveClick(Sender: TObject);
    procedure btnSignLoadClick(Sender: TObject);
  private
    {$IFDEF _SMIME_}
    FEnryptCertStorage,
    FSignCertStorage : TElMemoryCertStorage;
    {$endif}
    {$IFDEF _PGP_}
    FSecretRing : TElPGPKeyring;
    FPublicRing : TElPGPKeyring;
    procedure PGPMIMEKeyPassphrase(Sender: TObject; Key : TElPGPCustomSecretKey;
      var Passphrase: string; var Cancel: boolean);
    {$ENDIF}
  public
    { Public declarations }
  end;

var
  MakerForm: TMakerForm;

implementation

uses
  SBMIMEUtils,
  SBUtils;

{$R *.DFM}

procedure TMakerForm.FormCreate(Sender: TObject);
begin
  editSubject.Text := 'EldoS MimeBlackbox Example. Version: '+cDemoVersion;
  {$IFDEF _UUE_}
  cbAttachAsUUE.Enabled := True;
  {$ENDIF}
  {$IFDEF _SMIME_}
  cbSignMessageSMIME.Enabled := True;
  cbEncryptMessageSMIME.Enabled := True;
  btnCryptLoad.Enabled := True;
  btnCryptRemove.Enabled := True;

  btnSignLoad.Enabled := True;
  btnSignRemove.Enabled := True;

  FEnryptCertStorage := TElMemoryCertStorage.Create(nil);
  FSignCertStorage := TElMemoryCertStorage.Create(nil);
  {$ENDIF}
  {$IFDEF _PGP_}
  editPublicKeyring.Enabled := True;
  editSecretKeyring.Enabled := True;
  btnSelectPub.Enabled := True;
  btnSelectSec.Enabled := True;
  cbSignMessagePGPMIME.Enabled := True;
  cbEncryptMessagePGPMIME.Enabled := True;
  FSecretRing := TElPGPKeyring.Create(nil);
  FPublicRing := TElPGPKeyring.Create(nil);
  {$ENDIF}
  cbSecurity.ItemIndex := 0;
  pSMIME.Visible := false;
  pPGPMIME.Visible := false;

end;

procedure TMakerForm.FormDestroy(Sender: TObject);
begin
  {$IFDEF _SMIME_}
  FEnryptCertStorage.Free;
  FSignCertStorage.Free;
  {$endif}
  {$IFDEF _PGP_}
  FSecretRing.Free;
  FPublicRing.Free;
  {$ENDIF}
end;

procedure TMakerForm.miAboutClick(Sender: TObject);
begin
  ShowMessage('EldoS MIMEBlackbox Demo Application.'#13#10'Mime maker , version: '+cDemoVersion+#13#10#13#10+
  '(' +cXMailerDefaultFieldValue + ')'#13#10#13#10+
  'Homepage: http://www.secureblackbox.com')
end;

procedure TMakerForm.miExitClick(Sender: TObject);
begin
  Close;
end;

procedure TMakerForm.miAssembleandSaveClick(Sender: TObject);
var
  iPartCount, i: Integer;

  msg: TElMessage;
  res: HRESULT;
  sm: TAnsiStringStream;
  {$IFDEF _RepackTest}
  sm0: TAnsiStringStream;
  {$ENDIF}

  par,
  ammp,
  mmp: TElMultiPartList;
  mpt: TElPlainTextPart;
  mpc: TElMessagePart;

  s: AnsiString;
  {$IFDEF _UUE_}
  uue: TElMessagePartHandlerUUE;
  {$ENDIF}
  {$IFDEF _SMIME_}
  smime: TElMessagePartHandlerSMime;
  {$ENDIF}
  {$IFDEF _PGP_}
  pgpmime: TElMessagePartHandlerPGPMime;
  {$ENDIF}

begin
  {$IFDEF _SMIME_}
  smime := nil;
  {$ENDIF}
  {$IFDEF _PGP_}
  pgpmime := nil;
  {$ENDIF}

  iPartCount := 0;
  if checkUsePlainText.Checked then
    inc(iPartCount);
  if checkUseHTML.Checked then
    inc(iPartCount);
  if listFileNames.Items.Count > 0 then
    inc(iPartCount);

  if iPartCount = 0 then
  begin
    ShowMessage('Warning: Please define any mime part !');
    exit;
  end;

  if not SaveDialog.Execute then
    exit;

  msg := nil;
  sm  := nil;
  mmp := nil;

  {$IFDEF _RepackTest}
  sm0 := nil;
  {$ENDIF}

  //try

    {$IFDEF _RepackTest}
    sm0 := TAnsiStringStream.Create;
    sm0.LoadFromFile('.\Received.eml');
    msg := TElMessage.Create(False{== do not create default main part});
    msg.ParseMessage(
        sm0,
        '',
        '',
        [mpoStoreStream, mpoLoadData, mpoCalcDataSize],
        False,
        False,
        False
    );
    {$ENDIF}

    if msg = nil then
    begin

    if iPartCount = 1 then
    begin
      msg := TElMessage.Create(False{== do not create default main part});
      if checkUsePlainText.Checked then
      begin
        mpt := TElPlainTextPart.Create(msg, mmp);
        msg.SetMainPart(mpt, False);
        mpt.SetText( memoPlainText.Text );
      end
      else
      if checkUseHTML.Checked then
      begin
        mpt := TElPlainTextPart.Create(msg, mmp);
        msg.SetMainPart(mpt, False);
        mpt.SetContentSubType('html', True);
        mpt.SetText( memoHTML.Text );
      end
      else
      begin
        {$IFDEF _UUE_}
        if cbAttachAsUUE.Enabled then
        begin
          mpt := TElPlainTextPart.Create(msg, mmp);
          msg.SetMainPart(mpt, False);
          uue := TElMessagePartHandlerUUE.Create(nil);
          mpt.MessageBodyPartHandler := uue;
          for i := 0 to listFileNames.Items.Count-1 do
            uue.AddAttachedFile(listFileNames.Items[i]);
        end
        else
        {$ENDIF}
        for i := 0 to listFileNames.Items.Count-1 do
          msg.AttachFile(''{ == application/octet-stream'}, listFileNames.Items[i]);
      end;
    end
    else
    begin
      msg := TElMessage.Create(False{== do not create default main part});
      mmp := TElMultiPartList.Create(msg, nil);
      msg.SetMainPart(mmp, False);

      par := mmp;

      if checkUsePlainText.Checked and checkUseHTML.Checked then
      begin
        if (listFileNames.Items.Count = 0) then
        begin
          mmp.SetContentType('multipart', true);
          mmp.SetContentSubtype('alternative', false);
        end
        else
        begin
          ammp := TElMultiPartList.Create(msg, mmp);
          mmp.AddPart(ammp);
          par := ammp;
          ammp.SetContentType('multipart', true);
          ammp.SetContentSubtype('alternative', false);
          mmp.SetContentType('multipart', true);
          mmp.SetContentSubtype('mixed', false);
        end;
      end;

      if checkUsePlainText.Checked then
      begin
        mpt := TElPlainTextPart.Create(msg, par);
        par.AddPart(mpt);
        mpt.SetText( memoPlainText.Text );
      end;

      if checkUseHTML.Checked then
      begin
        mpt := TElPlainTextPart.Create(msg, par);
        par.AddPart(mpt);
        mpt.SetContentSubType('html', True);
        mpt.SetText( memoHTML.Text );
      end;

      if listFileNames.Items.Count > 0 then
      begin
        for i := 0 to listFileNames.Items.Count-1 do
        begin
          // msg.AttachFile(''{ == application/octet-stream'}, listFileNames.Items[i]);
          // or manual:

          sm := TAnsiStringStream.Create;

          mpc := TElMessagePart.Create(msg, mmp);
          mmp.AddPart(mpc);

          s := ExtractFileName(listFileNames.Items[i]);

          with mpc.Header.AddField('Content-Type', 'application/octet-stream', True) do
            AddParam('name', s);
          with mpc.Header.AddField('Content-Disposition', 'attachment', True) do
            AddParam('filename', s);
          mpc.Header.AddField('Content-Transfer-Encoding', 'base64', True);

          sm.LoadFromFile(listFileNames.Items[i]);
          mpc.SetData(sm, sm.Size, False); // stream controled in mpc
          sm := nil;

        end;//of: for i

      end;//of: if listFileNames.Items.Count > 0

    end;//of: if iPartCount = 1

    end;

    {$IFDEF _SMIME_}
    if (cbSecurity.ItemIndex = 1) and (cbSignMessageSMIME.Checked or cbEncryptMessageSMIME.Checked) then
    begin
      smime := TElMessagePartHandlerSMime.Create(nil);
      smime.EncoderCryptCertStorage := FEnryptCertStorage;
      smime.EncoderSignCertStorage := FSignCertStorage;
      msg.MainPart.MessagePartHandler := smime;
      if cbSignMessageSMIME.Checked then
      begin
        smime.EncoderSigned := True;
        smime.EncoderSignOnlyClearFormat := True;
        smime.EncoderMicalg := 'sha1';
      end;
      if cbEncryptMessageSMIME.Checked then
      begin
        smime.EncoderCrypted := True;
        smime.EncoderCryptBitsInKey := 128;
        smime.EncoderCryptAlgorithm := SB_ALGORITHM_CNT_3DES;
      end;
    end;
    {$ENDIF}

    {$IFDEF _PGP_}
    if (cbSecurity.ItemIndex = 2) and (cbSignMessagePGPMIME.Checked or
      cbEncryptMessagePGPMIME.Checked) then
    begin
      pgpmime := TElMessagePartHandlerPGPMime.Create(nil);
      msg.MainPart.MessagePartHandler := pgpmime;
      if cbSignMessagePGPMIME.Checked then
      begin
        pgpmime.Sign := true;
        pgpmime.SigningKeys := FSecretRing;
        pgpmime.OnKeyPassphrase := PGPMIMEKeyPassphrase;
      end;
      if cbEncryptMessagePGPMIME.Checked then
      begin