preffuncs.pas

用DELPHI实现的 PGP 加密算法

	    if Result=0 then begin
	      FileOut:=nil;
	      Result:=PGPGetFullPathFromFileSpec(FileSpec, FileOut);
	      try
		Prefs.RandomSeedFile:=FileOut;
	      finally
		PGPFreeData(FileOut);
	      end;
	    end;
	  finally
	    PGPFreeFileSpec(FileSpec);
	  end;
	end;
	if Result<>0 then Exit;

	// Groups file
	if Flags and PrefsFlag_GroupsFile<>0 then begin
	  Result:=PGPsdkPrefGetFileSpec(Context, kPGPsdkPref_GroupsFile, FileSpec);
	  try
	    if Result=0 then begin
	      FileOut:=nil;
	      Result:=PGPGetFullPathFromFileSpec(FileSpec, FileOut);
	      try
		Prefs.GroupsFile:=FileOut;
	      finally
		PGPFreeData(FileOut);
	      end;
	    end;
	  finally
	    PGPFreeFileSpec(FileSpec);
	  end;
	end;
	if Result<>0 then Exit;

	// Private key
	if Flags and PrefsFlag_DefaultKeyID<>0 then begin
	  KeyOut:=nil;
	  Result:=PGPsdkPrefGetData(Context, kPGPsdkPref_DefaultKeyID, @KeyOut, IDSize);
	  if Result<>0 then Exit;
	  try
	    Result:=PGPImportKeyID(KeyOut, PGPKeyID);
	  finally
	    PGPFreeData(KeyOut);
	  end;
	  if Result<>0 then Exit;
	  Result:=PGPGetKeyIDString(PGPKeyID, kPGPKeyIDString_Full, KeyID);
	  if Result=0 then Prefs.DefaultKeyHexID:=KeyID;
	end;
      finally
	PGPFreeContext(Context);
      end;
    end;
  end;
end;

function SetPreferences(const Prefs: TPreferenceRec; Flags: Longint): Longint;
var
  Context	: pPGPContext;
  FileSpec	: pPGPFileSpec;
  KeyPropsList	: TKeyPropsList;
  RingContext	: pPGPContext;
  MainKeySet	: pPGPKeySet;
  Key		: pPGPKey;
  KeyIn		: TPGPKeyID7;
  PGPKeyID	: TPGPKeyID7;
  IDSize	: PGPSize;
