mainform.pas

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

  SaveDlg.FileName := edOutputFile.Text;
  if SaveDlg.Execute then
    edOutputFile.Text := SaveDlg.FileName;
end;

procedure TfrmMain.SetPage(Page: Integer);
begin
  case Page of
    PAGE_SELECT_ACTION:
      PageControl.ActivePageIndex := tsSelectAction.PageIndex;

    PAGE_SELECT_FILES:
    begin
      case Action of
        ACTION_SMIME_ENCRYPT, ACTION_PGPMIME_ENCRYPT:
          lbSelectFiles.Caption := sSelectFilesForEncryption;

        ACTION_SMIME_DECRYPT, ACTION_PGPMIME_DECRYPT:
          lbSelectFiles.Caption := sSelectFilesForDecryption;

        ACTION_SMIME_SIGN, ACTION_PGPMIME_SIGN:
          lbSelectFiles.Caption := sSelectFilesForSigning;

        ACTION_SMIME_VERIFY, ACTION_PGPMIME_VERIFY:
          lbSelectFiles.Caption := sSelectFilesForVerifying;
      end;

      edOutputFile.Visible := (Action <> ACTION_SMIME_VERIFY) and (Action <> ACTION_PGPMIME_VERIFY);
      lbOutputFile.Visible := edOutputFile.Visible;
      sbOutputFile.Visible := edOutputFile.Visible;
      PageControl.ActivePageIndex := tsSelectFiles.PageIndex;
    end;

    PAGE_SELECT_CERTIFICATES:
    begin
      case Action of
        ACTION_SMIME_ENCRYPT:
          lbSelectCertificates.Caption := sSelectCertificatesForEncryption;

        ACTION_SMIME_DECRYPT:
          lbSelectCertificates.Caption := sSelectCertificatesForDecryption;

        ACTION_SMIME_SIGN:
          lbSelectCertificates.Caption := sSelectCertificatesForSigning;

        ACTION_SMIME_VERIFY:
          lbSelectCertificates.Caption := sSelectCertificatesForVerifying;
      end;

      PageControl.ActivePageIndex := tsSelectCertificates.PageIndex;
    end;

    PAGE_SELECT_ALGORITHM:
    begin
      case Action of
        ACTION_SMIME_ENCRYPT:
          PageControl.ActivePageIndex := tsAlgorithm.PageIndex;

        ACTION_SMIME_SIGN:
          PageControl.ActivePageIndex := tsSignAlgorithm.PageIndex;
      end;
    end;

    PAGE_SELECT_KEYS:
    begin
      case Action of
        ACTION_PGPMIME_ENCRYPT:
        begin
          lbSelectKey.Caption := sSelectKeysForEncryption;
          lbKeyring.Caption := 'Public keyring:';
        end;

        ACTION_PGPMIME_DECRYPT:
          lbSelectKeys.Caption := sSelectKeysForDecryption;

        ACTION_PGPMIME_SIGN:
        begin
          lbSelectKey.Caption := sSelectKeysForSigning;
          lbKeyring.Caption := 'Secret keyring:';
        end;

        ACTION_PGPMIME_VERIFY:
          lbSelectKeys.Caption := sSelectKeysForVerifying;
      end;

      if (Action = ACTION_PGPMIME_ENCRYPT) or
         (Action = ACTION_PGPMIME_SIGN) then
        PageControl.ActivePageIndex := tsSelectKey.PageIndex
      else
        PageControl.ActivePageIndex := tsSelectKeys.PageIndex;
    end;

    PAGE_CHECK_DATA:
    begin
      case Action of
        ACTION_SMIME_ENCRYPT, ACTION_PGPMIME_ENCRYPT:
        begin
          lbInfo.Caption := sInfoEncryption;
          btnDoIt.Caption := 'Encrypt';

          mmInfo.Clear;
          mmInfo.Lines.Add('File to encrypt: ' + edInputFile.Text);
          mmInfo.Lines.Add('');
          mmInfo.Lines.Add('File to write encrypted data: ' + edOutputFile.Text);
          mmInfo.Lines.Add('');
          if Action = ACTION_SMIME_ENCRYPT then
          begin
            mmInfo.Lines.Add('Certificates: ');
            mmInfo.Lines.Text := mmInfo.Lines.Text + WriteCertificateInfo(FMemoryCertStorage);
            mmInfo.Lines.Add('Algorithm: ' + GetAlgorithmName());
          end
          else
          begin
            mmInfo.Lines.Add('Keys: ');
            mmInfo.Lines.Text := mmInfo.Lines.Text + WriteKeyringInfo(FPublicRing);
          end;
        end;

        ACTION_SMIME_SIGN, ACTION_PGPMIME_SIGN:
        begin
          lbInfo.Caption := sInfoSigning;
          btnDoIt.Caption := 'Sign';

          mmInfo.Clear;
          mmInfo.Lines.Add('File to sign: ' + edInputFile.Text);
          mmInfo.Lines.Add('');
          mmInfo.Lines.Add('File to write signed data: ' + edOutputFile.Text);
          mmInfo.Lines.Add('');
          if Action = ACTION_SMIME_SIGN then
          begin
            mmInfo.Lines.Add('Certificates: ');
            mmInfo.Lines.Text := mmInfo.Lines.Text + WriteCertificateInfo(FMemoryCertStorage);
            mmInfo.Lines.Add('Algorithm: ' + GetSignAlgorithm());
          end
          else
          begin
            mmInfo.Lines.Add('Keys: ');
            mmInfo.Lines.Text := mmInfo.Lines.Text + WriteKeyringInfo(FSecretRing);
          end;
        end;

        ACTION_SMIME_DECRYPT, ACTION_PGPMIME_DECRYPT:
        begin
          lbInfo.Caption := sInfoDecryption;
          btnDoIt.Caption := 'Decrypt';

          mmInfo.Clear;
          mmInfo.Lines.Add('File to decrypt: ' + edInputFile.Text);
          mmInfo.Lines.Add('');
          mmInfo.Lines.Add('File to write decrypted data: ' + edOutputFile.Text);
          mmInfo.Lines.Add('');
          if Action = ACTION_SMIME_DECRYPT then
          begin
            mmInfo.Lines.Add('Certificates: ');
            mmInfo.Lines.Text := mmInfo.Lines.Text + WriteCertificateInfo(FMemoryCertStorage);
          end
          else
          begin
            mmInfo.Lines.Add('Keys: ');
            mmInfo.Lines.Text := mmInfo.Lines.Text + WriteKeyringInfo(FKeyring);
          end;
        end;

        ACTION_SMIME_VERIFY, ACTION_PGPMIME_VERIFY:
        begin
          lbInfo.Caption := sInfoVerifying;
          btnDoIt.Caption := 'Verify';

          mmInfo.Clear;
          mmInfo.Lines.Add('File to verify: ' + edInputFile.Text);
          mmInfo.Lines.Add('');
          if Action = ACTION_SMIME_VERIFY then
          begin
            mmInfo.Lines.Add('Certificates: ');
            mmInfo.Lines.Text := mmInfo.Lines.Text + WriteCertificateInfo(FMemoryCertStorage);
          end
          else
          begin
            mmInfo.Lines.Add('Keys: ');
            mmInfo.Lines.Text := mmInfo.Lines.Text + WriteKeyringInfo(FKeyring);
          end;
        end;
      end;

      PageControl.ActivePageIndex := tsCheckData.PageIndex;
    end;

    PAGE_PROCESS:
    begin
      case Action of
        ACTION_SMIME_ENCRYPT, ACTION_PGPMIME_ENCRYPT:
          lbResult.Caption := 'Encryption results:';

        ACTION_SMIME_SIGN, ACTION_PGPMIME_SIGN:
          lbResult.Caption := 'Signing results:';

        ACTION_SMIME_DECRYPT, ACTION_PGPMIME_DECRYPT:
          lbResult.Caption := 'Decryption results:';

        ACTION_SMIME_VERIFY, ACTION_PGPMIME_VERIFY:
          lbResult.Caption := 'Verifying results:';
      else
        lbResult.Caption := 'Results:';
      end;

      mmResult.Text := 'Processing...';

      PageControl.ActivePageIndex := tsResult.PageIndex;
      Cursor := crHourGlass;
    end;
  else
    PageControl.ActivePageIndex := tsSelectAction.PageIndex;
    Page := PAGE_SELECT_ACTION;
  end;

  btnBack.Enabled := (Page <> PAGE_SELECT_ACTION) and (Page <> PAGE_PROCESS);
  btnNext.Enabled := (Page <> PAGE_CHECK_DATA);
  if Page = PAGE_PROCESS then
  begin
    btnNext.Caption := 'New Task';
    btnCancel.Caption := 'Finish';
  end
  else
  begin
    btnNext.Caption := 'Next >';
    btnCancel.Caption := 'Cancel';
  end;

  CurrentPage := Page;
