pgp2comp.pas

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

    function Update: Longint;
    property RingPropsList: TKeyPropsList
      read FRingPropsList;
  published
    property RingAlgorithmFilter: TAlgorithmKeyFilter
      read FRingAlgorithmFilter
      write FRingAlgorithmFilter;
    property RingBoolFilter: TBooleanKeyFilter
      read FRingBoolFilter
      write FRingBoolFilter;
    property RingKeyOrdering: TKeyOrdering
      read FRingKeyOrdering
      write FRingKeyOrdering;
    property RingProps: TKeyProps
      read FRingProps
      write FRingProps;
    property ComboBox: TComboBox
      read FComboBox
      write FComboBox;
    property ListBox: TListBox
      read FListBox
      write FListBox;
    property OnFailure: TOnFailure
      read FOnFailure
      write FOnFailure;
  end;

  TOnGetKeyID = procedure(var KeyID: String) of Object;
  TOnGetKeyProps = procedure(const KeyPropsList: TKeyPropsList) of Object;

  TPGPGetKeyProps = class(TKeyRingProps)
  private
    FAlgorithmFilter: TAlgorithmKeyFilter;
    FBoolFilter: TBooleanKeyFilter;
    FKeyOrdering: TKeyOrdering;
    FKeyID: String;
    FKeyProps: TKeyProps;
    FOnGetKeyID: TOnGetKeyID;
    FOnGetKeyProps: TOnGetKeyProps;
  protected
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function DoGetKeyProps: Longint;
    function KeyIsOnRing: Longint;
    function KeyRingCount: Longint;
    function GetKeyProp(KeyPropsList: TKeyPropsList; KeyIndex: Longint; KeyProp: TKeyProp): Variant;
    function GetUserIDList(KeyPropsList: TKeyPropsList; KeyIndex: Longint): TStringList;
    function GetSignerIDList(KeyPropsList: TKeyPropsList; KeyIndex: Longint): TStringList;
    function GetRevKeyIDList(KeyPropsList: TKeyPropsList; KeyIndex: Longint): TStringList;
    function GetADKeyIDList(KeyPropsList: TKeyPropsList; KeyIndex: Longint): TStringList;
    function GetGroupHexIDs(KeyPropsList: TKeyPropsList; GroupIndex: Longint; var GroupName: String): String;
  published
    property AlgorithmFilter: TAlgorithmKeyFilter
      read FAlgorithmFilter
      write FAlgorithmFilter;
    property BoolFilter: TBooleanKeyFilter
      read FBoolFilter
      write FBoolFilter;
    property KeyOrdering: TKeyOrdering
      read FKeyOrdering
      write FKeyOrdering;
    property KeyID: String
      read FKeyID
      write FKeyID;
    property KeyProps: TKeyProps
      read FKeyProps
      write FKeyProps;
    property OnGetKeyID: TOnGetKeyID
      read FOnGetKeyID
      write FOnGetKeyID;
    property OnGetKeyProps: TOnGetKeyProps
      read FOnGetKeyProps
      write FOnGetKeyProps;
  end;


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

type
  TOnKeySelected = function(const KeyProps: TKeyPropsRec): Longbool of Object;
  TOnEnterPassphrase = procedure(const Passphrase: PChar; var Cancel: Longbool) of Object;
  TOnChangePassphrase = procedure(const OldPassphrase, NewPassphrase: PChar;
				  MinPassLen: TMinPassLen;
				  MinPassQual: TMinPassQual;
				  var Cancel: Longbool) of Object;

  TPGPSetKeyProps = class(TComponent)
  private
    FParentHandle: THandle;
    FKeyDlgPrompt: String;
    FKeyHexID: String;
    FKeyProps: TKeyProps;
    FMinPassLen: TMinPassLen;
    FMinPassQual: TMinPassQual;
    FPassDlgPrompt: String;
    FPassDlgNewPrompt: String;
    FPassDlgOldPrompt: String;
    FOnFailure: TOnFailure;
    FOnKeySelected: TOnKeySelected;
    FOnEnterPassphrase: TOnEnterPassphrase;
    FOnChangePassphrase: TOnChangePassphrase;
    function GetKeyHexID(FilterFlags: DWord): Longint;
  protected
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function DoKeyDisable: Longint;
    function DoKeyEnable: Longint;
    function DoKeyRemove: Longint;
    function DoKeyRevoke: Longint;
    function DoKeyPassChange: Longint;
    property ParentHandle: THandle
      read FParentHandle
      write FParentHandle;
  published
    property KeyID: String
      read FKeyHexID
      write FKeyHexID;
    property KeyProps: TKeyProps
      read FKeyProps
      write FKeyProps;
    property KeyDlgPrompt: String
      read FKeyDlgPrompt
      write FKeyDlgPrompt;
    property PassDlgPrompt: String
      read FPassDlgPrompt
      write FPassDlgPrompt;
    property PassDlgNewPrompt: String
      read FPassDlgNewPrompt
      write FPassDlgNewPrompt;
    property PassDlgOldPrompt: String
      read FPassDlgOldPrompt
      write FPassDlgOldPrompt;
    property MinPassLen: TMinPassLen
      read FMinPassLen
      write FMinPassLen;
    property MinPassQual: TMinPassQual
      read FMinPassQual
      write FMinPassQual;
    property OnFailure: TOnFailure
      read FOnFailure
      write FOnFailure;
    property OnKeySelected: TOnKeySelected
      read FOnKeySelected
      write FOnKeySelected;
    property OnEnterPassphrase: TOnEnterPassphrase
      read FOnEnterPassphrase
      write FOnEnterPassphrase;
    property OnChangePassphrase: TOnChangePassphrase
      read FOnChangePassphrase
      write FOnChangePassphrase;
  end;


