mainform.pas

著名的SecureBlackBox控件完整源码

    if (MessageDlg('Are you sure you want to remove the key (' + GetDefaultUserID(key) + ')?',
                  mtConfirmation, [mbYes, mbNo], 0) = mrYes) then
    begin
      if (key.SecretKey <> nil) then
      begin
        if (MessageDlg('The key you want to remove is SECRET! Are you still sure?',
                  mtConfirmation, [mbYes, mbNo], 0) <> mrYes) then
          Exit;
      end;

      pgpKeyring.RemovePublicKey(Key, True);
      RedrawKeyring(tvKeyring, pgpKeyring);
      SetStatus('Key was successfully removed');
    end;
  end;
end;

procedure TfrmKeys.actExportKeyExecute(Sender: TObject);
var
  Key: TElPGPPublicKey;
begin
  if ((tvKeyring.Selected <> nil) and (TObject(tvKeyring.Selected.Data) is TElPGPPublicKey)) then
  begin
    Key := TElPGPPublicKey(tvKeyring.Selected.Data);
    if SaveDlg.Execute then
    begin
      Key.SaveToFile(SaveDlg.FileName, True);
      SetStatus('Key saved');
    end;
  end;
end;

procedure TfrmKeys.actSignUpdate(Sender: TObject);
begin
  (Sender as TAction).Enabled := (tvKeyring.Selected <> nil) and
    (tvKeyring.Selected.Level < 2);
end;

function TfrmKeys.SignUser(user: TElPGPCustomUser; userKey: TElPGPCustomPublicKey; signingKey: TElPGPSecretKey): TElPGPSignature;
var
  Sig: TElPGPSignature;
begin
  Sig := TElPGPSignature.Create();
  Sig.CreationTime := Now;
  try
    signingKey.Sign(TElPGPPublicKey(userKey), user, sig, ctGeneric);
  except
    // Exception. Possibly, passphrase is needed.
    signingKey.Passphrase := RequestPassphrase(signingKey.PublicKey);
    try
      signingKey.Sign(TElPGPPublicKey(userKey), user, sig, ctGeneric);
    except
      on E: Exception do
      begin
        MessageDlg(E.Message, mtError, [mbOK], 0);
        FreeAndNil(Sig);
      end;
    end;
  end;

  Result := Sig;
end;

procedure TfrmKeys.actSignExecute(Sender: TObject);
var
  i: Integer;
  Sig: TElPGPSignature;
begin
  if pgpKeyring.SecretCount = 0 then
  begin
    MessageDlg('There is no secret keys', mtError, [mbOK], 0);
    Exit;
  end;

  if ((tvKeyring.Selected <> nil) and (tvKeyring.Selected.Data <> nil)) then
  begin
    if (TObject(tvKeyring.Selected.Data) is TElPGPCustomUser) and
       (tvKeyring.Selected.Parent <> nil) and
       (TObject(tvKeyring.Selected.Parent.Data) is TElPGPPublicKey) then
    begin
      with TfrmPrivateKeys.Create(Self) do
        try
          lstKeys.Items.Clear();
          for i := 0 to pgpKeyring.SecretCount - 1 do
            lstKeys.Items.Add(GetDefaultUserID(pgpKeyring.SecretKeys[i].PublicKey));

          if (ShowModal = mrOK) then
          begin
            i := 0;
            while (i < lstKeys.Items.Count) and (not lstKeys.Selected[i]) do
              Inc(i);

            sig := SignUser(TElPGPCustomUser(tvKeyring.Selected.Data),
                      TElPGPPublicKey(tvKeyring.Selected.Parent.Data),
                      pgpKeyring.SecretKeys[i]);

            if (sig <> nil) then
            begin
              (TElPGPCustomUser(tvKeyring.Selected.Data)).AddSignature(sig);
              RedrawKeyring(tvKeyring, pgpKeyring);
              SetStatus('Signed successfully');
            end;
          end;
        finally
          Free;
        end;
    end
    else
      MessageDlg('Only User information may be signed', mtError, [mbOK], 0);
  end;
end;

function TfrmKeys.RevokeUser(user: TElPGPCustomUser; userKey: TElPGPCustomPublicKey; signingKey: TElPGPSecretKey): TElPGPSignature;
var
  Sig: TElPGPSignature;
begin
  sig := TElPGPSignature.Create();
  sig.CreationTime := Now;
  try
    signingKey.Revoke(TElPGPPublicKey(userKey), user, sig, nil);
  except
    // Exception. Possibly, passphrase is needed.
    signingKey.Passphrase := RequestPassphrase(signingKey.PublicKey);
    try
      signingKey.Revoke(TElPGPPublicKey(userKey), user, sig, nil);
    except
      on E: Exception do
      begin
        MessageDlg(E.Message, mtError, [mbOK], 0);
        FreeAndNil(Sig);
      end;
    end;
  end;

  Result := Sig;