end;

procedure TfrmMain.SetResults(const Res: string);
begin
  Cursor := crDefault;
  if Res <> '' then
    mmResult.Text := Res
  else
    mmResult.Text := 'Finished. Unknown status.';
end;

function TfrmMain.SMimeDecrypt(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 TElMessagePartHandlerSMime then
      begin
        TElMessagePartHandlerSMime(Msg.MainPart.MessagePartHandler).CertificatesStorage := FMemoryCertStorage;

        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.SMimeDecryptNext;
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_CERTIFICATES;
    end;

    PAGE_SELECT_CERTIFICATES:
    begin
     if FMemoryCertStorage.Count = 0 then
       MessageDlg('No recipient certificate 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
  begin
    Application.ProcessMessages;
    SetResults( SMimeDecrypt(edInputFile.Text, edOutputFile.Text) );
  end;
end;

function TfrmMain.SMimeEncrypt(const InputFileName, OutputFileName: string;
     const CryptAlgorithm, CryptAlgorithmBitsInKey: Integer): string;
var
  Msg: TElMessage;
  Stream: TFileStream;
  SMime: TElMessagePartHandlerSMime;
  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, True);
  except
    on E: Exception do
    begin
      Result := E.Message;
      Res := EL_ERROR;
    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;

  SMime := TElMessagePartHandlerSMime.Create(nil);
  SMime.EncoderCryptCertStorage := FMemoryCertStorage;
  Msg.MainPart.MessagePartHandler := SMime;

  SMime.EncoderCrypted := True;
  SMime.EncoderCryptBitsInKey := CryptAlgorithmBitsInKey;
  SMime.EncoderCryptAlgorithm := CryptAlgorithm;