mainform.pas

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

    Res := Cert.LoadFromBufferPFX({$IFDEF DELPHI_NET}Buf{$ELSE}@Buf[0], Length(Buf){$ENDIF}, InputBox('Please enter passphrase:', '',''))
  else
  if OpenDlg.FilterIndex = 1 then
    Res := Cert.LoadFromBufferPEM({$IFDEF DELPHI_NET}Buf{$ELSE}@Buf[0], Length(Buf){$ENDIF}, '')
  else
  if OpenDlg.FilterIndex = 2 then
    Cert.LoadFromBuffer({$IFDEF DELPHI_NET}Buf{$ELSE}@Buf[0], Length(Buf){$ENDIF})
  else
    Res := -1;

  if (Res <> 0) or (Cert.CertificateSize = 0) then
  begin
    Cert.Free;
    ShowMessage('Error loading the certificate');
    Exit;
  end;

  if (Action = ACTION_SMIME_DECRYPT) or (Action = ACTION_SMIME_SIGN) then
  begin
    Sz := 0;
{$IFDEF DELPHI_NET}
    SetLength(Buf, 0);
    Cert.SaveKeyToBuffer(Buf, Sz);
{$ELSE}
    Cert.SaveKeyToBuffer(nil, Sz);
{$ENDIF}

    if (Sz = 0) then
    begin
      OpenDlg.Title := 'Select the corresponding private key file';
      OpenDlg.Filter := 'PEM-encoded key (*.pem)|*.PEM|DER-encoded key (*.key)|*.key';
      if OpenDlg.Execute then
      begin
        F := TFileStream.Create(OpenDlg.Filename, fmOpenRead or fmShareExclusive);
        SetLength(Buf, F.Size);
        F.Read({$IFDEF DELPHI_NET}Buf, 0{$ELSE}Buf[0]{$ENDIF}, F.Size);
        F.Free;

        if OpenDlg.FilterIndex = 1 then
          Cert.LoadKeyFromBufferPEM({$IFDEF DELPHI_NET}Buf{$ELSE}@Buf[0], Length(Buf){$ENDIF}, InputBox('Please enter passphrase:', '',''))
        else
          Cert.LoadKeyFromBuffer({$IFDEF DELPHI_NET}Buf{$ELSE}@Buf[0], Length(Buf){$ENDIF});

        KeyLoaded := True;
      end;
    end
    else
      KeyLoaded := True;
  end;

  // certificate e-mail in UTF8
  sFrom := GetOIDValue(Cert.SubjectRDN, SB_CERT_OID_EMAIL);
  if sFrom = '' then
  begin
    Index := Cert.Extensions.SubjectAlternativename.Content.FindNameByType(gnRFC822Name);
    if Index >= 0 then
      sFrom := Cert.Extensions.SubjectAlternativeName.Content.Names[Index].RFC822Name
    else
      MessageDlg('Warning: Certificate does not contain e-mail address.', mtWarning, [mbOk], 0);
  end;

  if (Action = ACTION_SMIME_DECRYPT) and (not KeyLoaded) then
    MessageDlg('Private key was not loaded, certificate ignored', mtError, [mbOk], 0)
  else
  begin
    FMemoryCertStorage.Add(Cert);
    UpdateCertificatesList;
  end;

  Cert.Free;
end;

procedure TfrmMain.btnAddKeyClick(Sender: TObject);
var
  TempKeyring : TElPGPKeyring;
begin
  OpenDlg.Title := 'Select input file';
  OpenDlg.Filter := 'PGP Keyring files (*.asc, *.pkr, *.skr, *.gpg, *.pgp)|*.asc;*.pkr;*.skr;*.gpg;*.pgp';
  OpenDlg.FileName := '';
  if OpenDlg.Execute then
  begin
    TempKeyring := TElPGPKeyring.Create(nil);
    try
      TempKeyring.Load(OpenDlg.Filename, '', True);
      if (Action = ACTION_PGPMIME_VERIFY) and (TempKeyring.PublicCount > 0) then
        TempKeyring.ExportTo(FKeyring);

      if (Action = ACTION_PGPMIME_DECRYPT) and (TempKeyring.SecretCount > 0) then
        TempKeyring.ExportTo(FKeyring);
    finally
      TempKeyring.Free;
    end;
    UpdateKeysList;
  end;
