dcpcrypt.pas

用于开发税务票据管理的软件

begin
  case fCipherMode of
    cmCBC: EncryptCBC(Indata,Outdata,Size);
    cmCFB8bit: EncryptCFB8bit(Indata,Outdata,Size);
    cmCFBblock: EncryptCFBblock(Indata,Outdata,Size);
    cmOFB: EncryptOFB(Indata,Outdata,Size);
  end;
end;

function TDCP_blockcipher.EncryptString(const Str: string): string;
begin
  SetLength(Result,Length(Str));
  EncryptCFB8bit(Str[1],Result[1],Length(Str));
  Result:= Base64EncodeStr(Result);
end;

function TDCP_blockcipher.DecryptString(const Str: string): string;
begin
  Result:= Base64DecodeStr(Str);
  DecryptCFB8bit(Result[1],Result[1],Length(Result));
end;

procedure TDCP_blockcipher.Decrypt(const Indata; var Outdata; Size: longint);
begin
  case fCipherMode of
    cmCBC: DecryptCBC(Indata,Outdata,Size);
    cmCFB8bit: DecryptCFB8bit(Indata,Outdata,Size);
    cmCFBblock: DecryptCFBblock(Indata,Outdata,Size);
    cmOFB: DecryptOFB(Indata,Outdata,Size);
  end;
end;

procedure TDCP_blockcipher.EncryptCBC(const Indata; var Outdata; Size: longint);
var
  i: longint;
  p1, p2: pointer;
begin
  if not fInitialized then
    raise EDCP_blockcipher.Create('Cipher not initialized');
  p1:= @Indata;
  p2:= @Outdata;
  for i:= 1 to (Size div BS) do
  begin
    Move(p1^,p2^,BS);
    XorBlock(p2^,Chain^,BS);
    EncryptECB(p2^,p2^);
    Move(p2^,Chain^,BS);
    p1:= pointer(longint(p1) + BS);
    p2:= pointer(longint(p2) + BS);
  end;
  if (Size mod BS)<> 0 then
  begin
    EncryptECB(Chain^,Chain^);
    Move(p1^,p2^,Size mod BS);
    XorBlock(p2^,Chain^,Size mod BS);
  end;
end;

procedure TDCP_blockcipher.DecryptCBC(const Indata; var Outdata; Size: longint);
var
  i: longint;
  p1, p2: pointer;
begin
  if not fInitialized then
    raise EDCP_blockcipher.Create('Cipher not initialized');
  p1:= @Indata;
  p2:= @Outdata;
  for i:= 1 to (Size div BS) do
  begin
    Move(p1^,p2^,BS);
    Move(p1^,Temp^,BS);
    DecryptECB(p2^,p2^);
    XorBlock(p2^,Chain^,BS);
    Move(Temp^,Chain^,BS);
    p1:= pointer(longint(p1) + BS);
    p2:= pointer(longint(p2) + BS);
  end;
  if (Size mod BS)<> 0 then
  begin
    EncryptECB(Chain^,Chain^);
    Move(p1^,p2^,Size mod BS);
    XorBlock(p2^,Chain^,Size mod BS);
  end;
end;

procedure TDCP_blockcipher.EncryptCFB8bit(const Indata; var Outdata; Size: longint);
var
  i: longint;
  p1, p2: Pbyte;
begin
  if not fInitialized then
    raise EDCP_blockcipher.Create('Cipher not initialized');
  p1:= @Indata;
  p2:= @Outdata;
  for i:= 1 to Size do
  begin
    EncryptECB(Chain^,Temp^);
    p2^:= p1^ xor Pbyte(Temp)^;
    Move(pointer(longint(Chain)+1)^,Chain^,BS-1);
    Pbyte(longint(Chain)+BS-1)^:= p2^;
    Inc(p1);
    Inc(p2);
  end;
end;

procedure TDCP_blockcipher.DecryptCFB8bit(const Indata; var Outdata; Size: longint);
var
  i: longint;
  p1, p2: Pbyte;
  TempByte: byte;
begin
  if not fInitialized then
    raise EDCP_blockcipher.Create('Cipher not initialized');
  p1:= @Indata;
  p2:= @Outdata;
  for i:= 1 to Size do
  begin
    TempByte:= p1^;
    EncryptECB(Chain^,Temp^);
    p2^:= p1^ xor Pbyte(Temp)^;
    Move(pointer(longint(Chain)+1)^,Chain^,BS-1);
    Pbyte(longint(Chain)+BS-1)^:= TempByte;
    Inc(p1);
    Inc(p2);
  end;
end;

procedure TDCP_blockcipher.EncryptCFBblock(const Indata; var Outdata; Size: longint);
var
  i: longint;
  p1, p2: Pbyte;