end;

procedure TfrmKeys.actRevokeExecute(Sender: TObject);
var
  i: Integer;
  Sig: TElPGPSignature;
begin
  if pgpKeyring.SecretCount = 0 then
  begin
    MessageDlg('There is no secret keys', mtError, [mbOK], 0);
    Exit;
  end;

  if ((tvKeyring.Selected <> nil) and (tvKeyring.Selected.Data <> nil)) then
  begin
    if (TObject(tvKeyring.Selected.Data) is TElPGPCustomUser) and
       (tvKeyring.Selected.Parent <> nil) and
       (TObject(tvKeyring.Selected.Parent.Data) is TElPGPPublicKey) then
    begin
      with TfrmPrivateKeys.Create(Self) do
        try
          lstKeys.Items.Clear();
          for i := 0 to pgpKeyring.SecretCount - 1 do
            lstKeys.Items.Add(GetDefaultUserID(pgpKeyring.SecretKeys[i].PublicKey));

          if (ShowModal = mrOK) then
          begin
            i := 0;
            while (i < lstKeys.Items.Count) and (not lstKeys.Selected[i]) do
              Inc(i);

            sig := RevokeUser(TElPGPCustomUser(tvKeyring.Selected.Data),
                      TElPGPPublicKey(tvKeyring.Selected.Parent.Data),
                      pgpKeyring.SecretKeys[i]);

            if (sig <> nil) then
            begin
              (TElPGPCustomUser(tvKeyring.Selected.Data)).AddSignature(sig);
              RedrawKeyring(tvKeyring, pgpKeyring);
              SetStatus('Revoked successfully');
            end;
          end;
        finally
          Free;
        end;
    end
    else
      MessageDlg('Only User information may be revoked', mtError, [mbOK], 0);
  end;
end;

function TfrmKeys.RequestPassphrase(Key: TElPGPPublicKey): string;
begin
  Result := '';
  with TfrmPassphraseRequest.Create(Self) do
    try
      lbKeyID.Caption := GetDefaultUserID(key) + ' (' + KeyID2Str(key.KeyID(), true) + ')';
      if ShowModal = mrOK then
        Result := edPassphrase.Text;
    finally
      Free;
    end;
end;

procedure TfrmKeys.SetStatus(s: string);
begin
  sbrMain.SimpleText := s;
end;

procedure TfrmKeys.HideAllInfoPanels();
begin
  pKeyInfo.Visible := False;
  pUserInfo.Visible := False;
  pSigInfo.Visible := False;
end;

procedure TfrmKeys.EnableView(p: TPanel);
begin
  p.Align := alClient;
  p.Visible := True;
end;

procedure TfrmKeys.DrawPublicKeyProps(key: TElPGPCustomPublicKey);
begin
  HideAllInfoPanels();
  lbKeyAlgorithm.Caption := 'Algorithm: ' + PKAlg2Str(Key.PublicKeyAlgorithm) + ' (' + IntToStr(Key.BitsInKey) + ' bits)';
  lbKeyID.Caption := 'KeyID: ' + KeyID2Str(key.KeyID(), False);
  lbKeyFP.Caption := 'KeyFP: ' + KeyFP2Str(key.KeyFP());
  lbTimestamp.Caption := 'Created: ' + FormatDateTime('yyyy/mm/dd hh:nn:ss', Key.Timestamp);
  if Key.Expires = 0 then
    lbExpires.Caption := 'Expires: NEVER'
  else
    lbExpires.Caption := 'Expires: ' + FormatDateTime('yyyy/mm/dd hh:nn:ss', key.Timestamp + key.Expires);

  EnableView(pKeyInfo);
end;

procedure TfrmKeys.DrawUserIDProps(user: TElPGPUserID);
begin
  HideAllInfoPanels();
  picUser.Visible := False;
  lbUserName.Visible := True;
  lbUserName.Caption := 'User name: ' + user.Name;
  EnableView(pUserInfo);
end;

procedure TfrmKeys.DrawUserAttrProps(user: TElPGPUserAttr);
{var
  strm: TMemoryStream;}
begin
// Load picture (Jpeg format)
  HideAllInfoPanels();
{  strm := TMemoryStream.Create();
  picUser.Visible := True;
  lbUserName.Visible := False;
  strm.Write(user.Images[0].JpegData[0], 0, Length(user.get_Images(0).JpegData));
  strm.Position := 0;
  picUser.Image := System.Drawing.Image.FromStream(strm);
  EnableView(pUserInfo);}
end;

procedure TfrmKeys.DrawSignatureProps(sig: TElPGPSignature; user: TElPGPCustomUser; userKey: TElPGPCustomPublicKey);
var
  Validity: string;
  Key: TElPGPCustomPublicKey;
