fmain.pas

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

begin
  // call ProcessBodyLine method of verifier for each line of the message body
  for I := 0 to memMessageBody.Lines.Count - 1 do
  begin
    Result := FVerifier.ProcessBodyLine(memMessageBody.Lines[I]);
    if Result <> SB_DK_VERIFIER_ERROR_SUCCESS then
    begin
      // SB_DK_VERIFIER_ERROR_INVALID_STATE code will be returned if
      // ProcessBodyLine is called before ProcessHeader; so this
      // code will not be returned in this demo app
      lblStep3Result.Caption := 'Internal error';
      // disable the current step; Reset method of verifier must be called
      // to process next message
      btnProcessBody.Enabled := False;
      Exit;
    end;
  end;
  // the body is processed successfully
  lblStep3Result.Caption := 'Succeeded';
  // enable the next step
  btnQueryDNS.Enabled := True;
  // and disable the current one
  btnProcessBody.Enabled := False;
  // scroll the form to make Step 4 controls visible
  ScrollInView(btnVerify);
end;

procedure TfrmMain.btnQueryDNSClick(Sender: TObject);
var
  SenderRecord, AuthorRecord: string;
  Result: Integer;
begin
  // get DNS records
  SenderRecord := '';
  AuthorRecord := '';
  Application.CreateForm(TfrmDNS, frmDNS);
  try
    if not frmDNS.Execute(edtSenderDomain.Text, edtAuthorDomain.Text, SenderRecord, AuthorRecord) then
      Exit;
    // clear controls
    lblSenderGranularity.Caption := '';
    lblSenderTestMode.Caption := '';
    edtSenderNotes.Text := '';
    lblSenderPublicKey.Caption := '';
    lblSenderRevoked.Caption := '';
    lblAuthorGranularity.Caption := '';
    lblAuthorTestMode.Caption := '';
    edtAuthorNotes.Text := '';
    lblAuthorPublicKey.Caption := '';
    lblAuthorRevoked.Caption := '';
    // parse Sender DNS record
    if SenderRecord <> '' then
    begin
      Result := FSenderRecord.Load(SenderRecord);
      if Result = SB_DK_DNS_ERROR_SUCCESS then
      begin
        // the record was parsed successfully
        lblSenderGranularity.Caption := FSenderRecord.KeyGranularity;
        if FSenderRecord.TestMode then
          lblSenderTestMode.Caption := 'YES'
        else
          lblSenderTestMode.Caption := 'NO';
        edtSenderNotes.Text := FSenderRecord.Notes;
        if FSenderRecord.PublicKey.Available then
        begin
          if FSenderRecord.PublicKey.KeyType = dkRSA then
            lblSenderPublicKey.Caption := 'RSA'
          else
            lblSenderPublicKey.Caption := 'Unknown';
        end
        else
          lblSenderPublicKey.Caption := 'Not Available';
        if FSenderRecord.PublicKey.Revoked then
          lblSenderRevoked.Caption := 'YES'
        else
          lblSenderRevoked.Caption := 'NO';
      end
      else
      begin
        // failed to parse the record
        case Result of
          SB_DK_DNS_ERROR_NODATA:
            begin
              // returned if the record is empty
              edtSenderNotes.Text := 'No DNS record data';
            end;
          SB_DK_DNS_ERROR_NOPARAMS:
            begin
              // returned if failed to parse DNS record parameters
              edtSenderNotes.Text := 'Invalid record format';
            end;
          SB_DK_DNS_ERROR_NOKEY:
            begin
              // returned if there is no key specified in the record
              lblSenderPublicKey.Caption := 'Not specified';
            end;
          SB_DK_DNS_ERROR_INVALID_KEYTYPE:
            begin
              // returned if failed to recognize the key type
              lblSenderPublicKey.Caption := 'Invalid key type';
            end;
          SB_DK_DNS_ERROR_INVALID_KEYDATA:
            begin
              // returned if failed to parse the key data
              lblSenderPublicKey.Caption := 'Invalid key format';
            end;
        else
          // unknown error
          edtSenderNotes.Text := 'Internal error';
        end;
      end;
    end;
    // parse Author DNS record
    if AuthorRecord <> '' then
    begin
      Result := FAuthorRecord.Load(AuthorRecord);
      if Result = SB_DK_DNS_ERROR_SUCCESS then
      begin
        // the record was parsed successfully
        lblAuthorGranularity.Caption := FAuthorRecord.KeyGranularity;
        if FAuthorRecord.TestMode then
          lblAuthorTestMode.Caption := 'YES'
        else
          lblAuthorTestMode.Caption := 'NO';
        edtAuthorNotes.Text := FAuthorRecord.Notes;
        if FAuthorRecord.PublicKey.Available then
        begin
          if FAuthorRecord.PublicKey.KeyType = dkRSA then
            lblAuthorPublicKey.Caption := 'RSA'
          else
            lblAuthorPublicKey.Caption := 'Unknown';
        end
        else
          lblAuthorPublicKey.Caption := 'Not Available';
        if FAuthorRecord.PublicKey.Revoked then
          lblAuthorRevoked.Caption := 'YES'
        else
          lblAuthorRevoked.Caption := 'NO';
      end
      else
      begin
        // failed to parse the record
        case Result of
          SB_DK_DNS_ERROR_NODATA:
            begin
              // returned if the record is empty
              edtAuthorNotes.Text := 'No DNS record data';
            end;
          SB_DK_DNS_ERROR_NOPARAMS:
            begin
              // returned if failed to parse DNS record parameters
              edtAuthorNotes.Text := 'Invalid record format';
            end;
          SB_DK_DNS_ERROR_NOKEY:
            begin
              // returned if there is no key specified in the record
              lblAuthorPublicKey.Caption := 'Not specified';
            end;
          SB_DK_DNS_ERROR_INVALID_KEYTYPE:
            begin
              // returned if failed to recognize the key type
              lblAuthorPublicKey.Caption := 'Invalid key type';
            end;
          SB_DK_DNS_ERROR_INVALID_KEYDATA:
            begin
              // returned if failed to parse the key data
              lblAuthorPublicKey.Caption := 'Invalid key format';
            end;
        else
          // unknown error
          edtAuthorNotes.Text := 'Internal error';
        end;
      end;
    end;
    // enable the next step
    btnVerify.Enabled := True;
    // scroll the form to the last step
    ScrollInView(pnlBottom);
  finally
    FreeAndNil(frmDNS);  
  end;