begin
  if not fInitialized then
    raise EDCP_blockcipher.Create('Cipher not initialized');
  p1:= @Indata;
  p2:= @Outdata;
  for i:= 1 to (Size div BS) do
  begin
    EncryptECB(Chain^,Chain^);
    Move(p1^,p2^,BS);
    XorBlock(p2^,Chain^,BS);
    Move(p2^,Chain^,BS);
    p1:= pointer(longint(p1) + BS);
    p2:= pointer(longint(p2) + BS);
  end;
  if (Size mod BS)<> 0 then
  begin
    EncryptECB(Chain^,Chain^);
    Move(p1^,p2^,Size mod BS);
    XorBlock(p2^,Chain^,Size mod BS);
  end;
end;

procedure TDCP_blockcipher.DecryptCFBblock(const Indata; var Outdata; Size: longint);
var
  i: longint;
  p1, p2: Pbyte;
begin
  if not fInitialized then
    raise EDCP_blockcipher.Create('Cipher not initialized');
  p1:= @Indata;
  p2:= @Outdata;
  for i:= 1 to (Size div BS) do
  begin
    Move(p1^,Temp^,BS);
    EncryptECB(Chain^,Chain^);
    Move(p1^,p2^,BS);
    XorBlock(p2^,Chain^,BS);
    Move(Temp^,Chain^,BS);
    p1:= pointer(longint(p1) + BS);
    p2:= pointer(longint(p2) + BS);
  end;
  if (Size mod BS)<> 0 then
  begin
    EncryptECB(Chain^,Chain^);
    Move(p1^,p2^,Size mod BS);
    XorBlock(p2^,Chain^,Size mod BS);
  end;
end;

procedure TDCP_blockcipher.EncryptOFB(const Indata; var Outdata; Size: longint);
var
  i: longint;
  p1, p2: pointer;
begin
  if not fInitialized then
    raise EDCP_blockcipher.Create('Cipher not initialized');
  p1:= @Indata;
  p2:= @Outdata;
  for i:= 1 to (Size div BS) do
  begin
    EncryptECB(Chain^,Chain^);
    Move(p1^,p2^,BS);
    XorBlock(p2^,Chain^,BS);
    p1:= pointer(longint(p1) + BS);
    p2:= pointer(longint(p2) + BS);
  end;
  if (Size mod BS)<> 0 then
  begin
    EncryptECB(Chain^,Chain^);
    Move(p1^,p2^,Size mod BS);
    XorBlock(p2^,Chain^,Size mod BS);
  end;
end;

procedure TDCP_blockcipher.DecryptOFB(const Indata; var Outdata; Size: longint);
var
  i: longint;
  p1, p2: pointer;
begin
  if not fInitialized then
    raise EDCP_blockcipher.Create('Cipher not initialized');
  p1:= @Indata;
  p2:= @Outdata;
  for i:= 1 to (Size div BS) do
  begin
    EncryptECB(Chain^,Chain^);
    Move(p1^,p2^,BS);
    XorBlock(p2^,Chain^,BS);
    p1:= pointer(longint(p1) + BS);
    p2:= pointer(longint(p2) + BS);
  end;
  if (Size mod BS)<> 0 then
  begin
    EncryptECB(Chain^,Chain^);
    Move(p1^,p2^,Size mod BS);
    XorBlock(p2^,Chain^,Size mod BS);
  end;
end;

constructor TDCP_blockcipher.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  BS:= GetBlockSize shr 3;
  IV:= nil; Chain:= nil; Temp:= nil;
  try
    GetMem(IV,BS);
    GetMem(Chain,BS);
    GetMem(Temp,BS);
  except
    FreeMem(IV,BS);
    FreeMem(Chain,BS);
    raise EDCP_blockcipher.Create('Insufficient memory');
  end;
  fCipherMode:= cmCBC;
end;