begin
  Validity := 'Unable to verify';
  Key := nil;
  HideAllInfoPanels();
  pgpKeyring.FindPublicKeyByID(sig.SignerKeyID(), Key, 0);

  if Key <> nil then
  begin
    if Key is TElPGPPublicKey then
    begin
      lbSigner.Caption := 'Signer: ' + GetDefaultUserID(TElPGPPublicKey(key));
      if user <> nil then
      begin
        try
          if (sig.IsUserRevocation()) then
          begin
            if (key.RevocationVerify(userKey, user, sig)) then
              validity := 'Valid'
            else
              validity := 'INVALID';
          end
	  else
          begin
            if (key.Verify(userKey, user, sig)) then
              validity := 'Valid'
            else
              validity := 'INVALID';
          end;

        except
          on E: Exception do
            validity := E.Message;
        end;
      end
      else
 	validity := 'UserID not found';
    end
    else
      lbSigner.Caption := 'Signer: Unknown signer';
  end
  else
    lbSigner.Caption := 'Signer: Unknown signer';

  lbSigCreated.Caption := FormatDateTime('yyyy/mm/dd hh:nn:ss', sig.CreationTime);
  lbValidity.Caption := 'Validity: ' + validity;
  if (sig.IsUserRevocation()) then
    lbSigType.Caption := 'Type: User revocation'
  else
    lbSigType.Caption := 'Type: Certification signature';

  EnableView(pSigInfo);
end;

procedure TfrmKeys.DrawSignatureProps(sig: TElPGPSignature; subkey: TElPGPPublicSubkey; userKey: TElPGPCustomPublicKey);
var
  Validity: string;
begin
  Validity := 'Unable to verify';
  HideAllInfoPanels();

  lbSigner.Caption := 'Signer: ' + GetDefaultUserID(TElPGPPublicKey(userKey));
  if (subkey <> nil) then
  begin
    try
      if (sig.IsSubkeyRevocation()) then
      begin
        if (userKey.RevocationVerify(subkey, sig)) then
          validity := 'Valid'
        else
          validity := 'INVALID';
      end
      else
      begin
        if (userKey.Verify(subkey, sig)) then
          validity := 'Valid'
        else
          validity := 'INVALID';
      end;

     except
       on E: Exception do
         validity := E.Message;
     end;
  end
  else
    validity := 'Subkey not found';

  lbSigCreated.Caption := FormatDateTime('yyyy/mm/dd hh:nn:ss', sig.CreationTime);
  lbValidity.Caption := 'Validity: ' + validity;
  if (sig.IsSubkeyRevocation()) then
    lbSigType.Caption := 'Type: Subkey revocation'
  else
    lbSigType.Caption := 'Type: Subkey binding signature';

  EnableView(pSigInfo);
end;

procedure TfrmKeys.tvKeyringChange(Sender: TObject; Node: TTreeNode);
begin
  if TObject(Node.Data) is TElPGPCustomPublicKey then
    DrawPublicKeyProps(TElPGPCustomPublicKey(Node.Data))
  else if TObject(Node.Data) is TElPGPUserID then
    DrawUserIDProps(TElPGPUserID(Node.Data))
  else if TObject(Node.Data) is TElPGPUserAttr then
    DrawUserAttrProps(TElPGPUserAttr(Node.Data))
  else if TObject(Node.Data) is TElPGPSignature then
  begin
    if ((Node.Parent <> nil) and (TObject(Node.Parent.Data) is TElPGPCustomUser) and
        (Node.Parent.Parent <> nil) and (TObject(Node.Parent.Parent.Data) is TElPGPCustomPublicKey)) then
    begin
      DrawSignatureProps(TElPGPSignature(Node.Data), TElPGPCustomUser(Node.Parent.Data),
                         TElPGPCustomPublicKey(Node.Parent.Parent.Data));
    end
    else if ((Node.Parent <> nil) and (TObject(Node.Parent.Data) is TElPGPPublicSubkey) and
             (Node.Parent.Parent <> nil) and (TObject(Node.Parent.Parent.Data) is TElPGPCustomPublicKey)) then
    begin
      DrawSignatureProps(TElPGPSignature(Node.Data), TElPGPPublicSubkey(Node.Parent.Data),
                         TElPGPCustomPublicKey(Node.Parent.Parent.Data));
    end
    else
    begin
      DrawSignatureProps(TElPGPSignature(Node.Data), TElPGPCustomUser(nil), nil);
    end;
  end;
end;

procedure TfrmKeys.FormCreate(Sender: TObject);
begin
  HideAllInfoPanels();
end;

procedure TfrmKeys.actAboutExecute(Sender: TObject);
begin
  with TfrmAbout.Create(Self) do
    try
      ShowModal;
    finally
      Free;
    end;
end;


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

end.