end;

procedure TfrmMain.btnBackClick(Sender: TObject);
begin
  Back;
end;

procedure TfrmMain.btnCancelClick(Sender: TObject);
begin
  Close;
end;

procedure TfrmMain.btnNextClick(Sender: TObject);
begin
  Next;
end;

procedure TfrmMain.btnRemoveCertificateClick(Sender: TObject);
begin
  if lbxCertificates.ItemIndex >= 0 then
  begin
    FMemoryCertStorage.Remove(lbxCertificates.ItemIndex);
    UpdateCertificatesList;
  end;
end;

procedure TfrmMain.btnRemoveKeyClick(Sender: TObject);
begin
  if Assigned(tvKeys.Selected) and Assigned(tvKeys.Selected.Data) then
  begin
    if TObject(tvKeys.Selected.Data) is TElPGPPublicKey then
    begin
      if Assigned(TElPGPPublicKey(tvKeys.Selected.Data).SecretKey) then
        FKeyring.RemoveSecretkey(TElPGPPublicKey(tvKeys.Selected.Data).SecretKey)
      else
        FKeyring.RemovePublickey(TElPGPPublicKey(tvKeys.Selected.Data));
    end
    else
    if TObject(tvKeys.Selected.Data) is TElPGPSecretKey then
      FKeyring.RemoveSecretkey(TElPGPSecretKey(tvKeys.Selected.Data));

    UpdateKeysList;
  end;
end;

procedure TfrmMain.ClearData;
begin
  edInputFile.Text := '';
  edOutputFile.Text := '';

  FMemoryCertStorage.Clear;
  lbxCertificates.Clear;

  rbTripleDES.Checked := True;
  rbSHA1.Checked := True;

  FPublicRing.Clear;
  FSecretRing.Clear;
  FKeyring.Clear;
  edKeyring.Text := '';
  tvKeys.Items.Clear;

  mmInfo.Clear;
  mmResult.Clear;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  FMemoryCertStorage := TElMemoryCertStorage.Create(nil);

  FKeyring := TElPGPKeyring.Create(nil);
  FSecretRing := TElPGPKeyring.Create(nil);
  FPublicRing := TElPGPKeyring.Create(nil);

  SetPage(PAGE_DEFAULT);
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  FreeAndNil(FPublicRing);
  FreeAndNil(FSecretRing);
  FreeAndNil(FKeyring);

  FreeAndNil(FMemoryCertStorage);
end;

function TfrmMain.GetAlgorithm: Integer;
begin
  if rbDES.Checked then
    Result := SB_ALGORITHM_CNT_DES
  else if rbTripleDES.Checked then
    Result := SB_ALGORITHM_CNT_3DES
  else if rbRC2.Checked then
    Result := SB_ALGORITHM_CNT_RC2
  else if rbRC4_40.Checked or rbRC4_128.Checked then
    Result := SB_ALGORITHM_CNT_RC4
  else if rbAES_128.Checked then
    Result := SB_ALGORITHM_CNT_AES128
  else if rbAES_192.Checked then
    Result := SB_ALGORITHM_CNT_AES192
  else if rbAES_256.Checked then
    Result := SB_ALGORITHM_CNT_AES256
  else
    Result := SB_ALGORITHM_CNT_3DES;
end;

function TfrmMain.GetAlgorithmBitsInKey: Integer;
begin
// this is only for SB_ALGORITHM_CNT_RC2 or SB_ALGORITHM_CNT_RC4
  if rbRC4_40.Checked then
    Result := 40
  else
    Result := 128;
end;

function TfrmMain.GetAlgorithmName: string;
begin
  if rbDES.Checked then
    Result := rbDES.Caption
  else if rbTripleDES.Checked then
    Result := rbTripleDES.Caption
  else if rbRC2.Checked then
    Result := rbRC2.Caption
  else if rbRC4_40.Checked then
    Result := rbRC4_40.Caption
  else if rbRC4_128.Checked then
    Result := rbRC4_128.Caption
  else if rbAES_128.Checked then
    Result := rbAES_128.Caption
  else if rbAES_192.Checked then
    Result := rbAES_192.Caption
  else if rbAES_256.Checked then
    Result := rbAES_256.Caption
  else
    Result := rbTripleDES.Caption;
