pgp2comp.pas

来自「用DELPHI实现的 PGP 加密算法」· PAS 代码 · 共 2,057 行 · 第 1/5 页

begin
  if Version<>'' then
    StrPLCopy(MyVersion, Version, pred(SizeOf(TVersionString)))
  else if PGPGetSDKString(MyVersion)<>0 then MyVersion:='N/A';
end;

function GetPGPVersion: String;
begin
  Result:=GetPGPVersionString;
end;

function WipeFiles(const FileNames: TStrings; ParentHandle: THandle): Longbool;
var
  WarnPref	: Longbool;
  PGPsc		: pPGPsc;
  PGPtls	: pPGPtls;
  WipeCount	: PGPUInt32;
  FileIndex	: Longint;
  FileName	: String;
begin
  PGPsc:=nil;
  PGPtls:=nil;
  Result:=false;
  if (FileNames<>nil) then with FileNames do begin
    if GetPrefWarnOnWipe(WarnPref)=0 then SetPrefWarnOnWipe(false);
    try
      if InitPGPsc(ParentHandle, PGPsc, PGPtls, 0) then begin
	try
	  GetPrefWipeCount(WipeCount);
	  for FileIndex:=0 to pred(Count) do begin
	    Result:=false;
	    FileName:=Strings[FileIndex];
	    if FileExists(FileName) then begin
	      Result:=WipeFileList(ParentHandle, PGPsc, CmdLineToFileList(PChar(FileName)), succ(ord(PGP7X)), WipeCount);
	    end;
	    if not Result then Break;
	  end;
	finally
	  UninitPGPsc(ParentHandle, PGPsc, PGPtls);
	end;
      end;
    finally
      SetPrefWarnOnWipe(WarnPref);
    end;
  end;
end;

function ValidPassphrase(const KeyID: String; Passphrase: PChar): Longbool;
var
  Context	: pPGPContext;
  KeySetMain	: pPGPKeySet;
begin
  Result:=false;
  Context:=nil;
  KeySetMain:=nil;
  if KeyRings.InitKeyRings(Context, KeySetMain)=0 then begin
    try
      Result:=PassphraseIsValid(Context, KeySetMain, PChar(KeyID), Passphrase);
    finally
      KeyRings.FreeKeyRings;
    end;
  end;
end;

function GetShortHexID(const HexID: String): String;
begin
  Result:=EMPTY;
  if IsHexID(HexID) then begin
    case Length(HexID) of
      ShortHexIDLen: Result:=HexID;
      LongHexIDLen: Result:='0x' + Copy(HexID, 11, 8)
    end;
  end;
end;

function ValidSecMem(Alloc: PChar): Longbool;
begin
  Result:=(PGPGetMemoryMgrDataInfo(Alloc)=kPGPMemoryMgrBlockInfo_Valid or
					  kPGPMemoryMgrBlockInfo_Secure or
  					  kPGPMemoryMgrBlockInfo_NonPageable);
end;

function SecAlloc(Size: Cardinal): PChar;
begin
  Result:=PGPNewSecureData(PGPGetDefaultMemoryMgr, Size, kPGPMemoryMgrFlags_Clear);
end;

function SecFree(var Alloc: PChar): Longint;
begin
  Result:=kPGPError_BadMemAddress;
  if Alloc<>nil then begin
    Result:=PGPFreeData(Alloc);
    if Result=kPGPError_NoErr then Alloc:=nil;
  end;
end;

function SecRealloc(var Alloc: PChar; Size: Cardinal; Copy: Longbool): Longint;
begin
  Result:=PGPReallocData(PGPGetDefaultMemoryMgr, pointer(Alloc), Size, kPGPMemoryMgrFlags_Clear);
  // kPGPMemoryMgrFlags_Clear only clears excess bytes
  if (Result=kPGPError_NoErr) and not Copy then FillChar(Alloc^, Size, 0);
end;

