decutil.pas

cipher 5.1。一个几乎包含了所有常见的加密算法的控件

  Buffer: String;
  Count,Bytes,DataSize: Integer;
  Position: Integer;
begin
  if IsObject(Stream, TStream) then
  begin
    Position := Stream.Position;
    DataSize := Stream.Size;
    if Size <= 0 then
    begin
      Size := DataSize;
      Position := 0;
    end else
    begin
      Dec(DataSize, Position);
      if Size > DataSize then Size := DataSize;
    end;
    SetLength(Buffer, BufferSize);
    for Count := 0 to WipeCount -1 do
    begin
      Stream.Position := Position;
      DataSize := Size;
      FillChar(Buffer[1], BufferSize, WipeBytes[Count]);
      while DataSize > 0 do
      begin
        Bytes := DataSize;
        if Bytes > BufferSize then Bytes := BufferSize;
        Stream.Write(Buffer[1], Bytes);
        Dec(DataSize, Bytes);
      end;
    end;
  end;
end;

function IsFilledWith(var Buffer; Size: Integer; Value: Char): Boolean;
asm // check iff Buffer is filled Size of bytes with Value
       TEST   EAX,EAX
       JZ     @@1
       PUSH   EDI
       MOV    EDI,EAX
       MOV    EAX,ECX
       MOV    ECX,EDX
       REPE   SCASB
       SETE   AL
       POP    EDI
@@1:
end;

procedure FoldBuf(var Dest; DestSize: Integer; const Source; SourceSize: Integer);
var
  I: Integer;
  S,D: PByteArray;
begin
  if (DestSize <= 0) or (SourceSize <= 0) then Exit;
  S := PByteArray(@Source);
  D := PByteArray(@Dest);
  if SourceSize > DestSize then
  begin
    FillChar(D^, DestSize, 0);
    for I := 0 to SourceSize-1 do
      D[I mod DestSize] := D[I mod DestSize] + S[I];
  end else
  begin
    while DestSize > SourceSize do
    begin
      Move(S^, D^, SourceSize);
      Dec(DestSize, SourceSize);
      Inc(PChar(D), SourceSize);
    end;
    Move(S^, D^, DestSize);
  end;
end;

procedure FoldStr(var Dest; DestSize: Integer; const Source: String);
begin
  FoldBuf(Dest, DestSize, PChar(Source)^, Length(Source));
end;
// random

var
  FRndSeed: Cardinal = 0;

function DoRndBuffer(Seed: Cardinal; var Buffer; Size: Integer): Cardinal;
// nothing others as Borlands Random
asm
      AND     EDX,EDX
      JZ      @@2
      AND     ECX,ECX
      JLE     @@2
      PUSH    EBX
@@1:  IMUL    EAX,EAX,134775813
      INC     EAX
      MOV     EBX,EAX
      SHR     EBX,24
      MOV     [EDX],BL
      INC     EDX
      DEC     ECX
      JNZ     @@1
      POP     EBX
@@2:
end;

function RandomSystemTime: Cardinal;
// create Seed from Systemtime and performancecounter
var
  SysTime: record
             Year: Word;
             Month: Word;
             DayOfWeek: Word;
             Day: Word;
             Hour: Word;
             Minute: Word;
             Second: Word;
             MilliSeconds: Word;
             Reserved: array [0..7] of Byte;
           end;
  Counter: record
             Lo,Hi: Integer;
           end;
asm
         LEA    EAX,SysTime
         PUSH   EAX
         CALL   GetSystemTime
         MOVZX  EAX,Word Ptr SysTime.Hour
         IMUL   EAX,60
         ADD    AX,SysTime.Minute
         IMUL   EAX,60
         MOVZX  ECX,Word Ptr SysTime.Second
         ADD    EAX,ECX
         IMUL   EAX,1000
         MOV    CX,SysTime.MilliSeconds
         ADD    EAX,ECX
         PUSH   EAX
         LEA    EAX,Counter
         PUSH   EAX
         CALL   QueryPerformanceCounter
         POP    EAX
         ADD    EAX,Counter.Hi
         ADC    EAX,Counter.Lo
