pgpencode.pas
来自「用DELPHI实现的 PGP 加密算法」· PAS 代码 · 共 857 行 · 第 1/2 页
PAS
857 行
{$J+,Z4}
unit PGPEncode;
{------------------------------------------------------------------------------}
{ }
{ This unit is partly based on Steve Heller's }
{ 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,
UTF8,
pgpBase,
pgpErrors,
pgpPubTypes,
pgpUtilities,
pgpOptionList,
pgpMemoryMgr,
pgpEvents,
pgpKeys,
pgpTLS,
KeyFuncs,
PrefFuncs,
PGPDialogs;
type
TSignAlgorithm = (
HashAlgorithm_Default,
HashAlgorithm_MD5,
HashAlgorithm_SHA,
HashAlgorithm_RIPEMD160{,
HashAlgorithm_SHA256,
HashAlgorithm_SHA384,
HashAlgorithm_SHA512}
// not yet implemented in PGP 8.0
);
TConventionalAlgorithm = (
CipherAlgorithm_IDEA,
CipherAlgorithm_3DES,
CipherAlgorithm_CAST5,
CipherAlgorithm_AES128,
CipherAlgorithm_AES192,
CipherAlgorithm_AES256,
CipherAlgorithm_Twofish256
);
TFormatOption = (
Format_Armor,
Format_MIME,
Format_Textmode
);
TFormatOptions = Set of TFormatOption;
TOnGetInputFileName = procedure(var SuggestedName: String) of Object;
TOnGetOutputFileName = procedure(var SuggestedName: String) of Object;
TOnEnterPassphrase = procedure(const Passphrase: PChar;
const SigningKeyList: TKeyPropsList;
var SelectedKey: Longint;
BadPassphrase: Longbool;
var Cancel: Longbool) of Object;
TOnShowProgress = procedure(BytesProcessed, BytesTotal: Longint) of Object;
TOnWipePassphrase = procedure(const Passphrase: PChar) of Object;
TPGPEncodeCustom = class(TComponent)
private
// internal
FContext: pPGPContext;
FKeySetMain: pPGPKeySet;
FtlsContext: pPGPTLSContext;
FPreferences: TPreferenceRec;
FAllocatedOutputBuffer: PChar;
FActualOutputSize: PGPSize;
FPassphraseBufSize: Cardinal;
FInputSize: PGPSize;
FInputFileName: String;
FOutputBuffer: String;
FPassphrase: PChar;
FEncryptKeySet: pPGPKeySet;
FClear: Longbool;
FCompress: Longbool;
FConventional: Longbool;
FDetachedSign: Longbool;
FEncrypt: Longbool;
FSign: Longbool;
// properties
FComment: String;
FConventionalAlgorithm: TConventionalAlgorithm;
FEncryptToSelf: Longbool;
FEyesOnly: Longbool;
FFileOutput: Longbool;
FFormatOptions: TFormatOptions;
FMimeBodyOffset: Longint;
FMimeSeparator: String;
FOmitMimeVersion: Longbool;
FParentHandle: THandle;
FProgressInterval: Cardinal;
FSignAlgorithm: TSignAlgorithm;
FEncryptKeyIDs: TStrings;
FSignKeyID: String;
FKeyDlgPrompt: String;
FPassDlgPrompt: String;
FOutputFileName: String;
// events
FOnGetInputFileName: TOnGetInputFileName;
FOnGetOutputFileName: TOnGetOutputFileName;
FOnEnterPassphrase: TOnEnterPassphrase;
FOnShowProgress: TOnShowProgress;
FOnWipePassphrase: TOnWipePassphrase;
procedure SetVersionString(const Value: String);
function GetVersionString: String;
procedure SetEncryptKeyIDs(const Value: TStrings);
procedure SetClear(Value: Longbool);
procedure SetConventional(Value: Longbool);
procedure SetEncrypt(Value: Longbool);
procedure SetSign(Value: Longbool);
function InitEncode: PGPError;
procedure FinitEncode;
function WriteOutputFile: PGPError;
function GetEncryptKeyIDs(const EncryptKeyIDs: TStrings; SignKeyID: String): PGPError;
function GetOptionList(var OptionList: pPGPOptionList): PGPError;
function SetOutputOption(var OptionList: pPGPOptionList): PGPError;
function Encode(const Input: String; IsFile: Longbool): Longint;
protected
property OutputBuffer: String
read FOutputBuffer;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function KeyEncryptBuffer(const DataBuffer: String; Sign: Longbool): Longint; virtual;
function KeyEncryptFile(const FileName: String; Sign: Longbool): Longint; virtual;
function ConventionalEncryptBuffer(const DataBuffer: String): Longint; virtual;
function ConventionalEncryptFile(const FileName: String): Longint; virtual;
function ClearSignBuffer(const DataBuffer: String): Longint; virtual;
function ClearSignFile(const FileName: String): Longint; virtual;
function ArmorBuffer(const DataBuffer: String): Longint; virtual;
function ArmorFile(const FileName: String): Longint; virtual;
function DetachedSignBuffer(const DataBuffer: String): Longint; virtual;
function DetachedSignFile(const FileName: String): Longint; virtual;
property MimeBodyOffset: Longint
read FMimeBodyOffset;
property MimeSeparator: String
read FMimeSeparator;
property ParentHandle: THandle
read FParentHandle
write FParentHandle;
published
property Comment: String
read FComment
write FComment;
property ConventionalAlgorithm: TConventionalAlgorithm
read FConventionalAlgorithm
write FConventionalAlgorithm;
property EncryptToSelf: Longbool
read FEncryptToSelf
write FEncryptToSelf;
property EyesOnly: Longbool
read FEyesOnly
write FEyesOnly;
property FileOutput: Longbool
read FFileOutput
write FFileOutput;
property FormatOptions: TFormatOptions
read FFormatOptions
write FFormatOptions;
property OmitMimeVersion: Longbool
read FOmitMimeVersion
write FOmitMimeVersion;
property ProgressInterval: Cardinal
read FProgressInterval
write FProgressInterval;
property SignAlgorithm: TSignAlgorithm
read FSignAlgorithm
write FSignAlgorithm;
property EncryptKeyIDs: TStrings
read FEncryptKeyIDs
write SetEncryptKeyIDs;
property SignKeyID: String
read FSignKeyID
write FSignKeyID;
property KeyDlgPrompt: String
read FKeyDlgPrompt
write FKeyDlgPrompt;
property PassDlgPrompt: String
read FPassDlgPrompt
write FPassDlgPrompt;
property OutputFileName: String
read FOutputFileName
write FOutputFileName;
property VersionString: String
read GetVersionString
write SetVersionString;
property OnGetInputFileName: TOnGetInputFileName
read FOnGetInputFileName
write FOnGetInputFileName;
property OnGetOutputFileName: TOnGetOutputFileName
read FOnGetOutputFileName
write FOnGetOutputFileName;
property OnEnterPassphrase: TOnEnterPassphrase
read FOnEnterPassphrase
write FOnEnterPassphrase;
property OnShowProgress: TOnShowProgress
read FOnShowProgress
write FOnShowProgress;
property OnWipePassphrase: TOnWipePassphrase
read FOnWipePassphrase
write FOnWipePassphrase;
end;
implementation
function EventHandler(Context: pPGPContext; Event: pPGPEvent; UserValue: PGPUserValue): PGPError; cdecl;
begin
Result:=0;
with TPGPEncodeCustom(UserValue) do begin
case Event^.EType of
kPGPEvent_NullEvent: if not (FDetachedSign or FClear) then begin
if TMethod(FOnShowProgress).Code<>nil then begin
// BytesTotal always stays 0 => use FInputSize
with Event^.EData.NullData do FOnShowProgress(BytesWritten, FInputSize);
end;
ProcessMessages;
end;
kPGPEvent_InitialEvent: ;
kPGPEvent_FinalEvent: ;
kPGPEvent_ErrorEvent: Result:=Event^.EData.ErrorData.Error;
kPGPEvent_WarningEvent: ;
end;
end;
end;
constructor TPGPEncodeCustom.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FEncryptKeyIDs:=TStringList.Create;
FProgressInterval:=1000;
end;
destructor TPGPEncodeCustom.Destroy;
begin
EncryptKeyIDs.Free;
inherited Destroy;
end;
procedure TPGPEncodeCustom.SetVersionString(const Value: String);
begin
if Value<>'' then
StrPLCopy(MyVersion, Value, pred(SizeOf(TVersionString)))
else if PGPGetSDKString(MyVersion)<>0 then MyVersion:='N/A';
end;
function TPGPEncodeCustom.GetVersionString: String;
begin
Result:=MyVersion;
end;
procedure TPGPEncodeCustom.SetEncryptKeyIDs(const Value: TStrings);
begin
FEncryptKeyIDs.Assign(Value);
end;
procedure TPGPEncodeCustom.SetClear(Value: Longbool);
begin
if Value<>FClear then FClear:=Value;
if FClear then begin
FSign:=true;
FEncrypt:=false;
FCompress:=false;
FConventional:=false;
FDetachedSign:=false;
Include(FFormatOptions, Format_Armor);
Include(FFormatOptions, Format_Textmode);
end;
end;
procedure TPGPEncodeCustom.SetConventional(Value: Longbool);
begin
if Value<>FConventional then FConventional:=Value;
if FConventional then begin
FDetachedSign:=false;
FEncrypt:=false;
FClear:=false;
FSign:=false;
end;
end;
procedure TPGPEncodeCustom.SetEncrypt(Value: Longbool);
begin
if Value<>FEncrypt then FEncrypt:=Value;
if FEncrypt then begin
FDetachedSign:=false;
FConventional:=false;
FClear:=false;
end;
end;
procedure TPGPEncodeCustom.SetSign(Value: Longbool);
begin
if Value<>FSign then FSign:=Value;
if FSign then FConventional:=false;
end;
function TPGPEncodeCustom.InitEncode: PGPError;
begin
FPassphrase:=nil;
FOutputBuffer:='';
FActualOutputSize:=0;
FAllocatedOutputBuffer:=nil;
Result:=KeyDlgInit(FContext, FtlsContext, FKeySetMain);
GetPreferences(FPreferences, PrefsFlag_GroupsFile or PrefsFlag_DefaultKeyID);
end;
procedure TPGPEncodeCustom.FinitEncode;
begin
KeyDlgFree(FContext, FtlsContext, FKeySetMain);
end;
function TPGPEncodeCustom.WriteOutputFile: PGPError;
var
OutputFile : THandle;
BytesWritten : DWord;
begin
OutputFile:=CreateFile(PChar(FOutputFileName), GENERIC_WRITE, 0, nil, CREATE_ALWAYS,
FILE_ATTRIBUTE_ARCHIVE or FILE_FLAG_WRITE_THROUGH, 0);
if OutputFile<>INVALID_HANDLE_VALUE then begin
try
if not WriteFile(OutputFile, FAllocatedOutputBuffer[0], FActualOutputSize, BytesWritten, nil)
or (BytesWritten<>DWord(FActualOutputSize)) then
Result:=kPGPError_WriteFailed
else Result:=kPGPError_NoErr;
finally
CloseHandle(OutputFile);
end;
end
else Result:=kPGPError_CantOpenFile;
end;
function TPGPEncodeCustom.GetEncryptKeyIDs(const EncryptKeyIDs: TStrings; SignKeyID: String): PGPError;
var
RecipientKeys : Pointer;
KeyPropsList : TKeyPropsList;
Armor : PGPUInt32;
MIME : PGPUInt32;
Textmode : PGPUInt32;
KeyCount : PGPUInt32;
begin
RecipientKeys:=nil;
with KeyRings do if GroupsFile=E then GroupsFile:=FPreferences.GroupsFile;
if FEncryptToSelf then begin
if not FSign then begin
KeyPropsList:=nil;
try
if FindKeyProps(SignKeyID, KeyPropsList,
spgpKeyPropFlag_KeyID or
spgpKeyPropFlag_CanEncrypt,
KeyFilterFlag_CanSign,
Any_Ordering)<>1 then begin
SignKeyID:=FPreferences.DefaultKeyHexID;
end;
finally
KeyPropsList.Free;
end;
if SignKeyID='' then begin
Result:=kPGPError_PublicKeyNotFound;
Exit;
end;
end;
end
else SignKeyID:='';
Result:=GetKeySetByAnyIDs(FContext, FKeySetMain, EncryptKeyIDs.CommaText, pPGPKeySet(RecipientKeys));
if Result<>0 then begin
if PGP7X then begin
try
EncryptKeyIDs.Clear;
Armor:=ord(Format_Armor in FFormatOptions);
MIME:=ord(Format_MIME in FFormatOptions);
Textmode:=ord(Format_Textmode in FFormatOptions);
Result:=RecipientsDialog(FContext, FKeySetMain, PGPTrue, Armor,
PGPUInt32(FEyesOnly), MIME, Textmode,
SignKeyID, pPGPKeyDB(RecipientKeys),
FKeyDlgPrompt, FParentHandle);
if Result=0 then begin
FFormatOptions:=[];
if Armor<>0 then Include(FFormatOptions, Format_Armor);
if MIME<>0 then Include(FFormatOptions, Format_MIME);
if Textmode<>0 then Include(FFormatOptions, Format_Textmode);
KeyPropsList:=nil;
try
KeyCount:=GetKeySetProps(FContext, PGPPeekKeyDBRootKeySet(pPGPKeyDB(RecipientKeys)),
KeyPropsList, spgpKeyPropFlag_KeyID,
KeyFilterFlag_CanEncrypt,
UserID_Ordering);
if KeyCount>0 then EncryptKeyIDs.Text:=TrimRight(KeyPropsList.Text);
finally
KeyPropsList.Free;
end;
end;
finally
PGPFreeKeyDB(pPGPKeyDB(RecipientKeys));
end;
end
else begin
try
EncryptKeyIDs.Clear;
Armor:=ord(Format_Armor in FFormatOptions);
MIME:=ord(Format_MIME in FFormatOptions);
Textmode:=ord(Format_Textmode in FFormatOptions);
Result:=RecipientsDialog(FContext, FKeySetMain, PGPTrue, Armor,
PGPUInt32(FEyesOnly), MIME, Textmode,
SignKeyID, pPGPKeySet(RecipientKeys),
FKeyDlgPrompt, FParentHandle);
if Result=0 then begin
FFormatOptions:=[];
if Armor<>0 then Include(FFormatOptions, Format_Armor);
if MIME<>0 then Include(FFormatOptions, Format_MIME);
if Textmode<>0 then Include(FFormatOptions, Format_Textmode);
KeyPropsList:=nil;
try
KeyCount:=GetKeySetProps(FContext, pPGPKeySet(RecipientKeys),
KeyPropsList, spgpKeyPropFlag_KeyID,
KeyFilterFlag_CanEncrypt,
UserID_Ordering);
if KeyCount>0 then EncryptKeyIDs.Text:=TrimRight(KeyPropsList.Text);
finally
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?