// TPGPKeysGenerate ------------------------------------------------------------

type
  TPGPKeysGenerate = class(TPGPKeysGenerateCustom)
  private
    FOnFailure: TOnFailure;
  protected
  public
    constructor Create(AOwner: TComponent); override;
    function DHDSSKeyGenerate: Longint; override;
    function DHSubKeyGenerate: Longint; override;
    function DSAKeyGenerate: Longint; override;
    function RSASubKeyGenerate: Longint; override;
    function RSAKeyGenerate(Legacy: Longbool): Longint; override;
  published
    property OnFailure: TOnFailure
      read FOnFailure
      write FOnFailure;
  end;


// TPGPKeyImport ---------------------------------------------------------------

type
  TOnGetFileIn = procedure(var FileIn: String) of Object;
  TOnKeyImported = procedure(const KeyPropsList: TKeyPropsList; KeysImported: Longint) of Object;

  TPGPKeyImport = class(TComponent)
  private
    FParentHandle: THandle;
    FFileIn: String;
    FIgnoreKnownKeys: TIgnoreKnownKeys;
    FKeyData: String;
    FKeyDlgPrompt: String;
    FKeyProps: TKeyProps;
    FOnFailure: TOnFailure;
    FOnGetFileIn: TOnGetFileIn;
    FOnKeyImported: TOnKeyImported;
  protected
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function DoKeyImport: Longint;
    function DoKeyImportFile: Longint;
    property ParentHandle: THandle
      read FParentHandle
      write FParentHandle;
  published
    property FileIn: String
      read FFileIn
      write FFileIn;
    property IgnoreKnownKeys: TIgnoreKnownKeys
      read FIgnoreKnownKeys
      write FIgnoreKnownKeys;
    property KeyData: String
      read FKeyData
      write FKeyData;
    property KeyDlgPrompt: String
      read FKeyDlgPrompt
      write FKeyDlgPrompt;
    property KeyProps: TKeyProps
      read FKeyProps
      write FKeyProps;
    property OnFailure: TOnFailure
      read FOnFailure
      write FOnFailure;
    property OnGetFileIn: TOnGetFileIn
      read FOnGetFileIn
      write FOnGetFileIn;
    property OnKeyImported: TOnKeyImported
      read FOnKeyImported
      write FOnKeyImported;
  end;


// TPGPKeyExport ---------------------------------------------------------------

type
  TOnGetFileOut = procedure(var FileOut: String) of Object;
  TOnKeyExported = procedure(const KeyPropsList: TKeyPropsList; const KeyData: String; const FileOut: String) of Object;

  TPGPKeyExport = class(TComponent)
  private
    FParentHandle: THandle;
    FExportCompatible: Longbool;
    FExportPrivate: Longbool;
    FFileOut: String;
    FKeyData: String;
    FKeyIDs: TStrings;
    FKeyDlgPrompt: String;
    FKeyProps: TKeyProps;
    FOnFailure: TOnFailure;
    FOnGetFileOut: TOnGetFileOut;
    FOnKeyExported: TOnKeyExported;
    procedure SetKeyIDs(const Value: TStrings);
  protected
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function DoKeyExport: Longint;
    function DoKeyExportFile: Longint;
    property ParentHandle: THandle
      read FParentHandle
      write FParentHandle;
  published
    property ExportCompatible: Longbool
      read FExportCompatible
      write FExportCompatible;
    property ExportPrivate: Longbool
      read FExportPrivate
      write FExportPrivate;
    property FileOut: String
      read FFileOut
      write FFileOut;
    property KeyData: String
      read FKeyData
      write FKeyData;
    property KeyIDs: TStrings
      read FKeyIDs
      write SetKeyIDs;
    property KeyDlgPrompt: String
      read FKeyDlgPrompt
      write FKeyDlgPrompt;
    property KeyProps: TKeyProps
      read FKeyProps
      write FKeyProps;
    property OnFailure: TOnFailure
      read FOnFailure
      write FOnFailure;
    property OnGetFileOut: TOnGetFileOut
      read FOnGetFileOut
      write FOnGetFileOut;
    property OnKeyExported: TOnKeyExported
      read FOnKeyExported
      write FOnKeyExported;
  end;


