mainform.pas

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

  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 encrypted and assembled OK'
  else
  begin
    if Result <> '' then
      Result := 'Message: "' + Result + '"'
    else
      if Res = EL_HANDLERR_ERROR then
        Result := 'Message: "' + SMime.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.SMimeEncryptNext;
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_SELECT_ALGORITHM;
    end;

    PAGE_SELECT_ALGORITHM:
    begin
      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( SMimeEncrypt(edInputFile.Text, edOutputFile.Text, GetAlgorithm(), GetAlgorithmBitsInKey()) );
  end;
end;

function TfrmMain.SMimeSign(const InputFileName, OutputFileName: string;
  const SignAlgorithm: string): 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.EncoderSignCertStorage := FMemoryCertStorage;
  Msg.MainPart.MessagePartHandler := SMime;

  SMime.EncoderSigned := True;
  SMime.EncoderSignOnlyClearFormat := True;
  SMime.EncoderMicalg := SignAlgorithm;

  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 signed and assembled OK'
  else
  begin
    if Result <> '' then
    begin
      Result := 'Message: "' + Result + '"';
      if Pos(IntToStr(SB_MESSAGE_ERROR_NO_CERTIFICATE), Result) > 0 then
        Result := Result + ' (at least one certificate should be loaded with corresponding sender (from email for message should be equal to certificate email field or to SubjectAlternativeName))';
    end
    else
      if Res = EL_HANDLERR_ERROR then
        Result := 'Message: "' + SMime.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.SMimeSignNext;
var
  i, NextPage: Integer;
  Found: Boolean;
{$IFDEF DELPHI_NET}
  Buf: array of Byte;
  Sz: Integer;
{$ELSE}
  Sz: Word;
{$ENDIF}
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
      Found := False;
      for i := 0 to FMemoryCertStorage.Count - 1 do
      begin
        Sz := 0;
{$IFDEF DELPHI_NET}
        SetLength(Buf, 0);
        FMemoryCertStorage.Certificates[i].SaveKeyToBuffer(Buf, Sz);
{$ELSE}
        FMemoryCertStorage.Certificates[i].SaveKeyToBuffer(nil, Sz);
{$ENDIF}
        if (Sz > 0) then
        begin
          Found := True;
          Break;
        end;
      end;

      if not Found then
        MessageDlg('At least one certificate should be loaded with corresponding private key',
            mtError, [mbOk], 0)
      else
        NextPage := PAGE_SELECT_ALGORITHM;
    end;

    PAGE_SELECT_ALGORITHM:
    begin
      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( SMimeSign(edInputFile.Text, edOutputFile.Text, GetSignAlgorithm()) );
  end;
end;

function TfrmMain.SMimeVerify(const InputFileName: string): string;
var
  Msg: TElMessage;
  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;

        with TElMessagePartHandlerSMime(Msg.MainPart.MessagePartHandler) do
{$IFDEF DELPHI_NET}
          if Errors <> 0 then
{$ELSE}
          if Errors <> [] then
{$ENDIF}
          begin
            if Result <> '' then
              Result := Result + #13#10;

            Result := Result + 'Errors: ';
{$IFDEF DELPHI_NET}
            if (smeUnknown and Errors) <> 0 then
{$ELSE}
            if smeUnknown in Errors then
{$ENDIF}
              Result := Result + 'smeUnknown, ';

{$IFDEF DELPHI_NET}
            if (smeSignaturePartNotFound and Errors) <> 0 then
{$ELSE}
            if smeSignaturePartNotFound in Errors then
{$ENDIF}
              Result := Result + 'smeSignaturePartNotFound, ';

{$IFDEF DELPHI_NET}
            if (smeBodyPartNotFound and Errors) <> 0 then
{$ELSE}
            if smeBodyPartNotFound in Errors then
{$ENDIF}
              Result := Result + 'smeBodyPartNotFound, ';

{$IFDEF DELPHI_NET}
            if (smeInvalidSignature and Errors) <> 0 then
{$ELSE}
            if smeInvalidSignature in Errors then
{$ENDIF}
              Result := Result + 'smeInvalidSignature, ';

{$IFDEF DELPHI_NET}
            if (smeSigningCertificateMismatch and Errors) <> 0 then
{$ELSE}
            if smeSigningCertificateMismatch in Errors then
{$ENDIF}
              Result := Result + 'smeSigningCertificateMismatch, ';

{$IFDEF DELPHI_NET}
            if (smeEncryptingCertificateMismatch and Errors) <> 0 then
{$ELSE}
            if smeEncryptingCertificateMismatch in Errors then
{$ENDIF}
              Result := Result + 'smeEncryptingCertificateMismatch, ';

{$IFDEF DELPHI_NET}
            if (smeNoData and Errors) <> 0 then
{$ELSE}
            if smeNoData in Errors then
{$ENDIF}
              Result := Result + 'smeNoData, ';

            SetLength(Result, Length(Result) - 2);
          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]);
  end
  else
  begin
    Result := 'Message verified OK';
    if Assigned(Msg.MainPart.MessagePartHandler) and
       (Msg.MainPart.MessagePartHandler is TElMessagePartHandlerSMime) then
    begin
      Result := Result + #13#10#13#10'Signed with:'#13#10;
      Result := Result + WriteCertificateInfo(TElMessagePartHandlerSMime(Msg.MainPart.MessagePartHandler).DecoderSignCertStorage);
    end;
  end;

  Msg.Free;
end;

procedure TfrmMain.SMimeVerifyNext;
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 = '' then
        MessageDlg(sSelectInputFiles, mtError, [mbOk], 0)
      else
        NextPage := PAGE_SELECT_CERTIFICATES;
    end;

    PAGE_SELECT_CERTIFICATES:
    begin
      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( SMimeVerify(edInputFile.Text{, edOutputFile.Text}) );
  end;
end;

procedure TfrmMain.UpdateCertificatesList;
var
  i: Integer;
  s