end;

procedure TfrmMain.btnVerifyClick(Sender: TObject);
var
  Status: TSBDKStatus;
begin
  // disable the previous step
  btnQueryDNS.Enabled := False;
  // verify signatures
  Status := FVerifier.SenderSignature.Verify(FSenderRecord);
  case Status of
    dkGood:
      lblSenderSignature.Caption := 'VERIFIED SUCCESSFULLY';
    dkBad:
      lblSenderSignature.Caption := 'INVALID SIGNATURE';
    dkNoKey:
      lblSenderSignature.Caption := 'NO DOMAIN KEY IS AVAILABLE';
    dkRevoked:
      lblSenderSignature.Caption := 'THE DOMAIN KEY IS REVOKED';
    dkNoSignature:
      lblSenderSignature.Caption := 'NOT AVAILABLE';
    dkBadFormat:
      lblSenderSignature.Caption := 'SIGNATURE ALGORITHM DOES NOT MATCH PUBLIC KEY ALGORITHM';
  else
    lblSenderSignature.Caption := 'INTERNAL ERROR';
  end;
  Status := FVerifier.AuthorSignature.Verify(FAuthorRecord);
  case Status of
    dkGood:
      lblAuthorSignature.Caption := 'VERIFIED SUCCESSFULLY';
    dkBad:
      lblAuthorSignature.Caption := 'INVALID SIGNATURE';
    dkNoKey:
      lblAuthorSignature.Caption := 'NO DOMAIN KEY IS AVAILABLE';
    dkRevoked:
      lblAuthorSignature.Caption := 'THE DOMAIN KEY IS REVOKED';
    dkNoSignature:
      lblAuthorSignature.Caption := 'NOT AVAILABLE';
    dkBadFormat:
      lblAuthorSignature.Caption := 'SIGNATURE ALGORITHM DOES NOT MATCH PUBLIC KEY ALGORITHM';
  else
    lblAuthorSignature.Caption := 'INTERNAL ERROR';
  end;
  // disable the current step
  btnVerify.Enabled := False;
  // scroll to bottom
  ScrollInView(pnlBottom);
end;

procedure TfrmMain.btnResetClick(Sender: TObject);
begin
  // reset the verifier
  FVerifier.Reset;
  // clear DNS records
  FSenderRecord.Clear;
  FAuthorRecord.Clear;
  // clear controls
  // step 1 - load message
  memMessageHeader.Lines.Clear;
  memMessageBody.Lines.Clear;
  // step 2 - process header
  lblStep2Result.Caption := '';
  lblSenderAvailable.Caption := '';
  lblSenderDomain.Caption := '';
  lblSenderSelector.Caption := '';
  lblSenderQueryType.Caption := '';
  lblSenderSignatureAlgorithm.Caption := '';
  lblSenderDigestAlgorithm.Caption := '';
  lblAuthorAvailable.Caption := '';
  lblAuthorDomain.Caption := '';
  lblAuthorSelector.Caption := '';
  lblAuthorQueryType.Caption := '';
  lblAuthorSignatureAlgorithm.Caption := '';
  lblAuthorDigestAlgorithm.Caption := '';
  // step 3 - process body
  lblStep3Result.Caption := '';
  // step 4 - query DNS
  edtSenderDomain.Text := '';
  lblSenderGranularity.Caption := '';
  lblSenderTestMode.Caption := '';
  edtSenderNotes.Text := '';
  lblSenderPublicKey.Caption := '';
  lblSenderRevoked.Caption := '';
  edtAuthorDomain.Text := '';
  lblAuthorGranularity.Caption := '';
  lblAuthorTestMode.Caption := '';
  edtAuthorNotes.Text := '';
  lblAuthorPublicKey.Caption := '';
  lblAuthorRevoked.Caption := '';
  // step 5 - verify
  lblSenderSignature.Caption := '';
  lblAuthorSignature.Caption := '';
  // enable the first step
  btnLoadMessage.Enabled := True;
  // scroll to top
  ScrollInView(pnlTop);
end;


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


end.