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.