// TPGPEncode ------------------------------------------------------------------

type
  TOnEncoded = procedure(const BufferOut, FileOut: String) of Object;

  TPGPEncode = class(TPGPEncodeCustom)
  private
    FOnEncoded: TOnEncoded;
    FOnFailure: TOnFailure;
  protected
  public
    constructor Create(AOwner: TComponent); override;
    function KeyEncryptBuffer(const DataBuffer: String; Sign: Longbool): Longint; override;
    function KeyEncryptFile(const FileName: String; Sign: Longbool): Longint; override;
    function ConventionalEncryptBuffer(const DataBuffer: String): Longint; override;
    function ConventionalEncryptFile(const FileName: String): Longint; override;
    function ClearSignBuffer(const DataBuffer: String): Longint; override;
    function ClearSignFile(const FileName: String): Longint; override;
    function ArmorBuffer(const DataBuffer: String): Longint; override;
    function ArmorFile(const FileName: String): Longint; override;
    function DetachedSignBuffer(const DataBuffer: String): Longint; override;
    function DetachedSignFile(const FileName: String): Longint; override;
  published
    property OnEncoded: TOnEncoded
      read FOnEncoded
      write FOnEncoded;
    property OnFailure: TOnFailure
      read FOnFailure
      write FOnFailure;
  end;


// TPGPDecode ------------------------------------------------------------------

type
  TOnDecoded = procedure(const BufferOut, FileOut: String;
			 const SigProps: TSigPropsRec;
			 const KeyPropsList: TKeyPropsList) of Object;

  TPGPDecode = class(TPGPDecodeCustom)
  private
    FIgnoreKnownKeys: TIgnoreKnownKeys;
    FOnDecoded: TOnDecoded;
    FOnFailure: TOnFailure;
  protected
  public
    constructor Create(AOwner: TComponent); override;
    function DecodeBuffer(const DataBuffer: String): Longint; override;
    function DecodeFile(const FileName: String): Longint; override;
  published
    property IgnoreKnownKeys: TIgnoreKnownKeys
      read FIgnoreKnownKeys
      write FIgnoreKnownKeys;
    property OnDecoded: TOnDecoded
      read FOnDecoded
      write FOnDecoded;
    property OnFailure: TOnFailure
      read FOnFailure
      write FOnFailure;
  end;


// Utilities -------------------------------------------------------------------

type
  EFailException = class(Exception);

procedure SetVersionString(const Version: String);
function GetPGPVersion: String;
function WipeFiles(const FileNames: TStrings; ParentHandle: THandle): Longbool;
function ValidPassphrase(const KeyID: String; Passphrase: PChar): Longbool;
function GetShortHexID(const HexID: String): String;
function ValidSecMem(Alloc: PChar): Longbool;
function SecAlloc(Size: Cardinal): PChar;
function SecFree(var Alloc: PChar): Longint;
function SecRealloc(var Alloc: PChar; Size: Cardinal; Copy: Longbool): Longint;


implementation


// String constants

const
  AT = '@';
  LT = '<';
  GT = '>';
  TAB = #9;
  ALL = '';
  EMPTY = '';
  SPACE = ' ';
  COMMA = ',';
  SLASH = '/';
  BSLASH = '\';
  CRLF = #13#10;
  HexFormError = 'Hex format error: ';
  PathStrError = 'Path string error: ';
  PGPInitError = 'PGP initialization failure';
  UnknownPrefsErr = 'Unknown Preferences error';
  UnknownServerErr = 'Unknown Server error';
  UnknownKeyRingErr = 'Unknown KeyRing error';
  UnknownKeyPropsErr = 'Unknown KeyProps error';
  UnknownKeyOnRingErr = 'Unknown KeyOnRing error';
  UnknownKeyRingCountErr = 'Unknown KeyRingCount error';
  UnknownKeyDisableErr = 'Unknown KeyDisable error';
  UnknownKeyEnableErr = 'Unknown KeyEnable error';
  UnknownKeyRemoveErr = 'Unknown KeyRemove error';
  UnknownKeyRevokeErr = 'Unknown KeyRevoke error';
  UnknownKeyPassChangeErr = 'Unknown KeyPassChange error';
  UnknownKeyGenErr = 'Unknown KeysGenerate error';
  UnknownKeyImportErr = 'Unknown KeyImport error';
  UnknownKeyExportErr = 'Unknown KeyExport error';
  UnknownEncodeErr = 'Unknown Encode error';
  UnknownDecodeErr = 'Unknown Decode error';


// Utility Funcs ---------------------------------------------------------------

procedure SetVersionString(const Version: String);