mainform.pas

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

  begin
    Application.ProcessMessages;
    SetResults( PGPDecrypt(edInputFile.Text, edOutputFile.Text) );
  end;
end;

function TfrmMain.PGPEncrypt(const InputFileName, OutputFileName: string): string;
var
  Msg: TElMessage;
  Stream: TFileStream;
  PGPMime: TElMessagePartHandlerPGPMime;
  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;

  PGPMime := TElMessagePartHandlerPGPMime.Create(nil);
  Msg.MainPart.MessagePartHandler := PGPMime;

  PGPMime.EncryptingKeys := FPublicRing;
//  PGPMime.OnKeyPassphrase := PGPMIMEKeyPassphrase;
  PGPMime.Encrypt := True;

  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: "' + PGPMime.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.PGPEncryptNext;
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 FPublicRing.PublicCount = 0 then
       MessageDlg('No public key 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( PGPEncrypt(edInputFile.Text, edOutputFile.Text) );
  end;
end;

procedure TfrmMain.PGPMIMEKeyPassphrase(Sender: TObject;
  Key: TElPGPCustomSecretKey; var Passphrase: string; var Cancel: boolean);
begin
  Passphrase := '';
  Cancel := not InputQuery('Password request',
         'Please enter password for key ' + KeyID2Str(Key.KeyID), Passphrase);
end;

function TfrmMain.PGPSign(const InputFileName, OutputFileName: string): string;
var
  Msg: TElMessage;
  Stream: TFileStream;
  PGPMime: TElMessagePartHandlerPGPMime;
  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;

  PGPMime := TElMessagePartHandlerPGPMime.Create(nil);
  Msg.MainPart.MessagePartHandler := PGPMime;

  PGPMime.SigningKeys := FSecretRing;
  PGPMime.OnKeyPassphrase := PGPMIMEKeyPassphrase;
  PGPMime.Sign := True;

  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
      Result := 'Message: "' + Result + '"'
    else
      if Res = EL_HANDLERR_ERROR then
        Result := 'Message: "' + PGPMime.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.PGPSignNext;
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 FSecretRing.SecretCount = 0 then
       MessageDlg('No secret key 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( PGPSign(edInputFile.Text, edOutputFile.Text) );
  end;
end;

function TfrmMain.PGPVerify(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 TElMessagePartHandlerPGPMime then
      begin
        with TElMessagePartHandlerPGPMime(Msg.MainPart.MessagePartHandler) do
        begin
          VerifyingKeys := 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]);
  end
  else
  begin
    if (Res = EL_WARNING) and Assigned(Msg.MainPart.MessagePartHandler) and
       (Msg.MainPart.MessagePartHandler.ErrorText <> '') then
      Result := 'Message: "' + Msg.MainPart.MessagePartHandler.ErrorText + '"'
    else
      Result := 'Message verified OK';
      
    if Assigned(Msg.MainPart.MessagePartHandler) and
       (Msg.MainPart.MessagePartHandler is TElMessagePartHandlerPGPMime) then
    begin
      Result := Result + #13#10#13#10'Signature verified with:'#13#10;
      Result := Result + WriteKeyringInfo(TElMessagePartHandlerPGPMime(Msg.MainPart.MessagePartHandler).VerifyingKeys);
    end;
  end;

  Msg.Free;
end;

procedure TfrmMain.PGPVerifyNext;
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_KEYS;
    end;

    PAGE_SELECT_KEYS:
    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( PGPVerify(edInputFile.Text) );
  end;
end;

procedure TfrmMain.sbInputFileClick(Sender: TObject);
begin
  OpenDlg.Title := 'Select input file';
  OpenDlg.Filter := 'Message files (*.eml)|*.eml|All files (*.*)|*.*';
  OpenDlg.FileName := edInputFile.Text;
  if OpenDlg.Execute then
    edInputFile.Text := OpenDlg.FileName;
end;

procedure TfrmMain.sbKeyringClick(Sender: TObject);
var
  F: TFileStream;
begin
  OpenDlg.Title := 'Select input file';
  OpenDlg.Filter := 'PGP Keyring files (*.asc, *.pkr, *.skr, *.gpg, *.pgp)|*.asc;*.pkr;*.skr;*.gpg;*.pgp';
  OpenDlg.FileName := edKeyring.Text;
  if OpenDlg.Execute then
  begin
    F := TFileStream.Create(OpenDlg.Filename, fmOpenRead);
    try
      try
        if Action = ACTION_PGPMIME_ENCRYPT then
          FPublicRing.Load(F, nil, True)
        else if Action = ACTION_PGPMIME_SIGN then
          FSecretRing.Load(F, nil, True);
      finally
        F.Free;
      end;
    except
      edKeyring.Text := '';
      Exit;
    end;

    edKeyring.Text := OpenDlg.Filename;
  end;
end;

procedure TfrmMain.sbOutputFileClick(Sender: TObject);
begin
  SaveDlg.Title := 'Select output file';
  SaveDlg.Filter := 'Message files (*.eml)|*.eml|All files (*.*)|*.*';