📄 main.pas

📁 这是一套全面的网络组件
💻 PAS
字号:
unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, clSMimeMessage, clCert, getcert, certlistfrm,
  clMailMessage;

type
  TMainForm = class(TForm)
    Label3: TLabel;
    Label4: TLabel;
    memText: TMemo;
    memHtml: TMemo;
    Label5: TLabel;
    lbAttachments: TListBox;
    btnAdd: TButton;
    btnClear: TButton;
    btnEncrypt: TButton;
    btnSign: TButton;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    edtFrom: TEdit;
    edtToList: TEdit;
    edtSubject: TEdit;
    OpenDialog: TOpenDialog;
    clSMimeMessage: TclSMimeMessage;
    SaveDialog: TSaveDialog;
    btnSignEncrypt: TButton;
    btnVerify: TButton;
    btnVerifyDecrypt: TButton;
    btnDecrypt: TButton;
    btnNewMessage: TButton;
    OpenAttach: TOpenDialog;
    cbDetachedSignature: TCheckBox;
    cbIncludeCertificate: TCheckBox;
    btnViewCertificates: TButton;
    clCertificateStore: TclCertificateStore;
    Label1: TLabel;
    Label2: TLabel;
    procedure btnAddClick(Sender: TObject);
    procedure btnClearClick(Sender: TObject);
    procedure btnEncryptClick(Sender: TObject);
    procedure clSMimeMessageGetCertificate(Sender: TObject;
      var ACertificate: TclCertificate; var Handled: Boolean);
    procedure clSMimeMessageGetBodyStream(Sender: TObject;
      ABody: TclMessageBody; const AFileName: String; var AStream: TStream;
      var Handled: Boolean);
    procedure btnNewMessageClick(Sender: TObject);
    procedure btnSignClick(Sender: TObject);
    procedure btnSignEncryptClick(Sender: TObject);
    procedure btnVerifyClick(Sender: TObject);
    procedure btnDecryptClick(Sender: TObject);
    procedure btnVerifyDecryptClick(Sender: TObject);
    procedure cbDetachedSignatureClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnViewCertificatesClick(Sender: TObject);
  private
    procedure BuildMessage;
    procedure FillControls;
    procedure NewMessage;
    procedure LoadBodies(ATextBody, AHtmlBody: TStrings; ABodies: TclMessageBodies);
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

procedure TMainForm.btnAddClick(Sender: TObject);
begin
  if OpenAttach.Execute() then
  begin
    lbAttachments.Items.Add(OpenAttach.FileName);
  end;
end;

procedure TMainForm.btnClearClick(Sender: TObject);
begin
  lbAttachments.Items.Clear();
end;

procedure TMainForm.NewMessage;
begin
  edtFrom.Text := DefaultEmail;
  edtToList.Text := '';
  edtSubject.Text := '';
  memText.Lines.Clear();
  memHtml.Lines.Clear();
  memHtml.Lines.Add('<html>');
  memHtml.Lines.Add('<body>');
  memHtml.Lines.Add('</body>');
  memHtml.Lines.Add('</html>');
  lbAttachments.Items.Clear();
end;

procedure TMainForm.btnNewMessageClick(Sender: TObject);
begin
  NewMessage();
end;

procedure TMainForm.clSMimeMessageGetCertificate(Sender: TObject;
  var ACertificate: TclCertificate; var Handled: Boolean);
var
  dlg: TGetCertDialog;
begin
  dlg := TGetCertDialog.Create(nil);
  try
    if (dlg.ShowModal() = mrOK) then
    begin
      clCertificateStore.LoadFromSystemStore(dlg.edtStore.Text);
      ACertificate := clCertificateStore.CertificateByEmail(dlg.edtEmail.Text);
      Handled := True;
    end;
  finally
    dlg.Free();
  end;
end;

procedure TMainForm.clSMimeMessageGetBodyStream(Sender: TObject;
  ABody: TclMessageBody; const AFileName: String; var AStream: TStream;
  var Handled: Boolean);
begin
  AStream := TMemoryStream.Create();
  Handled := True;
  if (AFileName <> '') then
  begin
    lbAttachments.Items.Add(AFileName);
  end;
end;

procedure TMainForm.BuildMessage;
begin
  clSMimeMessage.BuildMessage(memText.Lines.Text, memHtml.Lines.Text, nil, lbAttachments.Items);
  clSMimeMessage.From := edtFrom.Text;
  StringToEmailList(edtToList.Text, clSMimeMessage.ToList);
  clSMimeMessage.Subject := edtSubject.Text;