begin
  Result:=kPGPError_PrefNotFound;
  if Flags<>0 then begin
    if PGP7X then begin
      if PrefsFile<>nil then with PrefsFile do if LoadPrefs then begin
	try
	  if Flags and PrefsFlag_PublicKeyring<>0 then begin
	  if not FileExists(Prefs.PublicKeyring) then begin
	    Result:=kPGPError_FileNotFound;
	    Exit;
	  end;
	  PrefsData.Values[PubFile]:=QU + Prefs.PublicKeyring + QU;
	  end;
	  if Flags and PrefsFlag_PrivateKeyring<>0 then begin
	    if not FileExists(Prefs.PrivateKeyring) then begin
	      Result:=kPGPError_FileNotFound;
	      Exit;
	    end;
	    PrefsData.Values[SecFile]:=QU + Prefs.PrivateKeyring + QU;
	  end;
	  if Flags and PrefsFlag_RandomSeedFile<>0 then begin
	    if not FileExists(Prefs.RandomSeedFile) then begin
	      Result:=kPGPError_FileNotFound;
	      Exit;
	    end;
	    PrefsData.Values[RNGFile]:=QU + Prefs.RandomSeedFile + QU;
	  end;
	  if Flags and PrefsFlag_GroupsFile<>0 then begin
	    MessageBox(0, 'PGP 7.X/8.X don''t support changing the default groups file name',
		       'PGP Components error:', MB_ICONERROR);
	  end;
	  if Flags and PrefsFlag_DefaultKeyID<>0 then begin
	    KeyPropsList:=nil;
	    try
	      Result:=KeyRings.InitKeyRings(RingContext, MainKeySet);
	      if Result<>0 then Exit;
	      try
		if FindKeyProps(Prefs.DefaultKeyHexID, KeyPropsList, 0, KeyFilterFlag_CanSign, Any_Ordering)=1 then begin
		  Result:=GetKeyByHexID(MainKeySet, Prefs.DefaultKeyHexID, Key);
		  if Result<>0 then Exit;
		  Result:=PGPGetKeyIDFromKey(Key, PGPKeyID);
		  if Result<>0 then Exit;
		  PrefsData.Values[DefKeyID]:='0x' + GetPGPKeyIDString(PGPKeyID);
		end
		else Result:=kPGPError_SecretKeyNotFound;
	      finally
		KeyRings.FreeKeyRings;
	      end;
	    finally
	      KeyPropsList.Free;
	    end;
	  end;
	  if (Result=0) and not SavePrefs then Result:=kPGPError_WriteFailed;
	finally
	  PrefsData.Clear;
	end;
      end;
    end
    else begin
      Context:=nil;
      FileSpec:=nil;
      Result:=PGPNewContext(kPGPsdkAPIVersion, Context);
      if Result<>0 then Exit;
      try
	Result:=PGPsdkLoadDefaultPrefs(Context);
	if Result<>0 then Exit;

	// Pubring
	if Flags and PrefsFlag_PublicKeyring<>0 then begin
	  if not FileExists(Prefs.PublicKeyring) then begin
	    Result:=kPGPError_FileNotFound;
	    Exit;
	  end;
	  Result:=PGPNewFileSpecFromFullPath(Context, PChar(Prefs.PublicKeyring), FileSpec);
	  try
	    if Result=0 then Result:=PGPsdkPrefSetFileSpec(Context, kPGPsdkPref_PublicKeyring, FileSpec);
	    if Result<>0 then Exit;
	  finally
	    PGPFreeFileSpec(FileSpec);
	  end;
	end;

	// Secring
	if Flags and PrefsFlag_PrivateKeyring<>0 then begin
	  if not FileExists(Prefs.PrivateKeyring) then begin
	    Result:=kPGPError_FileNotFound;
	    Exit;
	  end;
	  Result:=PGPNewFileSpecFromFullPath(Context, PChar(Prefs.PrivateKeyring), FileSpec);
	  try
	    if Result=0 then Result:=PGPsdkPrefSetFileSpec(Context, kPGPsdkPref_PrivateKeyring, FileSpec);
	    if Result<>0 then Exit;
	  finally
	    PGPFreeFileSpec(FileSpec);
	  end;
	end;

	// Randseed file
	if Flags and PrefsFlag_RandomSeedFile<>0 then begin
	  if not FileExists(Prefs.RandomSeedFile) then begin
	    Result:=kPGPError_FileNotFound;
	    Exit;
	  end;
	  Result:=PGPNewFileSpecFromFullPath(Context, PChar(Prefs.RandomSeedFile), FileSpec);
	  try
	    if Result=0 then Result:=PGPsdkPrefSetFileSpec(Context, kPGPsdkPref_RandomSeedFile, FileSpec);
	    if Result<>0 then Exit;
	  finally
	    PGPFreeFileSpec(FileSpec);
	  end;
	end;

	// Groups file
	if Flags and PrefsFlag_GroupsFile<>0 then begin
	  if not FileExists(Prefs.GroupsFile) then begin
	    Result:=kPGPError_FileNotFound;
	    Exit;
	  end;
	  Result:=PGPNewFileSpecFromFullPath(Context, PChar(Prefs.GroupsFile), FileSpec);
	  try
	    if Result=0 then Result:=PGPsdkPrefSetFileSpec(Context, kPGPsdkPref_GroupsFile, FileSpec);
	    if Result<>0 then Exit;
	  finally
	    PGPFreeFileSpec(FileSpec);
	  end;
	end;

	// Private key
	if Flags and PrefsFlag_DefaultKeyID<>0 then begin
	  KeyPropsList:=nil;
	  try
	    if FindKeyProps(Prefs.DefaultKeyHexID, KeyPropsList, 0, KeyFilterFlag_CanSign, Any_Ordering)=1 then begin
	      Result:=KeyRings.InitKeyRings(RingContext, MainKeySet);
	      if Result<>0 then Exit;
	      try
		Result:=GetKeyByHexID(MainKeySet, Prefs.DefaultKeyHexID, Key);
		if Result<>0 then Exit;
		Result:=PGPGetKeyIDFromString(PChar(Prefs.DefaultKeyHexID), kPGPPublicKeyAlgorithm_Invalid, KeyIn);
		if Result<>0 then Exit;
		Result:=PGPExportKeyID(@KeyIn, PGPKeyID, IDSize);
		if Result<>0 then Exit;
	      finally
		KeyRings.FreeKeyRings;
	      end;
	      Result:=PGPsdkPrefSetData(Context, kPGPsdkPref_DefaultKeyID, @PGPKeyID, IDSize);
	    end
	    else Result:=kPGPError_SecretKeyNotFound;
	    if Result<>0 then Exit;
	  finally
	    KeyPropsList.Free;
	  end;
	end;
	Result:=PGPsdkSavePrefs(Context);
      finally
	PGPFreeContext(Context);
      end;
    end;
    if Result=0 then begin
      PGPclNotifyKeyringChanges(GetCurrentProcessID);
      PGPclNotifyPrefsChanges(GetCurrentProcessID);
    end;
  end;