end;

function RandomBinary(Size: Integer): Binary;
begin
  SetLength(Result, Size);
  RandomBuffer(Result[1], Size);
end;

procedure RandomBuffer(var Buffer; Size: Integer);
begin
  if Assigned(DoRandomBuffer) then DoRandomBuffer(Buffer, Size)
    else FRndSeed := DoRndBuffer(FRndSeed, Buffer, Size);
end;

function RandomLong: LongWord;
begin
  RandomBuffer(Result, SizeOf(Result));
end;

procedure RandomSeed(const Buffer; Size: Integer);
begin
  if Assigned(DoRandomSeed) then DoRandomSeed(Buffer, Size) else
    if Size >= 0 then
    begin
      FRndSeed := 0;
      while Size > 0 do
      begin
        Dec(Size);
        FRndSeed := (FRndSeed shl 8 + FRndSeed shr 24) xor TByteArray(Buffer)[Size]
      end;
    end else FRndSeed := RandomSystemTime;
end;

procedure RandomSeed;
begin
  RandomSeed('', -1);
end;

procedure SwapBytes(var Buffer; BufferSize: Integer);
asm
       CMP    EDX,1
       JLE    @@3
       AND    EAX,EAX
       JZ     @@3
       PUSH   EBX
       MOV    ECX,EDX
       LEA    EDX,[EAX + ECX -1]
       SHR    ECX,1
@@1:   MOV    BL,[EAX]
       XCHG   BL,[EDX]
       DEC    EDX
       MOV    [EAX],BL
       INC    EAX
       DEC    ECX
       JNZ    @@1
@@2:   POP    EBX
@@3:
end;

function SwapLong(Value: LongWord): LongWord;
{$IFDEF UseASM}
  {$IFDEF 486GE}
    {$DEFINE SwapLong_asm}
  {$ENDIF}
{$ENDIF}
{$IFDEF SwapLong_asm}
asm
       BSWAP  EAX
end;
{$ELSE}
begin
  Result := Value shl 24 or Value shr 24 or Value shl 8 and $00FF0000 or Value shr 8 and $0000FF00;
end;
{$ENDIF}

procedure SwapLongBuffer(const Source; var Dest; Count: Integer);
{$IFDEF UseASM}
  {$IFDEF 486GE}
    {$DEFINE SwapLongBuffer_asm}
  {$ENDIF}
{$ENDIF}
{$IFDEF SwapLongBuffer_asm}
asm
       TEST   ECX,ECX
       JLE    @Exit
       PUSH   EDI
       SUB    EAX,4
       SUB    EDX,4
@@1:   MOV    EDI,[EAX + ECX * 4]
       BSWAP  EDI
       MOV    [EDX + ECX * 4],EDI
       DEC    ECX
       JNZ    @@1
       POP    EDI
@Exit:
end;
{$ELSE}
var
  I: Integer;
  T: LongWord;
begin
  for I := 0 to Count -1 do
  begin
    T := TLongArray(Source)[I];
    TLongArray(Dest)[I] := (T shl 24) or (T shr 24) or ((T shl 8) and $00FF0000) or ((T shr 8) and $0000FF00);
  end;
end;
{$ENDIF}

function SwapInt64(const Value: Int64): Int64;
{$IFDEF UseASM}
  {$IFDEF 486GE}
    {$DEFINE SwapInt64_asm}
  {$ENDIF}
{$ENDIF}
{$IFDEF SwapInt64_asm}
asm
       MOV    EDX,Value.DWord[0]
       MOV    EAX,Value.DWord[4]
       BSWAP  EDX
       BSWAP  EAX
end;
{$ELSE}
var
  L,H: LongWord;