function GetKeyPropsFlag(const setKeyProps: TKeyProps): DWord;
begin
  Result:=
    DWord(KeyProp_HexID in setKeyProps) * spgpKeyPropFlag_KeyID or
    DWord(KeyProp_UserID in setKeyProps) * spgpKeyPropFlag_UserID or
    DWord(KeyProp_Fingerprint in setKeyProps) * spgpKeyPropFlag_Fingerprint or
    DWord(KeyProp_CreaTimeStr in setKeyProps) * spgpKeyPropFlag_CreationTimeStr or
    DWord(KeyProp_ExpTimeStr in setKeyProps) * spgpKeyPropFlag_ExpirationTimeStr or
    DWord(KeyProp_Size in setKeyProps) * spgpKeyPropFlag_KeyBits or
    DWord(KeyProp_Algorithm in setKeyProps) * spgpKeyPropFlag_KeyAlg or
    DWord(KeyProp_Trust in setKeyProps) * spgpKeyPropFlag_Trust or
    DWord(KeyProp_Validity in setKeyProps) * spgpKeyPropFlag_Validity or
    DWord(KeyProp_CreaTimeNum in setKeyProps) * spgpKeyPropFlag_CreationTime or
    DWord(KeyProp_ExpTimeNum in setKeyProps) * spgpKeyPropFlag_ExpirationTime or
    DWord(KeyProp_Secret in setKeyProps) * spgpKeyPropFlag_IsSecret or
    DWord(KeyProp_ImplicitTrust in setKeyProps) * spgpKeyPropFlag_IsAxiomatic or
    DWord(KeyProp_Revoked in setKeyProps) * spgpKeyPropFlag_IsRevoked or
    DWord(KeyProp_Disabled in setKeyProps) * spgpKeyPropFlag_IsDisabled or
    DWord(KeyProp_Expired in setKeyProps) * spgpKeyPropFlag_IsExpired or
    DWord(KeyProp_SecretShared in setKeyProps) * spgpKeyPropFlag_IsSecretShared or
    DWord(KeyProp_CanEncrypt in setKeyProps) * spgpKeyPropFlag_CanEncrypt or
    DWord(KeyProp_CanDecrypt in setKeyProps) * spgpKeyPropFlag_CanDecrypt or
    DWord(KeyProp_CanSign in setKeyProps) * spgpKeyPropFlag_CanSign or
    DWord(KeyProp_CanVerify in setKeyProps) * spgpKeyPropFlag_CanVerify or
    DWord(KeyProp_HasRevoker in setKeyProps) * spgpKeyPropFlag_HasRevoker or
    DWord(KeyProp_HasADK in setKeyProps) * spgpKeyPropFlag_HasADK or
    DWord(KeyProp_HasSubKey in setKeyProps) * spgpKeyPropFlag_HasSubKey or
    DWord(KeyProp_LegacyKey in setKeyProps) * spgpKeyPropFlag_LegacyKey or
    DWord(KeyProp_IncludeUserIDs in setKeyProps) * spgpKeyPropFlag_IncludeUserIDs or
    DWord(KeyProp_IncludeSignerIDs in setKeyProps) * spgpKeyPropFlag_IncludeSignerIDs or
    DWord(KeyProp_IncludeGroupsList in setKeyProps) * spgpKeyPropFlag_IncludeGroupsList;
end;

function ShowError(const FOnFailure: TOnFailure; ErrorCode: Longint; ErrorStr: String): Longint;
begin
  Result:=ErrorCode;
  if PGPInitErrorCode=ieNone then begin
    if ErrorStr=EMPTY then begin
      SetLength(ErrorStr, 256);
      PGPGetErrorString(ErrorCode, 255, @ErrorStr[1]);
      SetLength(ErrorStr, StrLen(PChar(ErrorStr)));
    end;
  end
  else ErrorStr:=PGPInitError;
  if Assigned(FOnFailure) then
    FOnFailure(ErrorCode, ErrorStr)
  else Raise EFailException.Create(ErrorStr);
end;

function ShowHexError(const FOnFailure: TOnFailure; const IDStr: String): Longbool;
begin
  if not IsHexID(IDStr) then begin
    ShowError(FOnFailure, -1, HexFormError + '"' + IDStr + '"');
    Result:=true;
  end
  else Result:=false;
end;

function ShowPathStrError(const FOnFailure: TOnFailure; const PathStr: String): Longbool;
begin
  if (PathStr=EMPTY) or (Length(PathStr)>MAX_PATH) then begin
    ShowError(FOnFailure, -1, PathStrError + '"' + PathStr + '"');
    Result:=true;
  end
  else Result:=false;
end;


// TPGPGetKeyProps -------------------------------------------------------------

constructor TKeyRingProps.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FRingKeyOrdering:=UserID_Order;
  FPrimaryIDs:=TStringList.Create;
  FRingProps:=KeyProps_IDComplete + [KeyProp_Secret];
  FRingPropsList:=TKeyPropsList.Create(0, spgpKeyPropFlag_All);
end;

destructor TKeyRingProps.Destroy;
begin
  FRingPropsList.Free;
  FPrimaryIDs.Free;
  inherited Destroy;
end;

function TKeyRingProps.GetPrimaryIDs: Longint;
var
  KeyIndex	: Longint;