end;

function GetServerList(var ServerList: TStringList): Longint;
const
  Protocols: Array[kPGPKeyServerProtocol_Invalid..kPGPKeyServerProtocol_HTTPS] of String = (
    E, 'ldap', 'http', 'ldaps', 'https'
  );
var
  Entry		 : TStringList;
  PGPPref	 : pPGPPref;
  KeyServerList	 : pPGPKeyServerEntry;
  KeyServerEntry : pPGPKeyServerEntry;
  ServerCount	 : PGPUInt32;
  ServerURL	 : String;
begin
  if PGP7X then begin
    Result:=kPGPError_PrefNotFound;
    if PrefsFile<>nil then with PrefsFile do if LoadPrefs then begin
      try
	Entry:=TStringList.Create;
	ServerList:=TStringList.Create;
	if (Entry<>nil) and (ServerList<>nil) then with Entry do begin
	  try
	    ServerCount:=0;
	    repeat
	      inc(ServerCount);
	      CommaText:=PrefsData.Values[KeyServers + IntToStr(ServerCount)];
	      if Count>=8 then begin
		if Strings[0]<>E then ServerURL:=Protocols[StrToInt(Strings[0])];
		if (ServerURL<>E) and (Strings[3]<>E) then begin
		  ServerURL:=ServerURL + '://' + Strings[3];
		  if (Strings[4]<>E) and (Strings[4]<>'0') then ServerURL:=ServerURL + ':' + Strings[4];
		  ServerList.Add(ServerURL);
		end;
	      end;
	    until CommaText=E;
	  finally
	    Entry.Free;
	  end;
	  Result:=0;
	end;
      except
      end;
      PrefsData.Clear;
    end;
  end
  else begin
    PGPPref:=nil;
    KeyServerList:=nil;
    ServerList:=TStringList.Create;
    if ServerList<>nil then begin
      Result:=PGPclOpenClientPrefs(PGPGetDefaultMemoryMgr, PGPPref);
      if Result=0 then begin
	try
	  Result:=PGPGetKeyServerPrefs(PGPPref, KeyServerList, ServerCount);
	  if Result=0 then begin
	    try
	      if ServerCount<>0 then begin
		KeyServerEntry:=KeyServerList;
		for ServerCount:=ServerCount downto 1 do with KeyServerEntry^ do begin
		  if Protocol<>kPGPKeyServerProtocol_Invalid then ServerURL:=Protocols[Protocol] + '://';
		  if ServerDNS<>E then begin
		    ServerURL:=ServerURL + ServerDNS;
		    if ServerPort<>0 then ServerURL:=ServerURL + ':' + IntToStr(ServerPort);
		    ServerList.Add(ServerURL);
		  end;
		  inc(KeyServerEntry);
		end;
	      end
	      else Result:=kPGPError_PrefNotFound;
	    finally
	      PGPFreeData(KeyServerList);
	    end;
	  end;
	finally
	  PGPclCloseClientPrefs(PGPPref, false);
	end;
      end;
    end
    else Result:=kPGPError_OutOfMemory;
  end;