end;

function TfrmMain.GetSignAlgorithm: string;
begin
  if rbMD5.Checked then
    Result := 'MD5'
  else
    Result := 'SHA1';
end;

procedure TfrmMain.Next;
begin
  if not Assigned(PageControl.ActivePage) then
  begin
    SetPage(PAGE_DEFAULT);
    Exit;
  end;

  if (CurrentPage = PAGE_SELECT_ACTION) and
     ((rbSMimeEncrypt.Checked and (Action <> ACTION_SMIME_ENCRYPT)) or
      (rbSMimeDecrypt.Checked and (Action <> ACTION_SMIME_DECRYPT)) or
      (rbSMimeSign.Checked and (Action <> ACTION_SMIME_SIGN)) or
      (rbSMimeVerify.Checked and (Action <> ACTION_SMIME_VERIFY)) or
      (rbPGPMimeEncrypt.Checked and (Action <> ACTION_PGPMIME_ENCRYPT)) or
      (rbPGPMimeDecrypt.Checked and (Action <> ACTION_PGPMIME_DECRYPT)) or
      (rbPGPMimeSign.Checked and (Action <> ACTION_PGPMIME_SIGN)) or
      (rbPGPMimeVerify.Checked and (Action <> ACTION_PGPMIME_VERIFY)) ) then
  begin
    if rbSMimeEncrypt.Checked then
      Action := ACTION_SMIME_ENCRYPT
    else if rbSMimeDecrypt.Checked then
      Action := ACTION_SMIME_DECRYPT
    else if rbSMimeSign.Checked then
      Action := ACTION_SMIME_SIGN
    else if rbSMimeVerify.Checked then
      Action := ACTION_SMIME_VERIFY
    else if rbPGPMimeEncrypt.Checked then
      Action := ACTION_PGPMIME_ENCRYPT
    else if rbPGPMimeDecrypt.Checked then
      Action := ACTION_PGPMIME_DECRYPT
    else if rbPGPMimeSign.Checked then
      Action := ACTION_PGPMIME_SIGN
    else if rbPGPMimeVerify.Checked then
      Action := ACTION_PGPMIME_VERIFY
    else
      Action := ACTION_UNKNOWN;

    ClearData;
  end;

  case Action of
    ACTION_SMIME_ENCRYPT: SMimeEncryptNext;
    ACTION_SMIME_DECRYPT: SMimeDecryptNext;
    ACTION_SMIME_SIGN: SMimeSignNext;
    ACTION_SMIME_VERIFY: SMimeVerifyNext;
    ACTION_PGPMIME_ENCRYPT: PGPEncryptNext;
    ACTION_PGPMIME_DECRYPT: PGPDecryptNext;
    ACTION_PGPMIME_SIGN: PGPSignNext;
    ACTION_PGPMIME_VERIFY: PGPVerifyNext;
  else
    SetPage(PAGE_DEFAULT);
  end;
end;

function TfrmMain.PGPDecrypt(const InputFileName, OutputFileName: string): string;
var
  Msg: TElMessage;
  MainPart: TElMessagePart;
  Stream: TFileStream;
  Res: Integer;