begin
  L := Int64Rec(Value).Lo;
  H := Int64Rec(Value).Hi;
  L := L shl 24 or L shr 24 or L shl 8 and $00FF0000 or L shr 8 and $0000FF00;
  H := H shl 24 or H shr 24 or H shl 8 and $00FF0000 or H shr 8 and $0000FF00;
  Int64Rec(Result).Hi := L;
  Int64Rec(Result).Lo := H;
end;
{$ENDIF}

procedure SwapInt64Buffer(const Source; var Dest; Count: Integer);
{$IFDEF UseASM}
  {$IFDEF 486GE}
    {$DEFINE SwapInt64Buffer_asm}
  {$ENDIF}
{$ENDIF}
{$IFDEF SwapInt64Buffer_asm}
asm
       TEST   ECX,ECX
       JLE    @Exit
       PUSH   ESI
       PUSH   EDI
       LEA    ESI,[EAX + ECX * 8]
       LEA    EDI,[EDX + ECX * 8]
       NEG    ECX
@@1:   MOV    EAX,[ESI + ECX * 8]
       MOV    EDX,[ESI + ECX * 8 + 4]
       BSWAP  EAX
       BSWAP  EDX
       MOV    [EDI + ECX * 8 + 4],EAX
       MOV    [EDI + ECX * 8],EDX
       INC    ECX
       JNZ    @@1
       POP    EDI
       POP    ESI
@Exit:
end;
{$ELSE}
var
  I: Integer;
  H,L: LongWord;
begin
  for I := 0 to Count -1 do
  begin
   H := TLongArray(Source)[I * 2    ];
   L := TLongArray(Source)[I * 2 + 1];
   TLongArray(Dest)[I * 2    ] := L shl 24 or L shr 24 or L shl 8 and $00FF0000 or L shr 8 and $0000FF00;
   TLongArray(Dest)[I * 2 + 1] := H shl 24 or H shr 24 or H shl 8 and $00FF0000 or H shr 8 and $0000FF00;
  end;
end;
{$ENDIF}

{reverse the bit order from a integer}
function SwapBits(Value, Bits: LongWord): LongWord;
{$IFDEF UseASM}
  {$IFDEF 486GE}
    {$DEFINE SwapBits_asm}
  {$ENDIF}
{$ENDIF}
{$IFDEF SwapBits_asm}
asm
       BSWAP  EAX
       MOV    ECX,EAX
       AND    EAX,0AAAAAAAAh
       SHR    EAX,1
       AND    ECX,055555555h
       SHL    ECX,1
       OR     EAX,ECX
       MOV    ECX,EAX
       AND    EAX,0CCCCCCCCh
       SHR    EAX,2
       AND    ECX,033333333h
       SHL    ECX,2
       OR     EAX,ECX
       MOV    ECX,EAX
       AND    EAX,0F0F0F0F0h
       SHR    EAX,4
       AND    ECX,00F0F0F0Fh
       SHL    ECX,4
       OR     EAX,ECX
       AND    EDX,01Fh
       JZ     @@1
       MOV    ECX,32
       SUB    ECX,EDX
       SHR    EAX,CL
@@1:
end;
{$ELSE}
{$ENDIF}

{$IFDEF VER_D3H}
procedure ModuleUnload(Instance: Integer);
var // automaticaly deregistration/releasing
  I: Integer;
begin
  if IsObject(FClasses, TList) then
    for I := FClasses.Count -1 downto 0 do
      if Integer(FindClassHInstance(TClass(FClasses[I]))) = Instance then
        FClasses.Delete(I);
end;

initialization
  AddModuleUnloadProc(ModuleUnload);
{$ELSE}
initialization
{$ENDIF}
  FClasses := TList.Create;
finalization
{$IFDEF VER_D3H}
  RemoveModuleUnloadProc(ModuleUnload);
{$ENDIF}
  FClasses.Free;
  FClasses := nil;
end.