end;

function GetPrefWarnOnWipe(var WarnOnWipe: Longbool): Longint;
var
  PGPPref	 : pPGPPref;
  Pref           : PGPBoolean;
begin
  WarnOnWipe:=false;
  if PGP7X then begin
    Result:=kPGPError_PrefNotFound;
    if PrefsFile<>nil then with PrefsFile do if LoadPrefs then begin
      try
	WarnOnWipe:=(CompareText(PrefsData.Values[WipeWarning], 'TRUE')=0);
	Result:=0;
      except
      end;
      PrefsData.Clear;
    end;
  end
  else begin
    PGPPref:=nil;
    Result:=PGPclOpenClientPrefs(PGPGetDefaultMemoryMgr, PGPPref);
    if Result=0 then begin
      try
	Result:=PGPclGetPrefBoolean(PGPPref, kPGPPrefWarnOnWipe, Pref);
	if Result=0 then WarnOnWipe:=Boolean(Pref);
      finally
	PGPclCloseClientPrefs(PGPPref, false);
      end;
    end;
  end;
end;

function SetPrefWarnOnWipe(WarnOnWipe: Longbool): Longint;
var
  PGPPref	 : pPGPPref;
begin
  if PGP7X then begin
    Result:=kPGPError_PrefNotFound;
    if PrefsFile<>nil then with PrefsFile do if LoadPrefs then begin
      try
	if WarnOnWipe then
	  PrefsData.Values[WipeWarning]:='TRUE'
	else PrefsData.Values[WipeWarning]:='FALSE';
	if SavePrefs then Result:=0;
      except
      end;
      PrefsData.Clear;
    end;
  end
  else begin
    PGPPref:=nil;
    Result:=PGPclOpenClientPrefs(PGPGetDefaultMemoryMgr, PGPPref);
    if Result=0 then begin
      try
	Result:=PGPclSetPrefBoolean(PGPPref, kPGPPrefWarnOnWipe, PGPBoolean(WarnOnWipe) and 1);
      finally
	PGPclCloseClientPrefs(PGPPref, true);
      end;
    end;
  end;
  if Result=0 then PGPclNotifyPrefsChanges(GetCurrentProcessID);
end;

function GetPrefWipeCount(var WipeCount: PGPUInt32): Longint;
var
  PGPPref	 : pPGPPref;
begin
  WipeCount:=0;
  if PGP7X then begin
    Result:=kPGPError_PrefNotFound;
    if PrefsFile<>nil then with PrefsFile do if LoadPrefs then begin
      try
	WipeCount:=StrToInt(PrefsData.Values[FileWipeCount]);
	Result:=0;
      except
      end;
      PrefsData.Clear;
    end;
  end
  else begin
    PGPPref:=nil;
    Result:=PGPclOpenClientPrefs(PGPGetDefaultMemoryMgr, PGPPref);
    if Result=0 then begin
      try
	Result:=PGPclGetPrefNumber(PGPPref, kPGPPrefFileWipePasses, WipeCount);
      finally
	PGPclCloseClientPrefs(PGPPref, false);
      end;
    end;
  end;
end;

function SetPrefWipeCount(WipeCount: PGPUInt32): Longint;
var
  PGPPref	 : pPGPPref;
