preffuncs.pas

用DELPHI实现的 PGP 加密算法

{$J+,Z4}
unit PrefFuncs;

{------------------------------------------------------------------------------}
{                                                                              }
{       This unit is based on Steve Heller's spgpPreferences.pas from his      }
{         SPGP sources available from http://www.oz.net/~srheller/spgp/        }
{                                                                              }
{                Portions created by Michael in der Wiesche are                }
{              Copyright (C) 2001-2003 by Michael in der Wiesche               }
{                                                                              }
{------------------------------------------------------------------------------}

interface

uses
  Windows,
  Classes,
  SysUtils,
  KeyPropTypes,
  pgpBase,
  pgpErrors,
  pgpPubTypes,
  pgpUtilities,
  pgpMemoryMgr,
  pgpKeyServer,
  pgpSDKPrefs,
  pgpKeys,
  pgpCL,
  KeyFuncs;

const
  E = '';
  BS = '\';
  CM = ',';
  QU = '"';
  SP = ' ';
  CRLF = #13#10;
  AppDataRegPath = 'Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders';
  NAIAppDataPath = '\Network Associates\PGP\';
  PGPAppDataPath = '\PGP Corporation\PGP\';
  PrefsFileName = 'PGPprefs.txt';
  GroupsFileName = 'PGPgroup.pgr';
  PubFile = 'PublicKeyringFile';
  SecFile = 'PrivateKeyringFile';
  RNGFile = 'RNGSeedFile';
  DefKeyID ='DefaultKeyID';
  KeyServers = 'KeyServerList';
  WipeWarning = 'WarnOnWipe';
  FileWipeCount = 'FileWipePasses';
  PrefAlgorithm = 'PreferredAlgorithm';
  AllowedAlgList = 'AllowedAlgorithmsList';

  PrefsFlag_Default		= $00;
  PrefsFlag_PublicKeyring	= $01;
  PrefsFlag_PrivateKeyring	= $02;
  PrefsFlag_RandomSeedFile	= $04;
  PrefsFlag_DefaultKeyID	= $08;
  PrefsFlag_GroupsFile		= $10;

type
  pPreferenceRec = ^TPreferenceRec;
  TPreferenceRec = Record
    PublicKeyring: String;
    PrivateKeyring: String;
    RandomSeedFile: String;
    GroupsFile: String;
    DefaultKeyHexID: String;
  end;

type
  TPrefsFile = Class
    PrefsData: TStringList;
    PrefsFilePath: String;
    GroupsFilePath: String;
    constructor Create;
    destructor Destroy; override;
    function LoadPrefs: Longbool;
    function SavePrefs: Longbool;
    function GetPGPKeyID(const PGPKeyIDString: String): TPGPKeyID7;
    function GetPGPKeyIDString(const PGPKeyID: TPGPKeyID7): String;
    function GetAppPathRegEntry(const RegPath, RegKey: String): String;
  end;

const PrefsFile: TPrefsFile = nil;

function GetPGPVersionString: String;
function GetPreferences(var Prefs: TPreferenceRec; Flags: Longint): Longint;
function SetPreferences(const Prefs: TPreferenceRec; Flags: Longint): Longint;
function GetServerList(var ServerList: TStringList): Longint;
function GetPrefWarnOnWipe(var WarnOnWipe: Longbool): Longint;
function SetPrefWarnOnWipe(WarnOnWipe: Longbool): Longint;
function GetPrefWipeCount(var WipeCount: PGPUInt32): Longint;
function SetPrefWipeCount(WipeCount: PGPUInt32): Longint;
function GetAllowedCipherAlgorithms(var AlgorithmList: TPGPCipherAlgorithms; var Count: Longint): Longint;
function GetPreferredCipherAlgorithm(var Algorithm: PGPCipherAlgorithm): Longint;

implementation

function ShortPos(Find: Char; const Dest: String; Pos: Integer): Integer; assembler;
asm	// EAX=Find, EDX=@Dest, ECX=Pos
  OR	EDX,EDX
  JE	@EXIT
  OR	ECX,ECX
  JLE	@EXIT
  SUB	ECX,[EDX-04h]
  JG	@EXIT
  PUSH	EDX
  DEC	ECX
  ADD	EDX,[EDX-04h]
  @LOOP:
  CMP	[EDX+ECX],AL
  JE	@MATCH
  INC	ECX
  JNE	@LOOP
  POP	EDX
  XOR	EAX,EAX
  RET
  @MATCH:
  INC	ECX
  POP	EDX
  MOV	EAX,ECX
  ADD	EAX,[EDX-04h]
  RET
  @EXIT:
  XOR	EAX,EAX
end;

function ShortStrPos(const Find, Dest: String; Pos: Integer): Integer; assembler;
asm	// EAX=@Find, EDX=@Dest, ECX=Pos
  OR	EAX,EAX
  JE	@EXIT
  OR	EDX,EDX
  JE	@EXIT
  OR	ECX,ECX
  JLE	@EXIT
  PUSH	EBX
  MOV	EBX,[EAX-04h]
  SUB	ECX,[EDX-04h]
  ADD	EBX,ECX
  CMP	EBX,1
  JG	@END
  CMP	DWORD PTR [EAX-04h],1
  JE	@CHAR
  PUSH	EBP
  PUSH	EDI
  PUSH	ESI
  MOV	EDI,EDX
  MOV	ESI,EAX
  ADD	EDI,[EDX-04h]
  MOV	AL,[ESI]
  DEC	EDI
  @LOOP:
  CMP	[EDI+ECX],AL
  JE	@MATCH
  INC	ECX
  JNE	@LOOP
  XOR	EAX,EAX
  POP	ESI
  POP	EDI
  POP	EBP
  POP	EBX
  RET
  @MATCH:
  NEG	ECX
  CMP	ECX,[ESI-04h]
  JE	@NOT
  PUSH	EDI
  NEG	ECX
  MOV	EBX,[ESI-04h]
  MOV	EBP,ESI
  ADD	EDI,EBX
  ADD	EBP,EBX
  ADD	EDI,ECX
  NEG	EBX
  @CMP:
  INC	EBX
  JE	@YES
  MOV	AH,[EDI+EBX]
  CMP	[EBP+EBX],AH
  JE	@CMP
  POP	EDI
  INC	ECX
  JNE	@LOOP
  @NOT:
  XOR	EAX,EAX
  POP	ESI
  POP	EDI
  POP	EBP
  POP	EBX
  RET
  @YES:
  ADD	ECX,[EDX-04h]
  POP	EDI
  MOV	EAX,ECX
  POP	ESI
  POP	EDI
  POP	EBP
  POP	EBX
  RET
  @END:
  POP	EBX
  @EXIT:
  XOR	EAX,EAX
  RET
  @CHAR:
  POP	EBX
  PUSH	EDX
  DEC	ECX
  ADD	EDX,[EDX-04h]
  MOV	AL,[EAX]
  @@LOOP:
  CMP	[EDX+ECX],AL
  JE	@@MATCH
  INC	ECX
  JNE	@@LOOP
  POP	EDX
  XOR	EAX,EAX
  RET
  @@MATCH:
  INC	ECX
  POP	EDX
  MOV	EAX,ECX
  ADD	EAX,[EDX-04]
end;

function ExtractStr(const Str: String): String;
var iPos: Longint;
begin
  Result:=Str;
  iPos:=Length(Result);
  if iPos>1 then begin
    if (Result[iPos]=BS) and (Result[pred(iPos)]=SP) then begin
      Delete(Result, pred(iPos), 2);
      dec(iPos, 2);
    end;
    if (iPos<>0) and (Result[1]=QU) and (Result[iPos]=QU) then begin
      Delete(Result, iPos, 1);
      Delete(Result, 1, 1);
    end;
  end;
end;

constructor TPrefsFile.Create;
var FilePath: String;
begin
  inherited;
  PrefsData:=TStringList.Create;
  if PGP8X then
    FilePath:=GetAppPathRegEntry(AppDataRegPath, 'AppData') + PGPAppDataPath
  else FilePath:=GetAppPathRegEntry(AppDataRegPath, 'AppData') + NAIAppDataPath;
  PrefsFilePath:=FilePath + PrefsFileName;
  GroupsFilePath:=FilePath + GroupsFileName;
end;

destructor TPrefsFile.Destroy;
begin
  PrefsData.Free;
  inherited;
end;

function TPrefsFile.LoadPrefs: Longbool;
var Buffer: String; iIndex: Longint;
begin
  Result:=false;
  if (PrefsData<>nil) and (PrefsFilePath<>E) then with PrefsData do begin
    try
      LoadFromFile(PrefsFilePath);
      Buffer:=Text;
      iIndex:=1;
      repeat
	iIndex:=ShortStrPos(SP + BS + CRLF, Buffer, iIndex);
	if iIndex>1 then begin
	  if (Buffer[pred(iIndex)]=QU) then
	    System.Delete(Buffer, pred(iIndex), Length(QU + SP + BS + CRLF + QU))
	  else System.Delete(Buffer, iIndex, Length(SP + BS + CRLF));
	end;
      until iIndex=0;
      Text:=Buffer;
      Result:=(Count<>0);
    except
    end;
  end;
end;

function TPrefsFile.SavePrefs: Longbool;
begin
  Result:=false;
  if (PrefsData<>nil) and (PrefsFilePath<>E) then with PrefsData do begin
    try
      SaveToFile(PrefsFilePath);
      Result:=true;
    except
    end;
  end;
end;

function TPrefsFile.GetPGPKeyID(const PGPKeyIDString: String): TPGPKeyID7; assembler;
asm	// EAX=@Self, EDX=@PGPKeyIDString, ECX=@Result
  PUSH	ECX
  OR	EDX,EDX
  JE	@ERROR
  CMP	DWORD PTR [EDX-04h],TYPE TPGPKeyID7 * 2 + 2
  JNE	@ERROR
  AND	BYTE PTR [EDX + 01h],0DFh
  CMP	WORD PTR [EDX],'X0'
  JNE	@ERROR
  ADD	EDX,2
  @START:
  MOV	AX,[EDX]
  @FIRSTHEX:
  CMP	AL,'0'
  JB	@ERROR
  CMP	AL,'9'
  JA	@LOBYTE
  SUB	AL,'0'
  JMP	@NEXTHEX
  @LOBYTE:
  AND	AL,0DFh
  CMP	AL,'A'
  JB	@ERROR
  CMP	AL,'F'
  JA	@ERROR
  SUB	AL,'A' - 0Ah
  @NEXTHEX:
  CMP	AH,'0'
  JB	@ERROR
  CMP	AH,'9'
  JA	@HIBYTE
  SUB	AH,'0'
  JMP	@DECODE
  @HIBYTE:
  AND	AH,0DFh
  CMP	AH,'A'
  JB	@ERROR
  CMP	AH,'F'
  JA	@ERROR
  SUB	AH,'A' - 0Ah
  @DECODE:
  SHL	AL,4
  ADD	AL,AH
  MOV	[ECX],AL
  CMP	BYTE PTR [EDX + 02h],0
  JE	@EXIT
  ADD	EDX,2
  INC	ECX
  JMP	@START
  @ERROR:
  POP	ECX
  MOV	DWORD PTR [ECX],0
  RET
  @EXIT:
  POP	ECX
end;

function TPrefsFile.GetPGPKeyIDString(const PGPKeyID: TPGPKeyID7): String; assembler;
asm	// EAX=@Self, EDX=@PGPKeyID, ECX=@Result
  JMP	@BEGIN
  @HEXCHARS:
  DB	'0123456789ABCDEF';
  @BEGIN:
  PUSH	EBX
  PUSH	EDI
  PUSH	ESI
  MOV	ESI,EDX
  MOV	EDI,ECX
  MOV	EAX,TYPE TPGPKeyID7 * 2
  CALL	SYSTEM.@NEWANSISTRING
  MOV	[EDI],EAX
  MOV	EDI,EAX
  MOV	ECX,TYPE TPGPKeyID7 - 1
  MOV	EBX,ECX
  SHL	EBX,1
  @LOOP:
  MOVZX	EAX,BYTE PTR[ESI + ECX]
  MOV	EDX,EAX
  AND	EAX,0Fh
  SHR	EDX,4
  MOV	AH,BYTE PTR[@HEXCHARS + EAX]
  MOV	AL,BYTE PTR[@HEXCHARS + EDX]
  MOV	[EDI + EBX],AX
  SUB	EBX,2
  DEC	ECX
  JNS	@LOOP
  @END:
  POP	ESI
  POP	EDI
  POP	EBX
end;

function TPrefsFile.GetAppPathRegEntry(const RegPath, RegKey: String): String;
var
  hRegKey: hKey;
  dwBufSize: DWord;
  aFilePath: Array[0..MAX_PATH] of Char;
begin
  dwBufSize:=MAX_PATH;
  if RegOpenKeyEx(HKEY_CURRENT_USER, PChar(RegPath), 0, KEY_QUERY_VALUE, hRegKey)=ERROR_SUCCESS then begin
    try
      if RegQueryValueEx(hRegKey, PChar(RegKey), nil, nil, @aFilePath, @dwBufSize)=ERROR_SUCCESS then begin
	Result:=aFilePath;
	Exit;
      end;
    finally
      RegCloseKey(hRegKey);
    end;
  end;
  Result:=E;
end;

function GetPGPVersionString: String;
var
  hRegKey: hKey;
  sRegPath: String;
  dwKeyIndex, dwBufSize: DWord;
  aKeyName: Array[0..MAX_PATH] of Char;
  ftLastWrite: TFileTime;
  iDotPos: Integer;
begin
  dwBufSize:=MAX_PATH;
  if PGP8X then
    sRegPath:='Software' + PGPAppDataPath
  else sRegPath:='Software' + NAIAppDataPath;
  if RegOpenKeyEx(HKEY_LOCAL_MACHINE, PChar(sRegPath), 0,
		  KEY_ENUMERATE_SUB_KEYS, hRegKey)=ERROR_SUCCESS then begin
    try
      dwKeyIndex:=0;
      while RegEnumKeyEx(hRegKey, dwKeyIndex, @aKeyName, dwBufSize,
			 nil, nil, nil, @ftLastWrite)<>ERROR_NO_MORE_ITEMS do begin
	if dwBufSize>1 then begin
	  iDotPos:=pos('.', aKeyName);
	  if (iDotPos<>0) and (aKeyName[iDotPos] in ['0'..'9']) then begin
	    Result:=aKeyName;
	    Exit;
	  end;
	end;
	inc(dwKeyIndex);
      end;
    finally
      RegCloseKey(hRegKey);
    end;
  end;
  Result:=E;
end;

function GetPreferences(var Prefs: TPreferenceRec; Flags: Longint): Longint;
var
  Context	: pPGPContext;
  FileSpec	: pPGPFileSpec;
  FileOut	: PChar;
  KeyOut	: PChar;
  PGPKeyID	: TPGPKeyID7;
  IDSize	: PGPSize;
  KeyID		: TKeyID;
begin
  Result:=kPGPError_PrefNotFound;
  if Flags<>0 then begin
    FillChar(Prefs, SizeOf(Prefs), 0);
    if PGP7X then begin
      if PrefsFile<>nil then with PrefsFile do if LoadPrefs then begin
	try
	  if Flags and PrefsFlag_PublicKeyring<>0 then Prefs.PublicKeyring:=ExtractStr(PrefsData.Values[PubFile]);
	  if Flags and PrefsFlag_PrivateKeyring<>0 then Prefs.PrivateKeyring:=ExtractStr(PrefsData.Values[SecFile]);
	  if Flags and PrefsFlag_RandomSeedFile<>0 then Prefs.RandomSeedFile:=ExtractStr(PrefsData.Values[RNGFile]);
	  if Flags and PrefsFlag_GroupsFile<>0 then Prefs.GroupsFile:=PrefsFile.GroupsFilePath;
	  if Flags and PrefsFlag_DefaultKeyID<>0 then begin
	    PGPKeyID:=GetPGPKeyID(PrefsData.Values[DefKeyID]);
	    Result:=PGPGetKeyIDString(PGPKeyID, kPGPKeyIDString_Full, KeyID);
	    if Result=0 then Prefs.DefaultKeyHexID:=KeyID;
	  end;
	  Result:=0;
	except
	end;
	PrefsData.Clear;
      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
	  Result:=PGPsdkPrefGetFileSpec(Context, kPGPsdkPref_PublicKeyring, FileSpec);
	  try
	    if Result=0 then begin
	      FileOut:=nil;
	      Result:=PGPGetFullPathFromFileSpec(FileSpec, FileOut);
	      try
		Prefs.PublicKeyring:=FileOut;
	      finally
		PGPFreeData(FileOut);
	      end;
	    end;
	  finally
	    PGPFreeFileSpec(FileSpec);
	  end;
	end;
	if Result<>0 then Exit;

	// Secring
	if Flags and PrefsFlag_PrivateKeyring<>0 then begin
	  Result:=PGPsdkPrefGetFileSpec(Context, kPGPsdkPref_PrivateKeyring, FileSpec);
	  try
	    if Result=0 then begin
	      FileOut:=nil;
	      Result:=PGPGetFullPathFromFileSpec(FileSpec, FileOut);
	      try
		Prefs.PrivateKeyring:=FileOut;
	      finally
		PGPFreeData(FileOut);
	      end;
	    end;
	  finally
	    PGPFreeFileSpec(FileSpec);
	  end;
	end;
	if Result<>0 then Exit;

	// Randseed file
	if Flags and PrefsFlag_RandomSeedFile<>0 then begin
	  Result:=PGPsdkPrefGetFileSpec(Context, kPGPsdkPref_RandomSeedFile, FileSpec);
	  try