Delphi -- 创建 桌面、发送到...、快速启动栏、开始菜单、程序菜单、右键菜 单
{=================================================================
功 能:
创建 桌面、发送到...、快速启动栏、开始菜单、程序菜单、右键菜单 快捷方式
参 数:
FileName : 快捷方式执行文件名
Description : 快捷方式描述信息
Arguements : 快捷方式执行参数
ShowName : 快捷方式显示名称
Location : 快捷方式类别
id : 需设置状态的队列号(255 为设置)
CreateOrDelete: 是创建还是删除(默认为创建 true)
返 回 值: 无
备 注:
需要引用 Registry, ShlObj, ComObj, ActiveX, RegStr 单元
=================================================================}
procedure TMainForm.CreateShortcut(FileName,Description,Arguements,ShowName:
string;
Location: ShortcutType; id: byte; CreateOrDelete: boolean=true);
var
cObj :IUnknown;
sLink :IShellLink;
pFile :IPersistFile;
sDir,spath,key,tmp :string;
wFileName :WideString;
mReg :TRegistry;
begin
cObj :=CreateComObject(CLSID_ShellLink); //创建COM对象
sLink :=cObj as IShellLink; //COM对象转化为IShellLink型接口
pFile :=cObj as IPersistFile; //COM对象转化为IPersistFile型接口
//获取路径
sPath :=ExtractFilePath(FileName);
with sLink do begin
SetPath(PChar(FileName)); //设置执行文件名
SetArguments(PChar(arguements)); //设置执行参数
SetDescription(Pchar(Description)); //设置描述信息
SetWorkingDirectory(PChar(sPath)); //设置工作路径，即执行程序所在目录
end;
//获取各快捷方式的实际目录
mReg :=TRegistry.Create;
with mReg do begin
if Location=ST_CONTEXT then //添加右键菜单
begin
RootKey :=HKEY_CLASSES_ROOT;
tmp:= '*shell'+ShowName;
if CreateOrDelete then
begin
if OpenKey(tmp,true) then
begin
//用writestring将设置值写入打开的主键
WriteString('',ShowName+'(&k)');
CloseKey;
end;
if OpenKey(tmp+'command',true) then
begin
//command子键的内容是点击右键后选择相应项后要运行的程序；
//%1是在单击右键时选中的文件名
//WriteString(,'c:delphimyprogram.exe+"%1"');
WriteString('',FileName);
CloseKey;
end;
end
else
DeleteKey(tmp);
Free;
exit;
end;
RootKey :=HKEY_CURRENT_USER;
key :=REGSTR_PATH_EXPLORER; //Delphi在单元RegStr中定义的常量
tmp :=key + 'Shell Folders';
OpenKey(tmp, false);
case Location of
ST_DESKTOP: sDir :=ReadString('Desktop');
ST_SENDTO: sDir :=ReadString('SendTo');
ST_STARTMENU: sDir :=ReadString('Start Menu');
ST_PROGRAMS: sDir :=ReadString('Programs');
ST_QUICKLAUNCH:
begin
sDir :=ReadString('AppData');
sDir :=sDir + 'MicrosoftInternet ExplorerQuick Launch';
end;
end;
//生成快捷方式文件名
if ShowName='' then
begin
ShowName :=ChangeFileExt(FileName, '.Lnk');
ShowName :=ExtractFileName(ShowName);
end
else
ShowName:= ShowName+'.lnk';
if sDir<>'' then
begin
//生成快捷方式全路径名
wFileName :=sDir + '' + ShowName;
if (id<255) then
begin
if FileExists(wFileName) then
//RzCheckGroup1.ItemChecked[id]:= true;
end
else
//保存或删除生成的快捷方式文件
if CreateOrDelete then
pFile.Save(PWChar(wFileName), false)
else
DeleteFile(wFileName);
end;
Free;
end;
end;
Delphi AES加密(转)
(**************************************************************)
(* Advanced Encryption Standard (AES) *)
(* Interface Unit v1.3 *)
(* *)
(* Copyright (c) 2002 Jorlen Young *)
(* *)
(* 说明： *)
(* 基于 ElASE.pas 单元封装 *)
(* *)
(* 这是一个 AES 加密算法的标准接口。 *)
(* 调用示例： *)
(* if not EncryptStream(src, key, TStream(Dest), keybit) then *)
(* showmessage('encrypt error'); *)
(* *)
(* if not DecryptStream(src, key, TStream(Dest), keybit) then *)
(* showmessage('encrypt error'); *)
(* *)
(* *** 一定要对Dest进行TStream(Dest) *** *)
(* ========================================================== *)
(* *)
(* 支持 128 / 192 / 256 位的密匙 *)
(* 默认情况下按照 128 位密匙操作 *)
(* *)
(**************************************************************)
unit AES;
interface
{$IFDEF VER210}
{$WARN IMPLICIT_STRING_CAST OFF} //关闭警告
{$WARN IMPLICIT_STRING_CAST_LOSS OFF}
{$ENDIF}
uses
SysUtils, Classes, Math, ElAES;
const
SDestStreamNotCreated = 'Dest stream not created.';
SEncryptStreamError = 'Encrypt stream error.';
SDecryptStreamError = 'Decrypt stream error.';
type
TKeyBit = (kb128, kb192, kb256);
function StrToHex(Const str: AnsiString): AnsiString;
function HexToStr(const Str: AnsiString): AnsiString;
function EncryptString(Value: AnsiString; Key: AnsiString;
KeyBit: TKeyBit = kb128): AnsiString;
function DecryptString(Value: AnsiString; Key: AnsiString;
KeyBit: TKeyBit = kb128): AnsiString;
function EncryptStream(Src: TStream; Key: AnsiString;
var Dest: TStream; KeyBit: TKeyBit = kb128): Boolean;
function DecryptStream(Src: TStream; Key: AnsiString;
var Dest: TStream; KeyBit: TKeyBit = kb128): Boolean;
procedure EncryptFile(SourceFile, DestFile: String;
Key: AnsiString; KeyBit: TKeyBit = kb128);
procedure DecryptFile(SourceFile, DestFile: String;
Key: AnsiString; KeyBit: TKeyBit = kb128);
implementation
function StrToHex(Const str: Ansistring): Ansistring;
asm
push ebx
push esi
push edi
test eax,eax
jz @@Exit
mov esi,edx //保存edx值，用来产生新字符串的地址
mov edi,eax //保存原字符串
mov edx,[eax-4] //获得字符串长度
test edx,edx //检查长度
je @@Exit {Length(S) = 0}
mov ecx,edx //保存长度
Push ecx
shl edx,1
mov eax,esi
{$IFDEF VER210}
movzx ecx, word ptr [edi-12] {需要设置CodePage}
{$ENDIF}
call System.@LStrSetLength //设置新串长度
mov eax,esi //新字符串地址
Call UniqueString //产生一个唯一的新字符串，串位置在eax中
Pop ecx
@@SetHex:
xor edx,edx //清空edx
mov dl, [edi] //Str字符串字符
mov ebx,edx //保存当前的字符
shr edx,4 //右移4字节，得到高8位
mov dl,byte ptr[edx+@@HexChar] //转换成字符
mov [eax],dl //将字符串输入到新建串中存放
and ebx,$0F //获得低8位
mov dl,byte ptr[ebx+@@HexChar] //转换成字符
inc eax //移动一个字节,存放低位
mov [eax],dl
inc edi
inc eax
loop @@SetHex
@@Exit:
pop edi
pop esi
pop ebx
ret
@@HexChar: db '0123456789ABCDEF'
end;
function HexToStr(const Str: AnsiString): AnsiString;
asm
push ebx
push edi
push esi
test eax,eax //为空串
jz @@Exit
mov edi,eax
mov esi,edx
mov edx,[eax-4]
test edx,edx
je @@Exit
mov ecx,edx
push ecx
shr edx,1
mov eax,esi //开始构造字符串
{$IFDEF VER210}
movzx ecx, word ptr [edi-12] {需要设置CodePage}
{$ENDIF}
call System.@LStrSetLength //设置新串长度
mov eax,esi //新字符串地址
Call UniqueString //产生一个唯一的新字符串，串位置在eax中
Pop ecx
xor ebx,ebx
xor esi,esi
@@CharFromHex:
xor edx,edx
mov dl, [edi] //Str字符串字符
cmp dl, '0' //查看是否在0到f之间的字符
JB @@Exit //小于0，退出
cmp dl,'9' //小于=9
ja @@DoChar//CompOkNum
sub dl,'0'
jmp @@DoConvert
@@DoChar:
//先转成大写字符
and dl,$DF
cmp dl,'F'
ja @@Exit //大于F退出
add dl,10
sub dl,'A'
@@DoConvert: //转化
inc ebx
cmp ebx,2
je @@Num1
xor esi,esi
shl edx,4
mov esi,edx
jmp @@Num2
@@Num1:
add esi,edx
mov edx,esi
mov [eax],dl
xor ebx,ebx
inc eax
@@Num2:
dec ecx
inc edi
test ecx,ecx
jnz @@CharFromHex
@@Exit:
pop esi
pop edi
pop ebx
end;
{ -- 字符串加密函数 默认按照 128 位密匙加密 -- }
function EncryptString(Value: AnsiString; Key: AnsiString;
KeyBit: TKeyBit = kb128): AnsiString;
var
{$IFDEF VER210}
SS,DS: TMemoryStream;
{$ELSE}
SS, DS: TStringStream;
{$ENDIF}
Size: Int64;
AESKey128: TAESKey128;
AESKey192: TAESKey192;
AESKey256: TAESKey256;
st: AnsiString;
begin
Result := '';
{$IFDEF VER210}
ss := TMemoryStream.Create;
SS.WriteBuffer(PAnsiChar(Value)^,Length(Value));
DS := TMemoryStream.Create;
{$ELSE}
SS := TStringStream.Create(Value);
DS := TStringStream.Create('');
{$ENDIF}
try
Size := SS.Size;
DS.WriteBuffer(Size, SizeOf(Size));
{ -- 128 位密匙最大长度为 16 个字符 -- }
if KeyBit = kb128 then
begin
FillChar(AESKey128, SizeOf(AESKey128), 0 );
Move(PAnsiChar(Key)^, AESKey128, Min(SizeOf(AESKey128), Length(Key)));
EncryptAESStreamECB(SS, 0, AESKey128, DS);
end;
{ -- 192 位密匙最大长度为 24 个字符 -- }
if KeyBit = kb192 then
begin
FillChar(AESKey192, SizeOf(AESKey192), 0 );
Move(PAnsiChar(Key)^, AESKey192, Min(SizeOf(AESKey192), Length(Key)));
EncryptAESStreamECB(SS, 0, AESKey192, DS);
end;
{ -- 256 位密匙最大长度为 32 个字符 -- }
if KeyBit = kb256 then
begin
FillChar(AESKey256, SizeOf(AESKey256), 0 );
Move(PAnsiChar(Key)^, AESKey256, Min(SizeOf(AESKey256), Length(Key)));
EncryptAESStreamECB(SS, 0, AESKey256, DS);
end;
{$IFDEF VER210}
SetLength(st,Ds.Size);
DS.Position := 0;
DS.ReadBuffer(PAnsiChar(st)^,DS.Size);
Result := StrToHex(st);
{$ELSE}
Result := StrToHex(DS.DataString);
{$ENDIF}
finally
SS.Free;
DS.Free;
end;
end;
{ -- 字符串解密函数 默认按照 128 位密匙解密 -- }
function DecryptString(Value: AnsiString; Key: AnsiString;
KeyBit: TKeyBit = kb128): AnsiString;
var
SS, DS: TStringStream;
Size: Int64;
AESKey128: TAESKey128;
AESKey192: TAESKey192;
AESKey256: TAESKey256;
begin
Result := '';
SS := TStringStream.Create(HexToStr(Value));
DS := TStringStream.Create('');
try
Size := SS.Size;
SS.ReadBuffer(Size, SizeOf(Size));
{ -- 128 位密匙最大长度为 16 个字符 -- }
if KeyBit = kb128 then
begin
FillChar(AESKey128, SizeOf(AESKey128), 0 );
Move(PAnsiChar(Key)^, AESKey128, Min(SizeOf(AESKey128), Length(Key)));
DecryptAESStreamECB(SS, SS.Size - SS.Position, AESKey128, DS);
end;
{ -- 192 位密匙最大长度为 24 个字符 -- }
if KeyBit = kb192 then
begin
FillChar(AESKey192, SizeOf(AESKey192), 0 );
Move(PAnsiChar(Key)^, AESKey192, Min(SizeOf(AESKey192), Length(Key)));
DecryptAESStreamECB(SS, SS.Size - SS.Position, AESKey192, DS);
end;
{ -- 256 位密匙最大长度为 32 个字符 -- }
if KeyBit = kb256 then
begin
FillChar(AESKey256, SizeOf(AESKey256), 0 );
Move(PAnsiChar(Key)^, AESKey256, Min(SizeOf(AESKey256), Length(Key)));
DecryptAESStreamECB(SS, SS.Size - SS.Position, AESKey256, DS);
end;
Result := DS.DataString;
finally
SS.Free;
DS.Free;
end;
end;
{ 流加密函数, default keybit: 128bit }
function EncryptStream(Src: TStream; Key: AnsiString;
var Dest: TStream; KeyBit: TKeyBit = kb128): Boolean;
var
Count: Int64;
AESKey128: TAESKey128;
AESKey192: TAESKey192;
AESKey256: TAESKey256;
begin
if Dest = nil then
begin
raise Exception.Create(SDestStreamNotCreated);
Result:= False;
Exit;
end;
try
Src.Position:= 0;
Count:= Src.Size;
Dest.Write(Count, SizeOf(Count));
{ -- 128 位密匙最大长度为 16 个字符 -- }
if KeyBit = kb128 then
begin
FillChar(AESKey128, SizeOf(AESKey128), 0 );
Move(PAnsiChar(Key)^, AESKey128, Min(SizeOf(AESKey128), Length(Key)));
EncryptAESStreamECB(Src, 0, AESKey128, Dest);
end;
{ -- 192 位密匙最大长度为 24 个字符 -- }
if KeyBit = kb192 then
begin
FillChar(AESKey192, SizeOf(AESKey192), 0 );
Move(PAnsiChar(Key)^, AESKey192, Min(SizeOf(AESKey192), Length(Key)));
EncryptAESStreamECB(Src, 0, AESKey192, Dest);
end;
{ -- 256 位密匙最大长度为 32 个字符 -- }
if KeyBit = kb256 then
begin
FillChar(AESKey256, SizeOf(AESKey256), 0 );
Move(PAnsiChar(Key)^, AESKey256, Min(SizeOf(AESKey256), Length(Key)));
EncryptAESStreamECB(Src, 0, AESKey256, Dest);
end;
Result := True;
except
raise Exception.Create(SEncryptStreamError);
Result:= False;
end;
end;
{ 流解密函数, default keybit: 128bit }
function DecryptStream(Src: TStream; Key: AnsiString;
var Dest: TStream; KeyBit: TKeyBit = kb128): Boolean;
var
Count, OutPos: Int64;
AESKey128: TAESKey128;
AESKey192: TAESKey192;
AESKey256: TAESKey256;
begin
if Dest = nil then
begin
raise Exception.Create(SDestStreamNotCreated);
Result:= False;
Exit;
end;
try
Src.Position:= 0;
OutPos:= Dest.Position;
Src.ReadBuffer(Count, SizeOf(Count));
{ -- 128 位密匙最大长度为 16 个字符 -- }
if KeyBit = kb128 then
begin
FillChar(AESKey128, SizeOf(AESKey128), 0 );
Move(PAnsiChar(Key)^, AESKey128, Min(SizeOf(AESKey128), Length(Key)));
DecryptAESStreamECB(Src, Src.Size - Src.Position,
AESKey128, Dest);
end;
{ -- 192 位密匙最大长度为 24 个字符 -- }
if KeyBit = kb192 then
begin
FillChar(AESKey192, SizeOf(AESKey192), 0 );
Move(PAnsiChar(Key)^, AESKey192, Min(SizeOf(AESKey192), Length(Key)));
DecryptAESStreamECB(Src, Src.Size - Src.Position,
AESKey192, Dest);
end;
{ -- 256 位密匙最大长度为 32 个字符 -- }
if KeyBit = kb256 then
begin
FillChar(AESKey256, SizeOf(AESKey256), 0 );
Move(PAnsiChar(Key)^, AESKey256, Min(SizeOf(AESKey256), Length(Key)));
DecryptAESStreamECB(Src, Src.Size - Src.Position,
AESKey256, Dest);
end;
Dest.Size := OutPos + Count;
Dest.Position := OutPos;
Result := True;
except
raise Exception.Create(SDecryptStreamError);
Result:= False;
end;
end;
{ -- 文件加密函数 默认按照 128 位密匙解密 -- }
procedure EncryptFile(SourceFile, DestFile: String;
Key: AnsiString; KeyBit: TKeyBit = kb128);
var
SFS, DFS: TFileStream;
Size: Int64;
AESKey128: TAESKey128;
AESKey192: TAESKey192;
AESKey256: TAESKey256;
begin
SFS := TFileStream.Create(SourceFile, fmOpenRead);
try
DFS := TFileStream.Create(DestFile, fmCreate);
try
Size := SFS.Size;
DFS.WriteBuffer(Size, SizeOf(Size));
{ -- 128 位密匙最大长度为 16 个字符 -- }
if KeyBit = kb128 then
begin
FillChar(AESKey128, SizeOf(AESKey128), 0 );
Move(PAnsiChar(Key)^, AESKey128, Min(SizeOf(AESKey128), Length(Key)));
EncryptAESStreamECB(SFS, 0, AESKey128, DFS);
end;
{ -- 192 位密匙最大长度为 24 个字符 -- }
if KeyBit = kb192 then
begin
FillChar(AESKey192, SizeOf(AESKey192), 0 );
Move(PAnsiChar(Key)^, AESKey192, Min(SizeOf(AESKey192), Length(Key)));
EncryptAESStreamECB(SFS, 0, AESKey192, DFS);
end;
{ -- 256 位密匙最大长度为 32 个字符 -- }
if KeyBit = kb256 then
begin
FillChar(AESKey256, SizeOf(AESKey256), 0 );
Move(PAnsiChar(Key)^, AESKey256, Min(SizeOf(AESKey256), Length(Key)));
EncryptAESStreamECB(SFS, 0, AESKey256, DFS);
end;
finally
DFS.Free;
end;
finally
SFS.Free;
end;
end;
{ -- 文件解密函数 默认按照 128 位密匙解密 -- }
procedure DecryptFile(SourceFile, DestFile: String;
Key: AnsiString; KeyBit: TKeyBit = kb128);
var
SFS, DFS: TFileStream;
Size: Int64;
AESKey128: TAESKey128;
AESKey192: TAESKey192;
AESKey256: TAESKey256;
begin
SFS := TFileStream.Create(SourceFile, fmOpenRead);
try
SFS.ReadBuffer(Size, SizeOf(Size));
DFS := TFileStream.Create(DestFile, fmCreate);
try
{ -- 128 位密匙最大长度为 16 个字符 -- }
if KeyBit = kb128 then
begin
FillChar(AESKey128, SizeOf(AESKey128), 0 );
Move(PAnsiChar(Key)^, AESKey128, Min(SizeOf(AESKey128), Length(Key)));
DecryptAESStreamECB(SFS, SFS.Size - SFS.Position, AESKey128, DFS);
end;
{ -- 192 位密匙最大长度为 24 个字符 -- }
if KeyBit = kb192 then
begin
FillChar(AESKey192, SizeOf(AESKey192), 0 );
Move(PAnsiChar(Key)^, AESKey192, Min(SizeOf(AESKey192), Length(Key)));
DecryptAESStreamECB(SFS, SFS.Size - SFS.Position, AESKey192, DFS);
end;
{ -- 256 位密匙最大长度为 32 个字符 -- }
if KeyBit = kb256 then
begin
FillChar(AESKey256, SizeOf(AESKey256), 0 );
Move(PAnsiChar(Key)^, AESKey256, Min(SizeOf(AESKey256), Length(Key)));
DecryptAESStreamECB(SFS, SFS.Size - SFS.Position, AESKey256, DFS);
end;
DFS.Size := Size;
finally
DFS.Free;
end;
finally
SFS.Free;
end;
end;
end.
Delphi 极速字符串替换函数
//此极速字符串替换函数为[盒子论坛hq200306兄]所作，在此感谢！亲测原本48秒的长文本替换操作，现在只要几十毫秒不到！
function PosX(const SubStr, Str: string; Offset: Integer): Integer;
var
I, LIterCnt, L, J: Integer;
PSubStr, PS: PChar;
begin
L := Length(SubStr);
{ Calculate the number of possible iterations. Not valid if Offset < 1. }
LIterCnt := Length(Str) - Offset - L + 1;
{ Only continue if the number of iterations is positive or zero (there is space to check) }
if (Offset > 0) and (LIterCnt >= 0) and (L > 0) then
begin
PSubStr := PChar(SubStr);
PS := PChar(Str);
Inc(PS, Offset - 1);
for I := 0 to LIterCnt do
begin
J := 0;
while (J >= 0) and (J < L) do
begin
if UpCase(PS[I + J]) = UpCase(PSubStr[J]) then
Inc(J)
else
J := -1;
end;
if J >= L then
Exit(I + Offset);
end;
end;
Result := 0;
end;
function StringReplaceEx(const st, oldSubstr, newSubStr: string): string;
var
idx, len: Integer;
iStart: Integer;
sb: TStringBuilder;
begin
len := Length(oldSubstr);
iStart := 1;
sb := TStringBuilder.Create;
try
repeat
idx := posX(oldSubstr, st, iStart);
if idx > 0 then
begin
sb.Append(Copy(st, iStart, idx - iStart));
sb.Append(newSubStr);
iStart := idx + len;
end;
until idx <= 0;
sb.Append(Copy(st, iStart, length(st)));
Result := sb.ToString;
finally
sb.Free;
end;
end;
Delphi 检测用户超过多长时间没有操作键盘或鼠标
procedure TForm1.Timer1Timer(Sender: TObject);
var vLastInputInfo: TLastInputInfo;
begin
vLastInputInfo.cbSize := SizeOf(vLastInputInfo);
GetLastInputInfo(vLastInputInfo);
if GetTickCount - vLastInputInfo.dwTime > 5000 then
begin
timer1.Enabled:= false;
showmessage('超过5秒，用户未动鼠标！');
end;
end;
function StopTime: integer;//返回没有键盘和鼠标事件的时间
var LInput: TLastInputInfo;
begin
LInput.cbSize := SizeOf(TLastInputInfo);
GetLastInputInfo(LInput);
Result := (GetTickCount()- LInput.dwTime)div 1000;// 微妙换成秒
end;
procedure TForm1.Timer1Timer(Sender: TObject);// Timer 事件
begin
if StopTime>=60 then
Showmessage('用户已经1分钟没有动键盘鼠标了！');
end;
Delphi编程实现调用系统图标
uses shellapi;
第一步 取得系统的图标列表的句柄，将之赋予一个图像列表控件。
procedure GetSystemImageList(imagelist: TImageList);
var
SysIL: THandle;
SFI: TSHFileInfo;
begin
// 取小图标，如果将SHGFI_SMALLICON替换成
// SHGFI_LARGEICON则表示取大图标
SysIL := SHGetFileInfo('', 0, SFI, SizeOf(SFI),
SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
if SysIL <> 0 then
begin
// 将imagelist的图像列表句柄指向系统图像句柄
imagelist.Handle := SysIL;
// 防止组件释放时释放图像句柄，很重要
imagelist.ShareImages := TRUE;
end;
end;
第二步 取得要处理文件的图标索引
//取一个文件的图标索引
function GetIconIndex(const AFile: string; Attrs: DWORD): integer;
// Attrs可以为表示文件或路径FILE_ATTRIBUTE_NORMAL or FILE_ATTRIBUTE_DIRECTORY
var
SFI: TSHFileInfo;
begin
SHGetFileInfo(PChar(AFile), Attrs, SFI, SizeOf(TSHFileInfo),
SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES);
Result := SFI.iIcon;
end;
实例调用：
//如在TreeView中得到c:\mydir的图标，因为是路径所以要加上路径的标志
aNode.ImageIndex := GetIconIndex('c:\mydir\',
FILE_ATTRIBUTE_NORMAL or FILE_ATTRIBUTE_DIRECTORY);
//如在TreeView中得到c:\index.html的图标
aNode.ImageIndex := GetIconIndex('c:\index.html',FILE_ATTRIBUTE_NORMAL);
AES.pas 单元文件
AES crypt algorithm pascal unit
base on AVR231's aes code
EMAIL: Shaoziyang@gmail.com
Web: http://avrubd.googlepages.com
by Shaoziyang 2008.6
*)
unit aes;
interface
uses
SysUtils;
const
//!< Lower 8 bits of (x^8+x^4+x^3+x+1), ie. (x^4+x^3+x+1).
BPOLY = $1B;
//!< Block size in number of bytes.
BLOCKSIZE = 16;
procedure aesKey(key: PByteArray; len: Integer);
procedure aesEncInit;
procedure aesEncrypt(buffer, chainBlock: PByteArray);
procedure aesDecInit;
procedure aesDecrypt(buffer, chainBlock: PByteArray);
implementation
var
kTable: array[0..31] of Byte =
(
$D0, $94, $3F, $8C, $29, $76, $15, $D8,
$20, $40, $E3, $27, $45, $D8, $48, $AD,
$EA, $8B, $2A, $73, $16, $E9, $B0, $49,
$45, $B3, $39, $28, $0A, $C3, $28, $3C
);
block1: array[0..255] of Byte; //!< Workspace 1.
block2: array[0..255] of Byte; //!< Worksapce 2.
tempbuf: array[0..255] of Byte;
powTbl: PByteArray; //!< Final location of exponentiation lookup table.
logTbl: PByteArray; //!< Final location of logarithm lookup table.
sBox: PByteArray; //!< Final location of s-box.
sBoxInv: PByteArray; //!< Final location of inverse s-box.
expandedKey: PByteArray; //!< Final location of expanded key.
ROUNDS: Byte = 10; //!< Number of rounds.
KEYLENGTH: Byte = 16; //!< Key length in number of bytes.
procedure aesKey(key: PByteArray; len: Integer);
var
i: Integer;
begin
if len <= 128 then
begin
ROUNDS := 10;
KEYLENGTH := 16;
end
else
begin
ROUNDS := 14;
KEYLENGTH := 32;
end;
for i := 0 to KEYLENGTH-1 do
kTable[i] := key^[i];
end;
function CalcDat(t: Byte): Byte;
begin
if (t and $80) = $80 then
Result := ((t * 2) xor BPOLY)
else
Result := (t * 2);
end;
procedure CalcPowLog(powTbl, logTbl: PByteArray);
var
i, t: Byte;
begin
i := 0;
t := 1;
repeat
// Use 0x03 as root for exponentiation and logarithms.
powTbl^[i] := t;
logTbl^[t] := i;
i := i + 1;
// Muliply t by 3 in GF(2^8).
t := t xor CalcDat(t);
until (t = 1); // Cyclic properties ensure that i < 255.
powTbl^[255] := powTbl^[0]; // 255 = '-0', 254 = -1, etc.
end;
procedure CalcSBox(sBox: PByteArray);
var
i, rot: Byte;
temp: Byte;
Result: Byte;
begin
// Fill all entries of sBox[].
i := 0;
repeat
//Inverse in GF(2^8).
if (i > 0) then
begin
temp := powTbl^[255 - logTbl^[i]];
end
else
begin
temp := 0;
end;
// Affine transformation in GF(2).
Result := temp xor $63; // Start with adding a vector in GF(2).
for rot := 1 to 4 do
begin
// Rotate left.
temp := (temp shl 1) or (temp shr 7);
// Add rotated byte in GF(2).
Result := Result xor temp;
end;
// Put result in table.
sBox^[i] := Result;
i := i + 1;
until (i = 0);
end;
procedure CalcSBoxInv(sBox, sBoxInv: PByteArray);
var
i, j: Byte;
begin
i := 0;
j := 0;
// Iterate through all elements in sBoxInv using i.
repeat
// Search through sBox using j.
repeat
// Check if current j is the inverse of current i.
if (sBox^[j] = i) then
begin
// If so, set sBoxInc and indicate search finished.
sBoxInv^[i] := j;
j := 255;
end;
j := j + 1;
until (j = 0);
i := i + 1;
until (i = 0);
end;
procedure CycleLeft(row: PByteArray);
var
temp: Byte;
begin
// Cycle 4 bytes in an array left once.
temp := row^[0];
row^[0] := row^[1];
row^[1] := row^[2];
row^[2] := row^[3];
row^[3] := temp;
end;
procedure InvMixColumn(column: PByteArray);
var
r0, r1, r2, r3: Byte;
begin
r0 := column^[1] xor column^[2] xor column^[3];
r1 := column^[0] xor column^[2] xor column^[3];
r2 := column^[0] xor column^[1] xor column^[3];
r3 := column^[0] xor column^[1] xor column^[2];
column^[0] := CalcDat(column^[0]);
column^[1] := CalcDat(column^[1]);
column^[2] := CalcDat(column^[2]);
column^[3] := CalcDat(column^[3]);
r0 := r0 xor column^[0] xor column^[1];
r1 := r1 xor column^[1] xor column^[2];
r2 := r2 xor column^[2] xor column^[3];
r3 := r3 xor column^[0] xor column^[3];
column^[0] := CalcDat(column^[0]);
column^[1] := CalcDat(column^[1]);
column^[2] := CalcDat(column^[2]);
column^[3] := CalcDat(column^[3]);
r0 := r0 xor column^[0] xor column^[2];
r1 := r1 xor column^[1] xor column^[3];
r2 := r2 xor column^[0] xor column^[2];
r3 := r3 xor column^[1] xor column^[3];
column^[0] := CalcDat(column^[0]);
column^[1] := CalcDat(column^[1]);
column^[2] := CalcDat(column^[2]);
column^[3] := CalcDat(column^[3]);
column^[0] := column^[0] xor column^[1] xor column^[2] xor column^[3];
r0 := r0 xor column^[0];
r1 := r1 xor column^[0];
r2 := r2 xor column^[0];
r3 := r3 xor column^[0];
column^[0] := r0;
column^[1] := r1;
column^[2] := r2;
column^[3] := r3;
end;
procedure SubBytes(bytes: PByteArray; count: Byte);
var
i: Byte;
begin
i := 0;
repeat
bytes^[i] := sBox^[bytes^[i]]; // Substitute every byte in state.
i := i + 1;
count := count - 1;
until (count = 0);
end;
procedure InvSubBytesAndXOR(bytes, key: PByteArray; count: Byte);
var
i: Byte;
begin
i := 0;
repeat
// *bytes = sBoxInv[ *bytes ] ^ *key; // Inverse substitute every byte in state and add key.
bytes^[i] := block2[bytes^[i]] xor key^[i]; // Use block2 directly. Increases speed.
i := i + 1;
count := count - 1;
until (count = 0);
end;
procedure InvShiftRows(state: PByteArray);
var
temp: Byte;
begin
// Note: State is arranged column by column.
// Cycle second row right one time.
temp := state^[1 + 3 * 4];
state^[1 + 3 * 4] := state^[1 + 2 * 4];
state^[1 + 2 * 4] := state^[1 + 1 * 4];
state^[1 + 1 * 4] := state^[1 + 0 * 4];
state^[1 + 0 * 4] := temp;
// Cycle third row right two times.
temp := state^[2 + 0 * 4];
state^[2 + 0 * 4] := state^[2 + 2 * 4];
state^[2 + 2 * 4] := temp;
temp := state^[2 + 1 * 4];
state^[2 + 1 * 4] := state^[2 + 3 * 4];
state^[2 + 3 * 4] := temp;
// Cycle fourth row right three times, ie. left once.
temp := state^[3 + 0 * 4];
state^[3 + 0 * 4] := state^[3 + 1 * 4];
state^[3 + 1 * 4] := state^[3 + 2 * 4];
state^[3 + 2 * 4] := state^[3 + 3 * 4];
state^[3 + 3 * 4] := temp;
end;
procedure InvMixColumns(state: PByteArray);
begin
InvMixColumn(@state[0 * 4]);
InvMixColumn(@state[1 * 4]);
InvMixColumn(@state[2 * 4]);
InvMixColumn(@state[3 * 4]);
end;
procedure XORBytes(bytes1, bytes2: PByteArray; count: Byte);
var
i: Integer;
begin
i := 0;
repeat
bytes1^[i] := bytes1^[i] xor bytes2^[i]; // Add in GF(2), ie. XOR.
i := i + 1;
count := count - 1;
until (count = 0);
end;
procedure CopyBytes(a, b: PByteArray; count: Byte);
var
i: Byte;
begin
i := 0;
repeat
a^[i] := b^[i];
i := i + 1;
count := count - 1;
until (count = 0);
end;
procedure KeyExpansion(expandedKey: PByteArray);
var
temp: array[0..3] of Byte;
i: Byte;
Rcon: array[0..3] of Byte; // Round constant.
key: PByte;
begin
Rcon[0] := 1;
Rcon[1] := 0;
Rcon[2] := 0;
Rcon[3] := 0;
key := @kTable;
// Copy key to start of expanded key.
{i := KEYLENGTH;
repeat
expandedKey^[0] := key^;
inc(PByte(expandedKey), 1);
inc(key, 1);
i := i - 1;
until (i = 0);}
CopyBytes(expandedKey, PByteArray(key), KEYLENGTH);
Inc(PByte(expandedKey), KEYLENGTH);
// Prepare last 4 bytes of key in temp.
dec(PByte(expandedKey), 4);
temp[0] := expandedKey^[0];
temp[1] := expandedKey^[1];
temp[2] := expandedKey^[2];
temp[3] := expandedKey^[3];
Inc(PByte(expandedKey), 4);
// Expand key.
i := KEYLENGTH;
while (i < BLOCKSIZE * (ROUNDS + 1)) do
begin
if KEYLENGTH > 24 then
begin
// Are we at the start of a multiple of the key size?
if ((i mod KEYLENGTH) = 0) then
begin
CycleLeft(@temp); // Cycle left once.
SubBytes(@temp, 4); // Substitute each byte.
XORBytes(@temp, @Rcon, 4); // Add constant in GF(2).
Rcon[0] := CalcDat(Rcon[0]);
// Keysize larger than 24 bytes, ie. larger that 192 bits?
end
// Are we right past a block size?
else
if ((i mod KEYLENGTH) = BLOCKSIZE) then
SubBytes(@temp, 4); // Substitute each byte.
end
else
begin
if ((i mod KEYLENGTH) = 0) then
begin
CycleLeft(@temp); // Cycle left once.
SubBytes(@temp, 4); // Substitute each byte.
XORBytes(@temp, @Rcon, 4); // Add constant in GF(2).
Rcon[0] := CalcDat(Rcon[0]);
end;
end;
// Add bytes in GF(2) one KEYLENGTH away.
dec(PByte(expandedKey), KEYLENGTH);
XORBytes(@temp, expandedKey, 4);
Inc(PByte(expandedKey), KEYLENGTH);
// Copy result to current 4 bytes.
{expandedKey[0] := temp[0];
expandedKey[1] := temp[1];
expandedKey[2] := temp[2];
expandedKey[3] := temp[3];}
CopyBytes(expandedKey, @temp, 4);
Inc(PByte(expandedKey), 4);
i := i + 4; // Next 4 bytes.
end;
end;
procedure InvCipher(block, expandedKey: PByteArray);
var
round: Byte;
begin
round := ROUNDS - 1;
Inc(PByte(expandedKey), BLOCKSIZE * ROUNDS);
XORBytes(block, expandedKey, 16);
dec(PByte(expandedKey), BLOCKSIZE);
repeat
InvShiftRows(block);
InvSubBytesAndXOR(block, expandedKey, 16);
dec(PByte(expandedKey), BLOCKSIZE);
InvMixColumns(block);
round := round - 1;
until (round = 0);
InvShiftRows(block);
InvSubBytesAndXOR(block, expandedKey, 16);
end;
procedure aesDecInit;
begin
powTbl := @block1;
logTbl := @block2;
CalcPowLog(powTbl, logTbl);
sBox := @tempbuf;
CalcSBox(sBox);
expandedKey := @block1;
KeyExpansion(expandedKey);
sBoxInv := @block2; // Must be block2.
CalcSBoxInv(sBox, sBoxInv);
end;
procedure aesDecrypt(buffer, chainBlock: PByteArray);
var
temp: array[0..BLOCKSIZE - 1] of Byte;
begin
CopyBytes(@temp, buffer, BLOCKSIZE);
InvCipher(buffer, expandedKey);
XORBytes(buffer, chainBlock, BLOCKSIZE);
CopyBytes(chainBlock, @temp, BLOCKSIZE);
end;
function Multiply(num, factor: Byte): Byte;
var
mask: Byte;
begin
mask := 1;
Result := 0;
while (mask <> 0) do
begin
// Check bit of factor given by mask.
if ((mask and factor) <> 0) then
begin
// Add current multiple of num in GF(2).
Result := Result xor num;
end;
// Shift mask to indicate next bit.
mask := mask shl 1;
// Double num.
num := CalcDat(num);
end;
end;
function DotProduct(vector1, vector2: PByteArray): Byte;
begin
Result := 0;
Result := Result xor Multiply(vector1^[0], vector2^[0]);
Inc(PByte(vector1));
Inc(PByte(vector2));
Result := Result xor Multiply(vector1^[0], vector2^[0]);
Inc(PByte(vector1));
Inc(PByte(vector2));
Result := Result xor Multiply(vector1^[0], vector2^[0]);
Inc(PByte(vector1));
Inc(PByte(vector2));
Result := Result xor Multiply(vector1^[0], vector2^[0]);
end;
procedure MixColumn(column: PByteArray);
var
// Prepare first row of matrix twice, to eliminate need for cycling.
row: array[0..7] of Byte;
Result: array[0..3] of Byte;
begin
row[0] := $02;
row[1] := $03;
row[2] := $01;
row[3] := $01;
row[4] := $02;
row[5] := $03;
row[6] := $01;
row[7] := $01;
// Take dot products of each matrix row and the column vector.
Result[0] := DotProduct(@row[0], column);
Result[1] := DotProduct(@row[3], column);
Result[2] := DotProduct(@row[2], column);
Result[3] := DotProduct(@row[1], column);
// Copy temporary result to original column.
column^[0] := Result[0];
column^[1] := Result[1];
column^[2] := Result[2];
column^[3] := Result[3];
end;
procedure MixColumns(state: PByteArray);
begin
MixColumn(@state[0 * 4]);
MixColumn(@state[1 * 4]);
MixColumn(@state[2 * 4]);
MixColumn(@state[3 * 4]);
end;
procedure ShiftRows(state: PByteArray);
var
temp: Byte;
begin
// Note: State is arranged column by column.
// Cycle second row left one time.
temp := state^[1 + 0 * 4];
state^[1 + 0 * 4] := state^[1 + 1 * 4];
state^[1 + 1 * 4] := state^[1 + 2 * 4];
state^[1 + 2 * 4] := state^[1 + 3 * 4];
state^[1 + 3 * 4] := temp;
// Cycle third row left two times.
temp := state^[2 + 0 * 4];
state^[2 + 0 * 4] := state^[2 + 2 * 4];
state^[2 + 2 * 4] := temp;
temp := state^[2 + 1 * 4];
state^[2 + 1 * 4] := state^[2 + 3 * 4];
state^[2 + 3 * 4] := temp;
// Cycle fourth row left three times, ie. right once.
temp := state^[3 + 3 * 4];
state^[3 + 3 * 4] := state^[3 + 2 * 4];
state^[3 + 2 * 4] := state^[3 + 1 * 4];
state^[3 + 1 * 4] := state^[3 + 0 * 4];
state^[3 + 0 * 4] := temp;
end;
procedure Cipher(block, expandedKey: PByteArray);
var
round: Byte;
begin
round := ROUNDS - 1;
XORBytes(block, expandedKey, 16);
Inc(PByte(expandedKey), BLOCKSIZE);
repeat
SubBytes(block, 16);
ShiftRows(block);
MixColumns(block);
XORBytes(block, expandedKey, 16);
Inc(PByte(expandedKey), BLOCKSIZE);
round := round - 1;
until (round = 0);
SubBytes(block, 16);
ShiftRows(block);
XORBytes(block, expandedKey, 16);
end;
procedure aesEncInit;
var
i: Integer;
begin
powTbl := @block1;
logTbl := @tempbuf;
CalcPowLog(powTbl, logTbl);
sBox := @block2;
CalcSBox(sBox);
expandedKey := @block1;
KeyExpansion(expandedKey);
end;
procedure aesEncrypt(buffer, chainBlock: PByteArray);
begin
XORBytes(buffer, chainBlock, BLOCKSIZE);
Cipher(buffer, expandedKey);
CopyBytes(chainBlock, buffer, BLOCKSIZE);
end;
end.
自带了 Base64 编解
procedure EncodeStream(Input, Output: TStream);
procedure DecodeStream(Input, Output: TStream);
function EncodeString(const Input: string): string;
function DecodeString(const Input: string): string;
{********************************************************}
{ }
{ Borland Delphi Visual Component Library }
{ }
{ Copyright (c) 2000, 2001 Borland Software Corporation }
{ }
{********************************************************}
unit EncdDecd;
{ Have string use stream encoding since that logic wraps properly }
interface
uses Classes;
procedure EncodeStream(Input, Output: TStream);
procedure DecodeStream(Input, Output: TStream);
function EncodeString(const Input: string): string;
function DecodeString(const Input: string): string;
implementation
const
EncodeTable: array[0..63] of Char ='ABCDEFGHIJKLMNOPQRSTUVWXYZ' +'abcdefghijklmnopqrstuvwxyz' +'0123456789+/';
DecodeTable: array[#0..#127] of Integer = (Byte('='), 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 62, 64, 64, 64, 63, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 64, 64, 64, 64, 64, 64, 64, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 64, 64, 64, 64, 64, 64, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 64, 64, 64, 64, 64);
type
PPacket = ^TPacket;
TPacket = packed record
case Integer of
0: (b0, b1, b2, b3: Byte);
1: (i: Integer);
2: (a: array[0..3] of Byte);
3: (c: array[0..3] of Char);
end;
procedure EncodePacket(const Packet: TPacket; NumChars: Integer; OutBuf: PChar);
begin
OutBuf[0] := EnCodeTable[Packet.a[0] shr 2];
OutBuf[1] := EnCodeTable[((Packet.a[0] shl 4) or (Packet.a[1] shr 4)) and $0000003f];
if NumChars < 2 then
OutBuf[2] := '='
else
OutBuf[2] := EnCodeTable[((Packet.a[1] shl 2) or (Packet.a[2] shr 6)) and $0000003f];
if NumChars < 3 then
OutBuf[3] := '='
else
OutBuf[3] := EnCodeTable[Packet.a[2] and $0000003f];
end;
function DecodePacket(InBuf: PChar; var nChars: Integer): TPacket;
begin
Result.a[0] := (DecodeTable[InBuf[0]] shl 2) or (DecodeTable[InBuf[1]] shr 4);
NChars := 1;
if InBuf[2] <> '=' then
begin
Inc(NChars);
Result.a[1] := Byte((DecodeTable[InBuf[1]] shl 4) or (DecodeTable[InBuf[2]] shr 2));
end;
if InBuf[3] <> '=' then
begin
Inc(NChars);
Result.a[2] := Byte((DecodeTable[InBuf[2]] shl 6) or DecodeTable[InBuf[3]]);
end;
end;
procedure EncodeStream(Input, Output: TStream);
type
PInteger = ^Integer;
var
InBuf: array[0..509] of Byte;
OutBuf: array[0..1023] of Char;
BufPtr: PChar;
I, J, K, BytesRead: Integer;
Packet: TPacket;
begin
K := 0;
repeat
BytesRead := Input.Read(InBuf, SizeOf(InBuf));
I := 0;
BufPtr := OutBuf;
while I < BytesRead do
begin
if BytesRead - I < 3 then
J := BytesRead - I
else
J := 3;
Packet.i := 0;
Packet.b0 := InBuf[I];
if J > 1 then
Packet.b1 := InBuf[I + 1];
if J > 2 then
Packet.b2 := InBuf[I + 2];
EncodePacket(Packet, J, BufPtr);
Inc(I, 3);
Inc(BufPtr, 4);
Inc(K, 4);
if K > 75 then
begin
BufPtr[0] := #$0D;
BufPtr[1] := #$0A;
Inc(BufPtr, 2);
K := 0;
end;
end;
Output.Write(Outbuf, BufPtr - PChar(@OutBuf));
until
BytesRead = 0;
end;
procedure DecodeStream(Input, Output: TStream);
var
InBuf: array[0..75] of Char;
OutBuf: array[0..60] of Byte;
InBufPtr, OutBufPtr: PChar;
I, J, K, BytesRead: Integer;
Packet: TPacket;
procedure SkipWhite;
var
C: Char;
NumRead: Integer;
begin
while True do
begin
NumRead := Input.Read(C, 1);
if NumRead = 1 then
begin
if C in ['0'..'9','A'..'Z','a'..'z','+','/','='] then
begin
Input.Position := Input.Position - 1;
Break;
end;
end
else
Break;
end;
end;
function ReadInput: Integer;
var
WhiteFound, EndReached : Boolean;
CntRead, Idx, IdxEnd: Integer;
begin
IdxEnd:= 0;
repeat
WhiteFound := False;
CntRead := Input.Read(InBuf[IdxEnd], (SizeOf(InBuf)-IdxEnd));
EndReached := CntRead < (SizeOf(InBuf)-IdxEnd);
Idx := IdxEnd;
IdxEnd := CntRead + IdxEnd;
while (Idx < IdxEnd) do
begin
if not (InBuf[Idx] in ['0'..'9','A'..'Z','a'..'z','+','/','=']) then
begin
Dec(IdxEnd);
if Idx < IdxEnd then
Move(InBuf[Idx+1], InBuf[Idx], IdxEnd-Idx);
WhiteFound := True;
end
else
Inc(Idx);
end;
until (not WhiteFound) or (EndReached);
Result := IdxEnd;
end;
begin
repeat
SkipWhite;
{BytesRead := Input.Read(InBuf, SizeOf(InBuf)); }
BytesRead := ReadInput;
InBufPtr := InBuf;
OutBufPtr := @OutBuf;
I := 0;
while I < BytesRead do
begin
Packet := DecodePacket(InBufPtr, J);
K := 0;
while J > 0 do
begin
OutBufPtr^ := Char(Packet.a[K]);
Inc(OutBufPtr);
Dec(J);
Inc(K);
end;
Inc(InBufPtr, 4);
Inc(I, 4);
end;
Output.Write(OutBuf, OutBufPtr - PChar(@OutBuf));
until BytesRead = 0;
end;
function EncodeString(const Input: string): string;
var
InStr, OutStr: TStringStream;
begin
InStr := TStringStream.Create(Input);
try
OutStr := TStringStream.Create('');
try
EncodeStream(InStr, OutStr);
Result := OutStr.DataString;
finally
OutStr.Free;
end;
finally
InStr.Free;
end;
end;
function DecodeString(const Input: string): string;
var
InStr, OutStr: TStringStream;
begin
InStr := TStringStream.Create(Input);
try
OutStr := TStringStream.Create('');
try
DecodeStream(InStr, OutStr);
Result := OutStr.DataString;
finally
OutStr.Free;
end;
finally
InStr.Free;
end;
end;
end.