mimemakerform.pas

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

PAS
897 行
字号
12
        pgpmime.Encrypt := true;
        pgpmime.EncryptingKeys := FPublicRing;
      end;
    end;
    {$ENDIF}

    msg.From.AddAddress('e-mail: '+editFrom.Text, editFrom.Text);

    {$IFNDEF _RepackTest}
    if editTo.Text <> '' then
      msg.To_.AddAddress('', editTo.Text);
    if editCc.Text <> '' then
      msg.Cc.AddAddress('', editCc.Text);
    msg.SetSubject(editSubject.Text);
    msg.SetDate(Now);
    msg.MessageID := msg.GenerateMessageID;
    {$ENDIF}

    // assemble:
    sm := TAnsiStringStream.Create;

    res := msg.AssembleMessage(sm,
      // Charset of message:
        'utf-8',
      // HeaderEncoding
        heBase64, //  variants:  he8bit  | heQuotedPrintable  | heBase64
      // BodyEncoding
        'base64', //  variants:   '8bit' | 'quoted-printable' |  'base64'
      // AttachEncoding
        'base64'  //  variants:   '8bit' | 'quoted-printable' |  'base64'
    );

    if (res = EL_OK) or (res = EL_WARNING) then
    begin
      sm.SaveToFile(SaveDialog.FileName);
      MessageDlg('Message assembled OK', mtInformation, [mbOk], 0);
    end
    else
    begin
      if res = EL_HANDLERR_ERROR then
      begin
        {$IFDEF _SMIME_}
        if Assigned(smime) then
          s := 'Message: "' + smime.ErrorText + '"';
        {$ENDIF}
        {$IFDEF _PGP_}
        if Assigned(pgpmime) then
          s := 'Message: "' + pgpmime.ErrorText + '"';
        {$ENDIF}
      end;
      MessageDlg('Failed to assemble a message, error "'+IntToStr(res)+'"'#13#10 + s,
        mtError, [mbOk], 0);
    end;

  //finally
    msg.Free;
    sm.Free;
  //end;

end;

procedure TMakerForm.spHCanResize(Sender: TObject; var NewSize: Integer;
  var Accept: Boolean);
begin
  if NewSize = spH.MinSize then // fix splitter bug when resizing to down
    Accept := False;
end;

procedure TMakerForm.btnAddAttachClick(Sender: TObject);
var
  i: integer;
begin
  if OpenDialog.Execute then
  begin
    i := listFileNames.Items.IndexOf(OpenDialog.FileName);
    if i >= 0 then
    begin
      listFileNames.ItemIndex := i;
      exit;
    end;
    {$IFDEF VCL_6_USED}
    listFileNames.AddItem(OpenDialog.FileName, nil);
    {$ELSE}
    listFileNames.Items.Add(OpenDialog.FileName);
    {$ENDIF}
    listFileNames.ItemIndex := listFileNames.Items.Count -1;
    btnRemoveAttach.Enabled := True;
  end;
end;

procedure TMakerForm.btnRemoveAttachClick(Sender: TObject);
var
  i: integer;
begin

  if listFileNames.ItemIndex>=0 then
  begin
    i := listFileNames.ItemIndex;
    {$IFDEF VCL_6_USED}
    listFileNames.DeleteSelected;
    {$ELSE}
    if i <> -1 then
      listFileNames.Items.Delete(i);
    {$ENDIF}
    btnRemoveAttach.Enabled := listFileNames.Items.Count > 0;
    if btnRemoveAttach.Enabled then
    begin
      if i < listFileNames.Items.Count-1 then
        listFileNames.ItemIndex := i
      else
        listFileNames.ItemIndex := listFileNames.Items.Count-1;
    end;
  end;
end;