begin
  Result:=0;
  if (FPrimaryIDs<>nil) and (FRingPropsList<>nil) and (FRingPropsList.Count<>0) then begin
    FPrimaryIDs.Clear;
    with FRingPropsList do begin
      for KeyIndex:=0 to pred(Count) do with PKeyPropsRec(Objects[KeyIndex])^ do begin
	case kAlgorithm of
	  KeyAlgorithm_RSA: FPrimaryIDs.Add(kUserID + ' (RSA  - ' + kSize + ')');
	  KeyAlgorithm_RSAEncryptOnly: FPrimaryIDs.Add(kUserID + ' (RSA encrypt only - ' + kSize + ')');
	  KeyAlgorithm_RSASignOnly: FPrimaryIDs.Add(kUserID + ' (RSA sign only - ' + kSize + ')');
	  KeyAlgorithm_DH: FPrimaryIDs.Add(kUserID + ' (DH - ' + kSize + ')');
	  KeyAlgorithm_DSS: FPrimaryIDs.Add(kUserID + ' (DSS - ' + kSize + ')');
	  KeyAlgorithm_DHDSS: FPrimaryIDs.Add(kUserID + ' (DH/DSS - ' + kSize + ')');
	  {KeyAlgorithm_ElGamalEncSign: FPrimaryIDs.Add(kUserID + ' (ElGamal E/S - ' + kSize + ')');} // GnuPG only
	end;
	inc(Result);
      end;
    end;
    if Assigned(FComboBox) then FComboBox.Items.Assign(FPrimaryIDs);
    if Assigned(FListBox) then FListBox.Items.Assign(FPrimaryIDs);
  end;
end;

function TKeyRingProps.GetKeyFilter(AlgorithmFilter: TAlgorithmKeyFilter; BoolFilter: TBooleanKeyFilter): Longint;
begin
  Result:=0;
  case AlgorithmFilter of
    AlgorithmFilter_DHDSS: Result:=KeyFilterFlag_DHDSS;
    AlgorithmFilter_RSA: Result:=KeyFilterFlag_RSA;
    AlgorithmFilter_RSALegacy: Result:=KeyFilterFlag_V3;
  end;
  case BoolFilter of
    BoolFilter_CanEncrypt: Result:=Result or KeyFilterFlag_CanEncrypt;
    BoolFilter_CanDecrypt: Result:=Result or KeyFilterFlag_CanDecrypt;
    BoolFilter_CanSign: Result:=Result or KeyFilterFlag_CanSign;
    BoolFilter_CanVerify: Result:=Result or KeyFilterFlag_CanVerify;
  end;
end;

function TKeyRingProps.Update: Longint;
begin
  try
    FRingPropsList.Clear;
    FRingProps:=FRingProps + KeyProps_IDComplete + [KeyProp_Secret, KeyProp_IncludeGroupsList];
    Result:=FindKeyProps(ALL, FRingPropsList,
			 GetKeyPropsFlag(FRingProps),
			 GetKeyFilter(FRingAlgorithmFilter, FRingBoolFilter),
			 TPGPKeyOrdering(succ(FRingKeyOrdering)));
    if Result>=0 then
      Result:=GetPrimaryIDs
    else begin
      if Assigned(FComboBox) then FComboBox.Items.Clear;
      if Assigned(FListBox) then FListBox.Items.Clear;
      ShowError(FOnFailure, Result, EMPTY);
    end;
  except
    on EFailException do Raise;
    else Result:=ShowError(FOnFailure, -1, UnknownKeyRingErr);
    if Assigned(FComboBox) then FComboBox.Items.Clear;
    if Assigned(FListBox) then FListBox.Items.Clear;
  end;
end;

constructor TPGPGetKeyProps.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
end;

destructor TPGPGetKeyProps.Destroy;
begin
  inherited Destroy;
end;

function TPGPGetKeyProps.DoGetKeyProps: Longint;
var
  KeyPropsList	: TKeyPropsList;
begin
  Result:=kPGPError_PublicKeyNotFound;
  try
    KeyPropsList:=nil;
    if Assigned(FOnGetKeyID) then FOnGetKeyID(FKeyID);
    if FKeyID<>EMPTY then begin
      Result:=FindKeyProps(FKeyID, KeyPropsList,
			   GetKeyPropsFlag(FKeyProps),
			   GetKeyFilter(FAlgorithmFilter, FBoolFilter),
			   TPGPKeyOrdering(succ(FKeyOrdering)));
      try
	if Result>=0 then begin
	  if Assigned(FOnGetKeyProps) then FOnGetKeyProps(KeyPropsList);
	end
	else ShowError(FOnFailure, Result, EMPTY);
      finally
	KeyPropsList.Free;
      end;
    end;
  except
    on EFailException do Raise;
    else Result:=ShowError(FOnFailure, -1, UnknownKeyPropsErr);
  end;
end;

function TPGPGetKeyProps.KeyIsOnRing: Longint;
var
  KeyPropsList	: TKeyPropsList; // dummy
begin
  Result:=kPGPError_PublicKeyNotFound;
  try
    KeyPropsList:=nil;
    if Assigned(FOnGetKeyID) then FOnGetKeyID(FKeyID);
    if FKeyID<>EMPTY then begin
      Result:=FindKeyProps(FKeyID, KeyPropsList,
			   spgpKeyPropFlag_None,
			   KeyFilterFlag_AllKeys,
			   Any_Ordering);
      if Result<0 then ShowError(FOnFailure, Result, EMPTY);
    end;
  except
    on EFailException do Raise;
    else Result:=ShowError(FOnFailure, -1, UnknownKeyOnRingErr);
  end;
end;

function TPGPGetKeyProps.KeyRingCount: Longint;
var
  KeyPropsList	: TKeyPropsList; // dummy
begin
  try
    KeyPropsList:=nil;
    Result:=FindKeyProps(ALL, KeyPropsList,
			 spgpKeyPropFlag_None,
			 KeyFilterFlag_AllKeys,
			 Any_Ordering);
    if Result<0 then ShowError(FOnFailure, Result, EMPTY);
  except
    on EFailException do Raise;
    else Result:=ShowError(FOnFailure, -1, UnknownKeyRingCountErr);
  end;
end;

function TPGPGetKeyProps.GetKeyProp(KeyPropsList: TKeyPropsList; KeyIndex: Longint; KeyProp: TKeyProp): Variant;
begin
  Result:=0;
  if (KeyPropsList<>nil) and (KeyIndex>=0) and (KeyIndex<KeyPropsList.Count) then begin
    with PKeyPropsRec(KeyPropsList.Objects[KeyIndex])^ do begin
      case KeyProp of
	KeyProp_HexID: if KeyProp_HexID in KeyPropsList.ValidProps then begin
	  Result:=kHexID;
	  Exit;
	end;
	KeyProp_UserID: if KeyProp_UserID in KeyPropsList.ValidProps then begin
	  Result:=kUserID;
	  Exit;
	end;
	KeyProp_Fingerprint: if KeyProp_Fingerprint in KeyPropsList.ValidProps then begin
	  Result:=kFingerprint;
	  Exit;
	end;
	KeyProp_CreaTimeStr: if KeyProp_CreaTimeStr in KeyPropsList.ValidProps then begin
	  Result:=kCreaTimeStr;
	  Exit;
	end;
	KeyProp_ExpTimeStr: if KeyProp_ExpTimeStr in KeyPropsList.ValidProps then begin
	  Result:=kExpTimeStr;
	  Exit;
	end;
	KeyProp_Size: if KeyProp_Size in KeyPropsList.ValidProps then begin
	  Result:=kSize;
	  Exit;
	end;
	KeyProp_Algorithm: if KeyProp_Algorithm in KeyPropsList.ValidProps then begin
	  Result:=kAlgorithm;
	  Exit;
	end;
	KeyProp_Trust: if KeyProp_Trust in KeyPropsList.ValidProps then begin
	  Result:=kTrust;
	  Exit;
	end;
	KeyProp_Validity: if KeyProp_Validity in KeyPropsList.ValidProps then begin
	  Result:=kValidity;
	  Exit;
	end;
	KeyProp_CreaTimeNum: if KeyProp_CreaTimeNum in KeyPropsList.ValidProps then begin
	  Result:=kCreaTimeNum;
	  Exit;
	end;
	KeyProp_ExpTimeNum: if KeyProp_ExpTimeNum in KeyPropsList.ValidProps then begin
	  Result:=kExpTimeNum;
	  Exit;
	end;
	KeyProp_Secret: if KeyProp_Secret in KeyPropsList.ValidProps then begin
	  Result:=kPrivate;
	  Exit;
	end;
	KeyProp_ImplicitTrust: if KeyProp_ImplicitTrust in KeyPropsList.ValidProps then begin
	  Result:=kImplicitTrust;
	  Exit;
	end;
	KeyProp_Revoked: if KeyProp_Revoked in KeyPropsList.ValidProps then begin
	  Result:=kRevoked;
	  Exit;
	end;
	KeyProp_Disabled: if KeyProp_Disabled in KeyPropsList.ValidProps then begin
	  Result:=kDisabled;
	  Exit;
	end;
	KeyProp_Expired: if KeyProp_Expired in KeyPropsList.ValidProps then begin
	  Result:=kExpired;
	  Exit;
	end;
	KeyProp_SecretShared: if KeyProp_SecretShared in KeyPropsList.ValidProps then begin
	  Result:=kSecShared;
	  Exit;
	end;
	KeyProp_CanEncrypt: if KeyProp_CanEncrypt in KeyPropsList.ValidProps then begin
	  Result:=kCanEncrypt;
	  Exit;
	end;
	KeyProp_CanDecrypt: if KeyProp_CanDecrypt in KeyPropsList.ValidProps then begin
	  Result:=kCanDecrypt;
	  Exit;