destructor TDCP_blockcipher.Destroy;
begin
  FreeMem(IV);
  FreeMem(Chain);
  FreeMem(Temp);
  IV:= nil;      { Make sure that burn doesn't try to fillchar freed memory }
  inherited Destroy;
end;



{** TDCP_hash *****************************************************************}

procedure TDCP_hash.DeadInt(Value: longint);
begin
end;

procedure TDCP_hash.DeadStr(Value: string);
begin
end;

procedure TDCP_hash.UpdateStream(Stream: TStream; Size: longint);
var
  Buffer: array[0..8191] of byte;
  i, read: integer;
begin
  for i:= 1 to (Size div Sizeof(Buffer)) do
  begin
    read:= Stream.Read(Buffer,Sizeof(Buffer));
    Update(Buffer,read);
  end;
  if (Size mod Sizeof(Buffer))<> 0 then
  begin
    read:= Stream.Read(Buffer,Size mod Sizeof(Buffer));
    Update(Buffer,read);
  end;
end;

procedure TDCP_hash.UpdateStr(const Str: string);
begin
  Update(Str[1],Length(Str));
end;

destructor TDCP_hash.Destroy;
begin
  if fInitialized then
    Burn;
  inherited Destroy;
end;



{** Helper functions **********************************************************}


function DCPcipherfromname(const Value: string; AOwner: TComponent): TDCP_cipher;
var
  Next: PDCP_cipherinfo;
  CName: string;
begin
  Next:= DCPcipherlist;
  CName:= LowerCase(Value);
  while (Next<> nil) and (Next^.Name<> CName) do
    Next:= Next^.Next;
  if Next<> nil then
    if Next^.Block then  // not sure if this is needed but ....
      Result:= TDCP_cipher(TDCP_blockcipherclass(Next^.Cipher).Create(AOwner))
    else
      Result:= Next^.Cipher.Create(AOwner)
  else
    Result:= nil;
end;

function DCPcipherfromid(Value: longint; AOwner: TComponent): TDCP_cipher;
var
  Next: PDCP_cipherinfo;
begin
  Next:= DCPcipherlist;
  while (Next<> nil) and (Next^.Id<> Value) do
    Next:= Next^.Next;
  if Next<> nil then
    if Next^.Block then  // not sure if this is needed but ....
      Result:= TDCP_cipher(TDCP_blockcipherclass(Next^.Cipher).Create(AOwner))
    else
      Result:= Next^.Cipher.Create(AOwner)
  else
    Result:= nil;
end;

function DCPhashfromname(const Value: string; AOwner: TComponent): TDCP_hash;
var
  Next: PDCP_hashinfo;
  HName: string;
begin
  Next:= DCPhashlist;
  HName:= LowerCase(Value);
  while (Next<> nil) and (Next^.Name<> HName) do
    Next:= Next^.Next;
  if Next<> nil then
    Result:= Next^.Hash.Create(AOwner)
  else
    Result:= nil;
end;

function DCPhashfromid(Value: longint; AOwner: TComponent): TDCP_hash;
var
  Next: PDCP_hashinfo;
begin
  Next:= DCPhashlist;
  while (Next<> nil) and (Next^.Id<> Value) do
    Next:= Next^.Next;
  if Next<> nil then
    Result:= Next^.Hash.Create(AOwner)
  else
    Result:= nil;
end;

procedure DCPregcipher(Cipher: TDCP_cipherclass; Block: boolean);
var
  NewCipher: PDCP_cipherinfo;
begin
  New(NewCipher);
  NewCipher^.Cipher:= Cipher;
  NewCipher^.Name:= LowerCase(Cipher.GetAlgorithm);
  NewCipher^.Id:= Cipher.GetId;
  NewCipher^.Next:= DCPcipherlist;
  NewCipher^.Block:= Block;
  DCPcipherlist:= NewCipher;
end;

procedure DCPreghash(Hash: TDCP_hashclass);
var
  NewHash: PDCP_hashinfo;
begin
  New(NewHash);
  NewHash^.Hash:= Hash;
  NewHash^.Name:= LowerCase(Hash.GetAlgorithm);
  NewHash^.Id:= Hash.GetId;
  NewHash^.Next:= DCPhashlist;
  DCPhashlist:= NewHash;
end;

procedure DCPregfree;
var
  NextCipher: PDCP_cipherinfo;
  NextHash: PDCP_hashinfo;
begin
  while (DCPcipherlist<> nil) do
  begin
    NextCipher:= DCPcipherlist^.Next;
    Dispose(DCPcipherlist);
    DCPcipherlist:= NextCipher;
  end;
  while (DCPhashlist<> nil) do
  begin
    NextHash:= DCPhashlist^.Next;
    Dispose(DCPhashlist);
    DCPhashlist:= NextHash;
  end;
end;


procedure XorBlock(var InData1, InData2; Size: longint);
var
  i: integer;
begin
  for i:= 1 to Size do
    Pbyte(longint(@InData1)+i-1)^:= Pbyte(longint(@InData1)+i-1)^ xor Pbyte(longint(@InData2)+i-1)^;
end;

function CompareMemory(X1, X2: PByteArray; Size: longint): boolean;
var
  i: longint;
begin
  Result:= true;
  for i:= 1 to Size do
    if X1^[i-1]<> X2^[i-1] then
      Result:= false;
end;

function LRot16(X: Word; c: longint): Word;
begin
  LRot16:= (X shl c) or (X shr (16 - c));
end;

function RRot16(X: Word; c: longint): Word;
begin
  RRot16:= (X shr c) or (X shl (16 - c));
end;

function LRot32(X: DWord; c: longint): DWord;
begin
  LRot32:= (X shl c) or (X shr (32 - c));
end;

function RRot32(X: DWord; c: longint): DWord;
begin
  RRot32:= (X shr c) or (X shl (32 - c));
end;

function SwapDWord(X: DWord): DWord;
begin
  Result:= (X shr 24) or ((X shr 8) and $FF00) or ((X shl 8) and $FF0000) or (X shl 24);
end;

initialization
  DCPcipherlist:= nil;
  DCPhashlist:= nil;
  DCPreghash(TDCP_SHA1);  { Change to what ever the default hash algorithm you use is }
                          { If this is not called then the hash algorithm isn't registered as the SHA1 unit registers it self before the list pointer is initialized }

finalization
  DCPregfree;

end.