Delphi -- 创建 桌面、发送到...、快速启动栏、开始菜单、程序菜单、右键菜 单


Delphi 一些pas_icoDelphi 一些pas_文件名_02


{=================================================================
功 能:
创建 桌面、发送到...、快速启动栏、开始菜单、程序菜单、右键菜单 快捷方式
参 数:
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;

View Code

Delphi AES加密(转)


Delphi 一些pas_icoDelphi 一些pas_文件名_02


(**************************************************************)
(*     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.

View Code

Delphi 极速字符串替换函数


Delphi 一些pas_icoDelphi 一些pas_文件名_02


//此极速字符串替换函数为[盒子论坛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;

View Code

Delphi 检测用户超过多长时间没有操作键盘或鼠标


Delphi 一些pas_icoDelphi 一些pas_文件名_02


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;

View Code

Delphi编程实现调用系统图标


Delphi 一些pas_icoDelphi 一些pas_文件名_02


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);

View Code

AES.pas 单元文件


Delphi 一些pas_icoDelphi 一些pas_文件名_02


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.

View Code

自带了 Base64 编解


Delphi 一些pas_icoDelphi 一些pas_文件名_02


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.

View Code