procedure TMakerForm.btnCryptLoadClick(Sender: TObject);
{$IFDEF _SMIME_}
var
  ws: WideString;
  sPswd: AnsiString;
  sFrom: string;
  Cert : TElX509Certificate;
  Item: TListItem;
  Index : integer;

  function ConvertUTF8String(const Source: AnsiString): WideString;
  {$IFDEF DELPHI_NET}
  begin
    Result := System.Text.Encoding.UTF8.GetString(TBytes(Source));
  end;
  {$ELSE}
  var
    sDest: AnsiString;
    Conv: TPlConverter;
  begin
    sDest := '';
    if Length(Source) > 0 then
    begin
      Conv := TPlConverter.Create('utf-8', 'utf-16');
      Conv.Convert(Source, sDest, []);
      Result := AnsiStringToByteWideString(sDest);
      Conv.Free;
    end
    else
      Result := '';
  end;
  {$ENDIF}

  function GetOIDValue(NTS : TElRelativeDistinguishedName; S: BufferType): AnsiString;
  var SL : {$IFDEF DELPHI_NET}ArrayList{$ELSE}TStringList{$ENDIF};
  begin
    SL := {$IFDEF DELPHI_NET}ArrayList{$ELSE}TStringList{$ENDIF}.Create;
    try
      NTS.GetValuesByOID(S, SL);
      if SL.Count >= 1 then
        Result := AnsiString(BufferType(SL[0]))
      else
        SetLength(Result, 0);
    finally
      SL.Free;
    end;
  end;
{$ENDIF}
begin
  {$IFDEF _SMIME_}
  if ODC.Execute then
  begin
    ws:= InputBox('Certificate Password',
        'Please enter password if it is needed', #0 );
    if ws = #0 then
      sPswd := ''
    else
      sPswd := ws;
    if AddToStorageCertificateFromFile( FEnryptCertStorage,
        // FileName:
          ODC.FileName,
       // Password:
          sPswd
    ) then
    begin
      Cert := FEnryptCertStorage.Certificates[FEnryptCertStorage.Count-1];
      sFrom := // == certificate e-mail:
      ConvertUTF8String(
        GetOIDValue(
          Cert.SubjectRDN,
          SB_CERT_OID_EMAIL)
      );
      if sFrom = '' then
      begin
        Index := Cert.Extensions.SubjectAlternativeName.Content.FindNameByType(gnRFC822Name);
        if Index <> -1 then
          sFrom := Cert.Extensions.SubjectAlternativeName.Content.Names[Index].RFC822Name
        else
          MessageDlg('Warning: Certificate does not contain e-mail address.', mtWarning,
            [mbOk], 0);
      end;
      //if (sFrom <> '') and Cert.PrivateKeyExists then
      //  editFrom.Text := sFrom;
      Item := lvCryptCerts.Items.Add;
      if sFrom = '' then
        sFrom := Cert.SubjectName.CommonName;
      if sFrom = '' then
        sFrom := '<untitled>';
      Item.Caption := sFrom;
      Item.Data := Cert;
    end
    else
      MessageDlg('Error: Error loading certificate: "' + ODC.FileName + '"',
        mtError, [mbOk], 0);
  end;
  {$ENDIF}
end;

procedure TMakerForm.cbSecurityChange(Sender: TObject);
begin
  pSMIME.Visible := cbSecurity.ItemIndex = 1;
  pPGPMIME.Visible := cbSecurity.ItemIndex = 2;
end;

procedure TMakerForm.btnSelectPubClick(Sender: TObject);
{$IFDEF _PGP_}
var
  F : TFileStream;
{$ENDIF}
begin
  {$IFDEF _PGP_}
  if OpenDialogKeyring.Execute then
  begin
    F := TFileStream.Create(OpenDialogKeyring.Filename, fmOpenRead);
    try
      try
        FPublicRing.Load(F, nil, true);
      finally
        F.Free;
      end;
    except
      editPublicKeyring.Text := '';
      Exit;
    end;
    editPublicKeyring.Text := OpenDialogKeyring.Filename;
  end;
  {$ENDIF}
end;

procedure TMakerForm.btnSelectSecClick(Sender: TObject);
{$IFDEF _PGP_}
var
  F : TFileStream;
{$ENDIF}
begin
  {$IFDEF _PGP_}
  if OpenDialogKeyring.Execute then
  begin
    F := TFileStream.Create(OpenDialogKeyring.Filename, fmOpenRead);
    try
      try
        FSecretRing.Load(F, nil, true);
      finally
        F.Free;
      end;
    except
      editSecretKeyring.Text := '';
      Exit;
    end;
    editSecretKeyring.Text := OpenDialogKeyring.Filename;
  end;
  {$ENDIF}
end;

procedure TMakerForm.btnCryptRemoveClick(Sender: TObject);
{$IFDEF _SMIME_}
var
  Index : integer;
{$ENDIF}
begin
  {$IFDEF _SMIME_}
  if (lvCryptCerts.Selected <> nil) and (lvCryptCerts.Selected.Data <> nil) then
  begin
    if MessageDlg('The selected certificated will be removed from list. Do you want to proceed?',
      mtWarning, [mbYes, mbNo], 0) = mrYes then
    begin
      Index := FEnryptCertStorage.IndexOf(lvCryptCerts.Selected.Data);
      if Index < 0 then
        MessageDlg('Internal error', mtError, [mbOk], 0)
      else
        FEnryptCertStorage.Remove(Index);
      Index := lvCryptCerts.Items.IndexOf(lvCryptCerts.Selected);
      if Index < 0 then
        MessageDlg('Internal error', mtError, [mbOk], 0)
      else
        lvCryptCerts.Items.Delete(Index);
    end;
  end;
  {$ENDIF}
end;

{$IFDEF _PGP_}
procedure TMakerForm.PGPMIMEKeyPassphrase(Sender: TObject; Key : TElPGPCustomSecretKey;
  var Passphrase: string; var Cancel: boolean);
begin
  Passphrase := InputBox('Password request',
    'Please enter password for key ' + KeyID2Str(Key.KeyID), '');
end;
{$ENDIF}

procedure TMakerForm.btnSignRemoveClick(Sender: TObject);
{$IFDEF _SMIME_}
var
  Index : integer;
{$ENDIF}
begin
  {$IFDEF _SMIME_}
  if (lvSignCerts.Selected <> nil) and (lvSignCerts.Selected.Data <> nil) then
  begin
    if MessageDlg('The selected certificated will be removed from list. Do you want to proceed?',
      mtWarning, [mbYes, mbNo], 0) = mrYes then
    begin
      Index := FSignCertStorage.IndexOf(lvSignCerts.Selected.Data);
      if Index < 0 then
        MessageDlg('Internal error', mtError, [mbOk], 0)
      else
        FSignCertStorage.Remove(Index);
      Index := lvSignCerts.Items.IndexOf(lvSignCerts.Selected);
      if Index < 0 then
        MessageDlg('Internal error', mtError, [mbOk], 0)
      else
        lvSignCerts.Items.Delete(Index);
    end;
  end;
  {$ENDIF}
end;

procedure TMakerForm.btnSignLoadClick(Sender: TObject);
{$IFDEF _SMIME_}
var
  ws: WideString;
  sPswd: AnsiString;
  sFrom: string;
  Cert : TElX509Certificate;
  Item: TListItem;
  Index: integer;

  function ConvertUTF8String(const Source: AnsiString): WideString;
  {$IFDEF DELPHI_NET}
  begin
    Result := System.Text.Encoding.UTF8.GetString(TBytes(Source));
  end;
  {$ELSE}
  var
    sDest: AnsiString;
    Conv: TPlConverter;
  begin
    sDest := '';
    if Length(Source) > 0 then
    begin
      Conv := TPlConverter.Create('utf-8', 'utf-16');
      Conv.Convert(Source, sDest, []);
      Result := AnsiStringToByteWideString(sDest);
      Conv.Free;
    end
    else
      Result := '';
  end;
  {$ENDIF}

  function GetOIDValue(NTS : TElRelativeDistinguishedName; S: BufferType): AnsiString;
  var SL : {$IFDEF DELPHI_NET}ArrayList{$ELSE}TStringList{$ENDIF};
  begin
    SL := {$IFDEF DELPHI_NET}ArrayList{$ELSE}TStringList{$ENDIF}.Create;
    try
      NTS.GetValuesByOID(S, SL);
      if SL.Count >= 1 then
        Result := AnsiString(BufferType(SL[0]))
      else
        SetLength(Result, 0);
    finally
      SL.Free;
    end;
  end;
{$ENDIF}
begin
  {$IFDEF _SMIME_}
  if ODC.Execute then
  begin
    ws:= InputBox('Certificate Password',
        'Please enter password if it is needed', #0 );
    if ws = #0 then
      sPswd := ''
    else
      sPswd := ws;
    if AddToStorageCertificateFromFile( FSignCertStorage,
        // FileName:
          ODC.FileName,
       // Password:
          sPswd
    ) then
    begin
      Cert := FSignCertStorage.Certificates[FSignCertStorage.Count-1];
      sFrom := // == certificate e-mail:
      ConvertUTF8String(
        GetOIDValue(
          Cert.SubjectRDN,
          SB_CERT_OID_EMAIL)
      );
      if sFrom = '' then
      begin
        Index := Cert.Extensions.SubjectAlternativeName.Content.FindNameByType(gnRFC822Name);
        if Index <> -1 then
          sFrom := Cert.Extensions.SubjectAlternativeName.Content.Names[Index].RFC822Name
        else
          MessageDlg('Warning: Certificate does not contain e-mail address.', mtWarning,
            [mbOk], 0);
      end;
      if (sFrom <> '') and Cert.PrivateKeyExists and (editFrom.Text <> '') then
      begin
        MessageDlg('Warning: Certificate e-mail address doesn''t correspond to From field.', mtWarning, [mbOk], 0);
      end
      else
      if (sFrom <> '') and Cert.PrivateKeyExists and (editFrom.Text = '') then
        editFrom.Text := sFrom;
      Item := lvSignCerts.Items.Add;
      if sFrom = '' then
        sFrom := Cert.SubjectName.CommonName;
      if sFrom = '' then
        sFrom := '<untitled>';
      Item.Caption := sFrom;
      Item.Data := Cert;
    end
    else
      MessageDlg('Error: Error loading certificate: "' + ODC.FileName + '"',
        mtError, [mbOk], 0);
  end;
  {$ENDIF}
end;


initialization
SetLicenseKey('ADDCD14AD06709806817E0B3D7BFD0A2222D536FE156466C5D5FE65DB5DEAE76' + 
  'FFDEBC07E915A5751C12C01C783958872A38E4A5EDA140E7247E0F2E56442A3C' + 
  'F3E9347AD8FDE52083A0DFC86BC00ECB0FD0CF1B51159A2BCB84F6EA6349EF47' + 
  '5C15A59AFCC55F7C3AAD26C279628B5D91B1DC94BD2385354A70CCA3B76101D9' + 
  'F41C84A639FC3CCE4BA8F0CC4A66DCD150114A3F58C1AD46B7B94643741BC20A' + 
  '8DCA83AB921480951B423CAA19EF1863A47CA2C3422E7E5634BED98939A5AE43' + 
  'DE1E4BAD79E66D8A5C973B3455656C8C9B6FF024FADD6CDA02D0F506D98493C8' + 
  'BD1ED7B237DB75FA31F2C82654490CDDDEE24E19939137B9E1DB05508733B22F');

end.
12

mimemakerform.pas - 源码说明

本页面展示了「著名的SecureBlackBox控件完整源码」中的 mimemakerform.pas 源码文件，采用 PAS 编程语言编写，共 897 行代码。您可以在线阅读完整代码内容，也可以返回资源详情页下载完整源码包进行本地学习和开发。

虫虫开发者社区收录了大量与security component相关的技术资源，包括源代码、技术文档、电路图等，是电子工程师和嵌入式开发者的专业学习平台。

⌨️ 快捷键说明

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