begin
  Result := '';
  Msg := TElMessage.Create(cXMailerDemoFieldValue);

  Stream := TFileStream.Create(InputFileName, fmOpenRead or fmShareExclusive);
  try
    Res := Msg.ParseMessage(Stream, '', '',
{$IFDEF DELPHI_NET}
                   mpoStoreStream + mpoLoadData + mpoCalcDataSize,
{$ELSE}
                   [mpoStoreStream, mpoLoadData, mpoCalcDataSize],
{$ENDIF}
                   False, False, False);
  except
    on E: Exception do
    begin
      Result := E.Message;
      Res := EL_ERROR;
    end;
  end;

  if (Res = EL_OK) or (Res = EL_WARNING) then
  begin
    if not Assigned(Msg.MainPart) or
       not Assigned(Msg.MainPart.MessagePartHandler) or
       Msg.MainPart.IsActivatedMessagePartHandler then
    begin
      Result := 'Mesage not encoded. No action done.';
      Stream.Free;
      Msg.Free;
      Exit;
    end;

    if Msg.MainPart.MessagePartHandler.IsError then
    begin
      Result := Msg.MainPart.MessagePartHandler.ErrorText;
      Res := EL_ERROR;
    end
    else
    begin
      if Msg.MainPart.MessagePartHandler is TElMessagePartHandlerPGPMime then
      begin
        with TElMessagePartHandlerPGPMime(Msg.MainPart.MessagePartHandler) do
        begin
          DecryptingKeys := FKeyring;
          OnKeyPassphrase := PGPMIMEKeyPassphrase;
        end;

        try
          Res := Msg.MainPart.MessagePartHandler.Decode(True);
        except
          on E: Exception do
          begin
            Result := E.Message;
            Res := EL_ERROR;
          end;
        end;

      end
      else
      begin
        Result := 'Unknown message handler.';
        Res := EL_ERROR;
      end;
    end;
  end;

  Stream.Free;

  if (Res <> EL_OK) and (Res <> EL_WARNING) then
  begin
    if Result <> '' then
      Result := 'Message: "' + Result + '"'
    else
      if (Res = EL_HANDLERR_ERROR) and Assigned(Msg.MainPart.MessagePartHandler) then
        Result := 'Message: "' + Msg.MainPart.MessagePartHandler.ErrorText + '"';

    Result := Format('Error parsing mime message "%s".'#13#10'ElMime error code: %d'#13#10'%s',
                     [InputFileName, Res, Result]);
    Msg.Free;
    Exit;
  end;

  MainPart := Msg.MainPart.MessagePartHandler.DecodedPart;
  Msg.MainPart.MessagePartHandler.DecodedPart := nil;
  Msg.SetMainPart(MainPart, False);

  Stream := TFileStream.Create(OutputFileName, fmCreate or fmShareExclusive);
  Stream.Size := 0;
  try
    Res := Msg.AssembleMessage(Stream,
      // 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'
      );
  except
    on E: Exception do
    begin
      Result := E.Message;
      Res := EL_ERROR;
    end;
  end;

  if (Res = EL_OK) or (Res = EL_WARNING) then
    Result := 'Message decrypted and assembled OK'
  else
  begin
    if Result <> '' then
      Result := 'Message: "' + Result + '"'
    else
      if (Res = EL_HANDLERR_ERROR) and Assigned(Msg.MainPart.MessagePartHandler) then
        Result := 'Message: "' + Msg.MainPart.MessagePartHandler.ErrorText + '"';

    Result := Format('Failed to assemble a message.'#13#10'ElMime error code: %d'#13#10'%s', [Res, Result]);
  end;

  Stream.Free;
  Msg.Free;
end;

procedure TfrmMain.PGPDecryptNext;
var
  NextPage: Integer;
begin
  NextPage := -1;
  case CurrentPage of
    PAGE_SELECT_ACTION:
    begin
      NextPage := PAGE_SELECT_FILES;
    end;

    PAGE_SELECT_FILES:
    begin
      if (edInputFile.Text = '') or (edOutputFile.Text = '') then
        MessageDlg(sSelectInputOutputFiles, mtError, [mbOk], 0)
      else
        NextPage := PAGE_SELECT_KEYS;
    end;

    PAGE_SELECT_KEYS:
    begin
     if FKeyring.SecretCount = 0 then
       MessageDlg('No recipient secret keys selected. Please select one.', mtError, [mbOk], 0)
     else
       NextPage := PAGE_CHECK_DATA;
    end;

    PAGE_CHECK_DATA:
    begin
      NextPage := PAGE_PROCESS;
    end;
  else
    NextPage := PAGE_DEFAULT;
  end;

  if NextPage >= 0 then
    SetPage(NextPage);

  if NextPage = PAGE_PROCESS then