begin
  if PGP7X then begin
    Result:=kPGPError_PrefNotFound;
    if PrefsFile<>nil then with PrefsFile do if LoadPrefs then begin
      try
	PrefsData.Values[FileWipeCount]:=IntToStr(WipeCount);
	if SavePrefs then Result:=0;
      except
      end;
      PrefsData.Clear;
    end;
  end
  else begin
    PGPPref:=nil;
    Result:=PGPclOpenClientPrefs(PGPGetDefaultMemoryMgr, PGPPref);
    if Result=0 then begin
      try
	Result:=PGPclSetPrefNumber(PGPPref, kPGPPrefFileWipePasses, WipeCount);
      finally
	PGPclCloseClientPrefs(PGPPref, true);
      end;
    end;
  end;
  if Result=0 then PGPclNotifyPrefsChanges(GetCurrentProcessID);
end;

function GetAllowedCipherAlgorithms(var AlgorithmList: TPGPCipherAlgorithms; var Count: Longint): Longint;
var
  Pref		 : String;
  PGPPref	 : pPGPPref;
  DataLength	 : PGPSize;
  PrefData	 : pPGPCipherAlgorithm;
  PrefIndex	 : pPGPCipherAlgorithm;
  AlgIndex	 : Longint;
begin
  Count:=0;
  FillChar(AlgorithmList, SizeOf(TPGPCipherAlgorithms), 0);
  if PGP7X then begin
    Result:=kPGPError_PrefNotFound;
    if PrefsFile<>nil then with PrefsFile do if LoadPrefs then begin
      try
	for AlgIndex:=0 to High(AlgorithmList) do begin
	  Pref:=PrefsData.Values[AllowedAlgList + IntToStr(succ(AlgIndex))];
	  if Pref<>'' then
	    AlgorithmList[AlgIndex]:=PGPCipherAlgorithm(StrToInt(Pref))
	  else Break;
	end;
	Count:=AlgIndex;
	Result:=0;
      except
      end;
      PrefsData.Clear;
    end;
  end
  else begin
    PGPPref:=nil;
    Result:=PGPclOpenClientPrefs(PGPGetDefaultMemoryMgr, PGPPref);
    if Result=0 then begin
      try
	Result:=PGPclGetPrefData(PGPPref, kPGPPrefAllowedAlgorithmsList, DataLength, Pointer(PrefData));
	if Result=0 then begin
	  PrefIndex:=PrefData;
	  try
	    Count:=DataLength div SizeOf(PGPCipherAlgorithm);
	    if Count>succ(High(AlgorithmList)) then Count:=succ(High(AlgorithmList));
	    for AlgIndex:=0 to pred(Count) do begin
	      AlgorithmList[AlgIndex]:=PrefIndex^;
	      inc(PrefIndex);
	    end;
	  finally
	    PGPFreeData(PrefData);
	  end;
	end;
      finally
	PGPclCloseClientPrefs(PGPPref, false);
      end;
    end;
  end;
end;

function GetPreferredCipherAlgorithm(var Algorithm: PGPCipherAlgorithm): Longint;
var
  PGPPref	 : pPGPPref;
  Pref           : PGPUInt32;
begin
  // PGP's default
  Algorithm:=kPGPCipherAlgorithm_CAST5;
  if PGP7X then begin
    Result:=kPGPError_PrefNotFound;
    if PrefsFile<>nil then with PrefsFile do if LoadPrefs then begin
      try
	Algorithm:=PGPCipherAlgorithm(StrToInt(PrefsData.Values[PrefAlgorithm]));
	Result:=0;
      except
      end;
      PrefsData.Clear;
    end;
  end
  else begin
    PGPPref:=nil;
    Result:=PGPclOpenClientPrefs(PGPGetDefaultMemoryMgr, PGPPref);
    if Result=0 then begin
      try
	Result:=PGPclGetPrefNumber(PGPPref, kPGPPrefPreferredAlgorithm, Pref);
	if Result=0 then Algorithm:=PGPCipherAlgorithm(Pref);
      finally
	PGPclCloseClientPrefs(PGPPref, false);
      end;
    end;
  end;
end;

initialization
  PrefsFile:=TPrefsFile.Create;

finalization
  PrefsFile.Free;
  PrefsFile:=nil;

end.