end;

procedure TMainForm.LoadBodies(ATextBody, AHtmlBody: TStrings; ABodies: TclMessageBodies);
var
  i: Integer;
begin
  for i := 0 to ABodies.Count - 1 do
  begin
    if (ABodies[i] is TclMultipartBody) then
    begin
      LoadBodies(ATextBody, AHtmlBody, (ABodies[i] as TclMultipartBody).Bodies);
    end else
    if (ABodies[i] is TclTextBody) then
    begin
      if (ABodies[i].ContentType = 'text/html') then
      begin
        AHtmlBody.Assign((ABodies[i] as TclTextBody).Strings);
      end else
      begin
        ATextBody.Assign((ABodies[i] as TclTextBody).Strings);
      end;
    end;
  end;
end;

procedure TMainForm.FillControls;
begin
  edtFrom.Text := clSMimeMessage.From;
  edtToList.Text := EmailListToString(clSMimeMessage.ToList);
  edtSubject.Text := clSMimeMessage.Subject;
  LoadBodies(memText.Lines, memHtml.Lines, clSMimeMessage.Bodies);
end;

procedure TMainForm.btnEncryptClick(Sender: TObject);
begin
  if SaveDialog.Execute() then
  begin
    BuildMessage();
    clSMimeMessage.Encrypt();
    clSMimeMessage.MessageSource.SaveToFile(SaveDialog.FileName);
    ShowMessage('The encrypted message is saved to ' + SaveDialog.FileName);
  end;
end;

procedure TMainForm.btnSignClick(Sender: TObject);
begin
  if SaveDialog.Execute() then
  begin
    BuildMessage();
    clSMimeMessage.Sign();
    clSMimeMessage.MessageSource.SaveToFile(SaveDialog.FileName);
    ShowMessage('The signed message is saved to ' + SaveDialog.FileName);
  end;
end;

procedure TMainForm.btnSignEncryptClick(Sender: TObject);
begin
  if SaveDialog.Execute() then
  begin
    BuildMessage();
    clSMimeMessage.Sign();
    clSMimeMessage.Encrypt();
    clSMimeMessage.MessageSource.SaveToFile(SaveDialog.FileName);
    ShowMessage('The encrypted and signed message is saved to ' + SaveDialog.FileName);
  end;
end;

procedure TMainForm.btnVerifyClick(Sender: TObject);
var
  msg: TStrings;
begin
  if OpenDialog.Execute() then
  begin
    NewMessage();
    msg := TStringList.Create();
    try
      msg.LoadFromFile(OpenDialog.FileName);
      clSMimeMessage.MessageSource := msg;
      clSMimeMessage.Verify();
      FillControls();
      ShowMessage('The signed message ' + OpenDialog.FileName + ' is verified.');
    finally
      msg.Free();
    end;
  end;
end;

procedure TMainForm.btnDecryptClick(Sender: TObject);
var
  msg: TStrings;
begin
  if OpenDialog.Execute() then
  begin
    NewMessage();
    msg := TStringList.Create();
    try
      msg.LoadFromFile(OpenDialog.FileName);
      clSMimeMessage.MessageSource := msg;
      clSMimeMessage.Decrypt();
      FillControls();
      ShowMessage('The encrypted message ' + OpenDialog.FileName + ' is decrypted.');
    finally
      msg.Free();
    end;
  end;
end;

procedure TMainForm.btnVerifyDecryptClick(Sender: TObject);
var
  msg: TStrings;
begin
  if OpenDialog.Execute() then
  begin
    NewMessage();
    msg := TStringList.Create();
    try
      msg.LoadFromFile(OpenDialog.FileName);
      clSMimeMessage.MessageSource := msg;
      clSMimeMessage.DecryptAndVerify();
      FillControls();
      ShowMessage('The secured message ' + OpenDialog.FileName + ' is decrypted and verified.');
    finally
      msg.Free();
    end;
  end;
end;

procedure TMainForm.cbDetachedSignatureClick(Sender: TObject);
begin
  clSMimeMessage.IsDetachedSignature := cbDetachedSignature.Checked;
  clSMimeMessage.IsIncludeCertificate := cbIncludeCertificate.Checked;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  edtFrom.Text := DefaultEmail;
end;

procedure TMainForm.btnViewCertificatesClick(Sender: TObject);
begin
  TCertListForm.ShowCertificates(clSMimeMessage.Certificates);
end;

end.
💿 文件大小 6236 K
👤 上传用户 xiaotiao
📂 所属分类 Delphi控件源码
🏷️ 相关标签

#网络
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -