pgp2comp.pas

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

	end;
	KeyProp_CanSign: if KeyProp_CanSign in KeyPropsList.ValidProps then begin
	  Result:=kCanSign;
	  Exit;
	end;
	KeyProp_CanVerify: if  KeyProp_CanVerify in KeyPropsList.ValidProps then begin
	  Result:=kCanVerify;
	  Exit;
	end;
	KeyProp_HasRevoker: if KeyProp_HasRevoker in KeyPropsList.ValidProps then begin
	  Result:=kHasRevoker;
	  Exit;
	end;
	KeyProp_HasADK: if KeyProp_HasADK in KeyPropsList.ValidProps then begin
	  Result:=kHasADK;
	  Exit;
	end;
	KeyProp_HasSubKey: if KeyProp_HasSubKey in KeyPropsList.ValidProps then begin
	  Result:=kHasSubKey;
	  Exit;
	end;
	KeyProp_LegacyKey: if KeyProp_LegacyKey in KeyPropsList.ValidProps then begin
	  Result:=kLegacyKey;
	  Exit;
	end;
      end;
      ShowError(FOnFailure, kPGPError_BadParams, EMPTY);
    end;
  end
  else ShowError(FOnFailure, kPGPError_ItemNotFound, EMPTY);
end;

function TPGPGetKeyProps.GetUserIDList(KeyPropsList: TKeyPropsList; KeyIndex: Longint): TStringList;
begin
  Result:=nil;
  if (KeyPropsList<>nil) and (KeyIndex>=0) and (KeyIndex<KeyPropsList.Count) then
    Result:=PKeyPropsRec(KeyPropsList.Objects[KeyIndex])^.kUserIDList
  else ShowError(FOnFailure, kPGPError_ItemNotFound, EMPTY);
end;

function TPGPGetKeyProps.GetSignerIDList(KeyPropsList: TKeyPropsList; KeyIndex: Longint): TStringList;
begin
  Result:=nil;
  if (KeyPropsList<>nil) and (KeyIndex>=0) and (KeyIndex<KeyPropsList.Count) then
    Result:=PKeyPropsRec(KeyPropsList.Objects[KeyIndex])^.kSignerIDList
  else ShowError(FOnFailure, kPGPError_ItemNotFound, EMPTY);
end;

function TPGPGetKeyProps.GetRevKeyIDList(KeyPropsList: TKeyPropsList; KeyIndex: Longint): TStringList;
begin
  Result:=nil;
  if (KeyPropsList<>nil) and (KeyIndex>=0) and (KeyIndex<KeyPropsList.Count) then
    Result:=PKeyPropsRec(KeyPropsList.Objects[KeyIndex])^.kRevKeyIDList
  else ShowError(FOnFailure, kPGPError_ItemNotFound, EMPTY);
end;

function TPGPGetKeyProps.GetADKeyIDList(KeyPropsList: TKeyPropsList; KeyIndex: Longint): TStringList;
begin
  Result:=nil;
  if (KeyPropsList<>nil) and (KeyIndex>=0) and (KeyIndex<KeyPropsList.Count) then
    Result:=PKeyPropsRec(KeyPropsList.Objects[KeyIndex])^.kADKeyIDList
  else ShowError(FOnFailure, kPGPError_ItemNotFound, EMPTY);
end;

function TPGPGetKeyProps.GetGroupHexIDs(KeyPropsList: TKeyPropsList; GroupIndex: Longint; var GroupName: String): String;
var
  TabPos	: Longint;
begin
  Result:=EMPTY;
  GroupName:=EMPTY;
  if (KeyPropsList<>nil) and (GroupIndex>=0) and (GroupIndex<KeyPropsList.GroupsList.Count) then begin
    Result:=KeyPropsList.GroupsList.Strings[GroupIndex];
    TabPos:=pos(TAB, Result);
    GroupName:=Copy(Result, 1, pred(TabPos));
    Delete(Result, 1, TabPos);
  end
  else ShowError(FOnFailure, kPGPError_ItemNotFound, EMPTY);
end;


// TPGPSetKeyProps -------------------------------------------------------------

constructor TPGPSetKeyProps.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FMinPassLen:=10;
  FMinPassQual:=100;
  if AOwner is TForm then FParentHandle:=TForm(AOwner).Handle;
end;

destructor TPGPSetKeyProps.Destroy;
begin
  inherited Destroy;
end;

function TPGPSetKeyProps.GetKeyHexID(FilterFlags: DWord): Longint;
var
  KeyPropsList	: TKeyPropsList;
  KeyPropsRec	: TKeyPropsRec;
begin
  Result:=0;
  KeyPropsList:=nil;
  try
    if FindKeyProps(FKeyHexID, KeyPropsList,
		    GetKeyPropsFlag(FKeyProps) or spgpKeyPropFlag_IDFlags,
		    FilterFlags, Any_Ordering)<>1 then begin
      if KeyPropsList<>nil then KeyPropsList.Clear;
      Result:=SelectKeysDialog(FKeyDlgPrompt, KeyPropsList, true,
			       GetKeyPropsFlag(FKeyProps) or spgpKeyPropFlag_IDFlags,
			       FilterFlags, FParentHandle);
      if Result=0 then begin
	KeyPropsRec:=KeyPropsList.KeyProps[0];
	FKeyHexID:=KeyPropsList.Strings[0];
      end;
    end
    else begin
      KeyPropsRec:=KeyPropsList.KeyProps[0];
      FKeyHexID:=KeyPropsList.Strings[0];
    end;
    if Result=0 then begin
      if not ShowHexError(FOnFailure, FKeyHexID) then begin
	if Assigned(FOnKeySelected) and not FOnKeySelected(KeyPropsRec) then Result:=kPGPError_UserAbort;
      end
      else Result:=kPGPError_BadParams;
    end;
  finally
    KeyPropsList.Free;
  end;
end;

function TPGPSetKeyProps.DoKeyDisable: Longint;
begin
  try
    Result:=GetKeyHexID(KeyFilterFlag_Enabled);
    if Result=0 then Result:=KeyDisable(PChar(FKeyHexID));
    if Result<0 then ShowError(FOnFailure, Result, EMPTY);
  except
    on EFailException do Raise;
    else Result:=ShowError(FOnFailure, -1, UnknownKeyDisableErr);
  end;
end;

function TPGPSetKeyProps.DoKeyEnable: Longint;
begin
  try
    Result:=GetKeyHexID(KeyFilterFlag_Disabled);
    if Result=0 then Result:=KeyEnable(PChar(FKeyHexID));
    if Result<0 then ShowError(FOnFailure, Result, EMPTY);
  except
    on EFailException do Raise;
    else Result:=ShowError(FOnFailure, -1, UnknownKeyEnableErr);
  end;
end;

function TPGPSetKeyProps.DoKeyRemove: Longint;
begin
  try
    Result:=GetKeyHexID(KeyFilterFlag_AllKeys);
    if Result=0 then Result:=KeyRemove(PChar(FKeyHexID));
    if Result<0 then ShowError(FOnFailure, Result, EMPTY);
  except
    on EFailException do Raise;
    else Result:=ShowError(FOnFailure, -1, UnknownKeyRemoveErr);
  end;
end;

function TPGPSetKeyProps.DoKeyRevoke: Longint;
var
  Passphrase	: PChar;
  PassBufSize	: Cardinal;
  Cancel	: Longbool;
begin
  try
    Result:=GetKeyHexID(KeyFilterFlag_CanSign);
    if Result=0 then begin
      if Assigned(FOnEnterPassphrase) then begin
	PassBufSize:=MaxUTF8Length;
	Passphrase:=PGPNewSecureData(PGPGetDefaultMemoryMgr, PassBufSize, kPGPMemoryMgrFlags_Clear);
	if Passphrase<>nil then begin
	  try
	    Cancel:=false;
	    Result:=kPGPError_UserAbort;
	    FOnEnterPassphrase(Passphrase, Cancel);
	    if not Cancel then begin
	      if PGP8X then AnsiToUtf8PChar(Passphrase, Passphrase, PassBufSize);
	      Result:=KeyRevoke(PChar(FKeyHexID), Passphrase);
	    end;
	  finally
	    PGPFreeData(Passphrase);
	  end;
	end
	else Result:=kPGPError_OutOfMemory;
      end
      else Result:=KeyRevokeDialog(FKeyHexID, FPassDlgPrompt, FParentHandle);
    end;
    if Result<0 then ShowError(FOnFailure, Result, EMPTY);
  except
    on EFailException do Raise;
    else Result:=ShowError(FOnFailure, -1, UnknownKeyRevokeErr);
  end;
end;

function TPGPSetKeyProps.DoKeyPassChange: Longint;
var
  OldPassphrase	: PChar;
  NewPassphrase	: PChar;
  PassBufSize	: Cardinal;
  PassLength	: Longint;
  Cancel	: Longbool;
begin
  try
    Result:=GetKeyHexID(KeyFilterFlag_CanSign);
    if Result=0 then begin
      if Assigned(FOnChangePassphrase) then begin
	PassBufSize:=MaxUTF8Length;
	OldPassphrase:=PGPNewSecureData(PGPGetDefaultMemoryMgr, PassBufSize, kPGPMemoryMgrFlags_Clear);
	if OldPassphrase<>nil then begin
	  try
	    NewPassphrase:=PGPNewSecureData(PGPGetDefaultMemoryMgr, PassBufSize, kPGPMemoryMgrFlags_Clear);
	    if NewPassphrase<>nil then begin
	      try
		Cancel:=false;
		Result:=kPGPError_UserAbort;
		repeat
		  FOnChangePassphrase(OldPassphrase, NewPassphrase, FMinPassLen, FMinPassQual, Cancel);
		  PassLength:=StrLen(NewPassphrase);
		  if PGP8X and not Cancel then begin
		    AnsiToUtf8PChar(OldPassphrase, OldPassphrase, PassBufSize);
		    AnsiToUtf8PChar(NewPassphrase, NewPassphrase, PassBufSize);
		  end;
		until Cancel
		or (PassLength>=FMinPassLen) and (PGPEstimatePassphraseQuality(NewPassphrase)>=FMinPassQual);
		if not Cancel then Result:=ChangePassphrase(PChar(FKeyHexID), OldPassphrase, NewPassphrase);
	      finally
		PGPFreeData(NewPassphrase);
	      end;
	    end
	    else Result:=kPGPError_OutOfMemory;
	  finally
	    PGPFreeData(OldPassphrase);
	  end;
	end
	else Result:=kPGPError_OutOfMemory;
      end
      else begin
	Result:=KeyPassChangeDialog(FKeyHexID, FPassDlgOldPrompt, FPassDlgNewPrompt,
				    FMinPassLen, FMinPassQual, FParentHandle);
      end;
    end;
    if Result<0 then ShowError(FOnFailure, Result, EMPTY);
  except
    on EFailException do Raise;
    else Result:=ShowError(FOnFailure, -1, UnknownKeyPassChangeErr);
  end;
end;


// TPGPPreferences -------------------------------------------------------------

constructor TPGPPreferences.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  if AOwner is TForm then FParentHandle:=TForm(AOwner).Handle;
end;

destructor TPGPPreferences.Destroy;
begin
  inherited Destroy;
end;

function TPGPPreferences.ShowPrefsDialog: Longint;
begin
  Result:=PreferencesDialog(ord(FPrefsPage), FParentHandle);
end;

function TPGPPreferences.GetFlags: Longint;
begin
  Result:=ord(Pref_PublicKeyring in FPGPPrefs) * PrefsFlag_PublicKeyring or
	  ord(Pref_PrivateKeyring in FPGPPrefs) * PrefsFlag_PrivateKeyring or
	  ord(Pref_RandomSeedFile in FPGPPrefs) * PrefsFlag_RandomSeedFile or
	  ord(Pref_GroupsFile in FPGPPrefs) * PrefsFlag_GroupsFile or
	  ord(Pref_DefaultKeyID in FPGPPrefs) * PrefsFlag_DefaultKeyID;
end;

function TPGPPreferences.PrefsError: Longbool;
begin
  with FPreferences do begin
    Result:=(Pref_PublicKeyring in FPGPPrefs) and ShowPathStrError(FOnFailure, PublicKeyring) or
	    (Pref_PrivateKeyring in FPGPPrefs) and ShowPathStrError(FOnFailure, PrivateKeyring) or
	    (Pref_RandomSeedFile in FPGPPrefs) and ShowPathStrError(FOnFailure, RandomSeedFile) or
	    (Pref_GroupsFile in FPGPPrefs) and ShowPathStrError(FOnFailure, GroupsFile) or
	    (Pref_DefaultKeyID in FPGPPrefs) and ShowHexError(FOnFailure, DefaultKeyHexID);
  end;
end;

function TPGPPreferences.GetAltPubKeyring: String;
begin
  Result:=FAltPubringFile;
end;

function TPGPPreferences.GetAltPrivKeyring: String;
begin
  Result:=FAltSecringFile;
end;

function TPGPPreferences.GetAltGroupsFile: String;
begin
  Result:=FAltGroupsFile;
end;

procedure TPGPPreferences.SetAltPubKeyring(const Value: String);
begin
  FAltPubringFile:=Value;
  KeyRings.PubringFile:=Value;
end;

procedure TPGPPreferences.SetAltPrivKeyring(const Value: String);
begin
  FAltSecringFile:=Value;
  KeyRings.SecringFile:=Value;
end;

procedure TPGPPreferences.SetAltGroupsFile(const Value: String);
begin
  FAltGroupsFile:=Value;
  KeyRings.GroupsFile:=Value;
end;

function TPGPPreferences.DoGetPreferences: Longint;
var PrefsFlag: Longint;
begin
  Result:=kPGPError_BadParams;
  try
    PrefsFlag:=GetFlags;
    if PrefsFlag<>0 then begin
      Result:=GetPreferences(FPreferences, PrefsFlag);
      if Result<0 then
	ShowError(FOnFailure, Result, EMPTY)
      else if Assigned(FOnGetPreferences) then FOnGetPreferences(FPreferences);
    end;
  except
    on EFailException do Raise;
    else Result:=ShowError(FOnFailure, -1, UnknownPrefsErr);
  end;
end;

function TPGPPreferences.DoSetPreferences: Longint;
var PrefsFlag: Longint;
begin
  Result:=kPGPError_BadParams;
  try
    if Assigned(FOnSetPreferences) then FOnSetPreferences(FPreferences);
    PrefsFlag:=GetFlags;
    if (PrefsFlag<>0) and not PrefsError then begin
      Result:=SetPreferences(FPreferences, PrefsFlag);
      if Result<0 then ShowError(FOnFailure, Result, EMPTY);
    end;
  except
    on EFailException do Raise;
    else Result:=ShowError(FOnFailure, -1, UnknownPrefsErr);
  end;
end;


// TPGPKeyServer ---------------------------------------------------------------

constructor TPGPKeyServer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  if AOwner is TForm then FParentHandle:=TForm(AOwner).Handle;
end;

destructor TPGPKeyServer.Destroy;
begin
  inherited Destroy;
end;

function TPGPKeyServer.DoGetKeysFromServer(const KeyData: String): Longint;
var
  KeyPropsList	 : TKeyPropsList;
begin
  KeyPropsList:=nil;
  try
    Result:=GetKeyFromServerDialog(FKeyDlgPrompt, KeyData, KeyPropsList, GetKeyPropsFlag(FKeyProps), FParentHandle);
    try
      if Result=0 then begin
	if Assigned(FOnServerResults) then FOnServerResults(KeyPropsList);
      end
      else ShowError(FOnFailure, Result, Empty);
    finally
      KeyPropsList.Free;
    end;
  except
    on EFailException do Raise;
    else Result:=ShowError(FOnFailure, -1, UnknownServerErr);
  end;
end;

function TPGPKeyServer.DoSendKeysToServer: Longint;
var
  KeyPropsList	 : TKeyPropsList;
begin
  KeyPropsList:=nil;
  try
    Result:=SendKeyToServerDialog(FKeyDlgPrompt, KeyPropsList, GetKeyPropsFlag(FKeyProps), FParentHandle);
    try
      if Result=0 then begin
	if Assigned(FOnServerResults) then FOnServerResults(KeyPropsList);
      end
      else ShowError(FOnFailure, Result, Empty);
    finally
      KeyPropsList.Free;