unit1.pas

来自「供asp使用的md5算法组件。示范如何在delphi中制作asp组件。」· PAS 代码 · 共 1,575 行 · 第 1/4 页

   Inc (Cardinal (OutPtr), 2);

   Inc (InnerLimit, MIME_DECODED_LINE_BREAK);
  end;
 
end;
procedure MimeEncode (const InputBuffer; const InputByteCount: Cardinal; out OutputBuffer);
var
 IDelta, ODelta     : Cardinal;
begin
 MimeEncodeFullLines (InputBuffer, InputByteCount, OutputBuffer);
 IDelta := InputByteCount div MIME_DECODED_LINE_BREAK; 
 ODelta := IDelta * (MIME_ENCODED_LINE_BREAK + 2);
 IDelta := IDelta * MIME_DECODED_LINE_BREAK;
 MimeEncodeNoCRLF (Pointer (Cardinal (@InputBuffer) + IDelta)^, 
  InputByteCount - IDelta, Pointer (Cardinal (@OutputBuffer) + ODelta)^);
end;

procedure MimeEncodeStream (const InputStream: TStream; const OutputStream: TStream);
var
 InputBuffer : array[0..BUFFER_SIZE - 1] of Byte;
 OutputBuffer : array[0.. (BUFFER_SIZE + 2) div 3 * 4 + BUFFER_SIZE div 
   MIME_DECODED_LINE_BREAK * 2 - 1] of Byte;
 BytesRead : Cardinal;
 IDelta, ODelta : Cardinal;
begin
 BytesRead := InputStream.Read (InputBuffer, SizeOf (InputBuffer));
 
 while BytesRead = SizeOf (InputBuffer) do
  begin
   MimeEncodeFullLines (InputBuffer, SizeOf (InputBuffer), OutputBuffer);
   OutputStream.Write (OutputBuffer, SizeOf (OutputBuffer));
   BytesRead := InputStream.Read (InputBuffer, SizeOf (InputBuffer));
  end;

 MimeEncodeFullLines (InputBuffer, BytesRead, OutputBuffer);
 
 IDelta := BytesRead div MIME_DECODED_LINE_BREAK; // Number of lines processed.
 ODelta := IDelta * (MIME_ENCODED_LINE_BREAK + 2);
 IDelta := IDelta * MIME_DECODED_LINE_BREAK;
 MimeEncodeNoCRLF(Pointer(Cardinal (@InputBuffer) + IDelta)^, BytesRead - IDelta, 
   Pointer (Cardinal (@OutputBuffer) + ODelta)^);
 
 OutputStream.Write (OutputBuffer, MimeEncodedSize (BytesRead));
end;


procedure Base64Encode(InputFile, OutputFile: string);
var
  Ms: TMemoryStream;
  Ss: TStringStream;
  Str: string;
  List: TStringList;
begin {Base64 encode} 
  Ms := TMemoryStream.Create;
  try
    Ms.LoadFromFile(InputFile);
    Ss := TStringStream.Create(Str);
    try
      MimeEncodeStream(Ms, Ss);
      List := TStringList.Create;
      try
        List.Text := Ss.DataString;
        List.SaveToFile(OutputFile);
      finally
        List.Free;
      end;
    finally
      Ss.Free;
    end;
  finally
    Ms.Free;
  end;
end;

procedure Base64Decode(InputFile, OutputFile: string);
var
  Ms: TMemoryStream;
  Ss: TStringStream;
  List: TStringList;
begin {Base64 decode}
  List := TStringList.Create;
  try
    List.LoadFromFile(InputFile);
    Ss := TStringStream.Create(List.Text);
    try
      Ms := TMemoryStream.Create;
      try
        MimeDecodeStream(Ss, Ms);
        Ms.SaveToFile(OutputFile);
      finally
        Ms.Free;
      end;
    finally
      Ss.Free;
    end;
  finally
    List.Free;
  end;
end;

function MimeEncodeStringNoCRLF (const s: AnsiString): AnsiString;
var
 l                  : Cardinal;
begin
 if Pointer (s) <> nil then
  begin
   l := Cardinal (Pointer (Cardinal (s) - 4)^);
   SetLength (Result, MimeEncodedSizeNoCRLF (l));
   MimeEncodeNoCRLF (Pointer (s)^, l, Pointer (Result)^);
  end
 else
  Result := '';
end;

function Tmake.MimeEncodeString(const s: WideString): WideString;
var
 l : Cardinal;
begin
 if Pointer (s) <> nil then
  begin
   l := Cardinal (Pointer (Cardinal (s) - 4)^);
   SetLength (Result, MimeEncodedSize (l));
   MimeEncode (Pointer (s)^, l, Pointer (Result)^);
  end
 else
  Result := '';
end;

function Tmake.MimeDecodeString(const s: WideString): WideString;
var
 ByteBuffer, ByteBufferSpace: Cardinal;
 l  : Cardinal;
begin
 if Pointer (s) <> nil then
  begin
   l := Cardinal (Pointer (Cardinal (s) - 4)^);
   SetLength (Result, (l + 3) div 4 * 3);
   ByteBuffer := 0;
   ByteBufferSpace := 4;
   l := MimeDecodePartial (Pointer (s)^, l, Pointer (Result)^, ByteBuffer, ByteBufferSpace);
   Inc (l, MimeDecodePartialEnd (Pointer (Cardinal (Result) + l)^,
     ByteBuffer, ByteBufferSpace));
   SetLength (Result, l);
  end
 else
  Result := '';
end;

//////////////////////////////////////////////////////////////////////////
//
//  以下开始blowfish算法代码
//
/////////////////////////////////////////////////////////////////////////

function Tmake.BlowFish_Func(PT: LongWord): LongWord;
var 
  a, b, c, d: byte; 
begin 
  a := (PT and $FF000000) shr $18; 
  b := (PT and $00FF0000) shr $10; 
  c := (PT and $0000FF00) shr $8; 
  d := (PT and $000000FF);
  Result := (((Key_Boxes[a+19] + Key_Boxes[b+19+256]) mod 4294967296) xor Key_Boxes[c+19+512] + Key_Boxes[d+19+768]) mod 4294967296;
end;

function Tmake.BlowFish_DN(PT: Int64): Int64;
var 
  i: byte; 
  xL, xR, tmp: LongWord; 
  r: int64; 
begin 
  xL := PT shr $20; 
  xR := PT mod $100000000; 
  xR := xR xor Key_Boxes[17]; 
  xL := xL xor Key_Boxes[18]; 
  for i:=16 downto 1 do 
  begin 
    if i<16 then 
    begin 
      tmp := xR; xR := xL; xL := tmp; 
    end;                        
    xR := BlowFish_Func(xL) xor xR; 
    xL := xL xor Key_Boxes[i]; 
  end; 
  r := xL; 
  r := (r shl $20) or xR; 
  Result := r; 
end;

function Tmake.BlowFish_EN(PT: Int64): Int64;
var 
  i: byte; 
  xL, xR, tmp: LongWord; 
  r: int64; 
begin 
  xL := PT shr $20; 
  xR := PT mod $100000000; 
  for i:=1 to 16 do 
  begin 
    xL := xL xor Key_Boxes[i]; 
    xR := BlowFish_Func(xL) xor xR; 
    if i<16 then 
    begin 
      tmp := xR; xR := xL; xL := tmp; 
    end; 
  end; 
  xR := xR xor Key_Boxes[17]; 
  xL := xL xor Key_Boxes[18]; 
  r := xL; 
  r := (r shl $20) or xR; 
  Result := r; 
end;

//BlowFish的初始化，得到子密钥，放在Key_Boxes中 
function Tmake.BlowFish_Init(const Key: WideString): WideString;
var 
  i, j, k: integer; 
  tmp: LongWord; 
  PT: int64; 
begin 
  FillChar(Key_Boxes, SizeOf(Key_Boxes), 0); 

//变换填充P盒 
  j := 1; 
  for i:=1 to 18 do 
  begin 
    tmp := 0; 
    for k:=0 to 3 do 
    begin 
      tmp := (tmp shl 8) or Ord(Key[j]); 
      inc(j); 
      if j>Length(Key) then 
        j := 1; 
    end; 
    Key_Boxes[i] := pBox[i] xor tmp; 
  end; 

//填充S盒 
  for i:=0 to 3 do 
  for j:=0 to 255 do 
    Key_Boxes[i*256+j+19] := sBox[i+1, j+1]; 

//开始连续填充 
  PT := 0; 
  for i:=1 to 521 do 
  begin 
    PT := BlowFish_EN(PT); 
    Key_Boxes[i*2-1] := PT shr $20; 
    Key_Boxes[i*2] := PT mod $100000000; 
  end;
end;

function Tmake.BlowFish_convert(const S: WideString): Int64;
var
  i:integer;
  b:Int64;
  Str:String;
begin
  b:=0;
  for i:=1 to Length(s) do
     str := str + inttostr(ord(s[i]));
  b:=strtoint64(str);
  result:=b;
end;

////////////////////////////////////////////////////////////////////////
//
//
//
////////////////////////////////////////////////////////////////////////

function Tmake.EncryStr(const Str, key: WideString): WideString;
var
  StrByte, OutByte, KeyByte: array[0..7] of Byte;
  StrResult: String;
  tempkey: string;
  tempstr: string;
  I, J: Integer;
begin
  tempkey:=key;
  tempstr:=str;
  if (Length(Str) > 0) and (Ord(Str[Length(Str)]) = 0) then
    raise Exception.Create('Error: the last char is NULL char.');
  if Length(Key) < 8 then
    while Length(tempKey) < 8 do tempKey := tempKey + Chr(0);
  while Length(tempStr) mod 8 <> 0 do tempStr := tempStr + Chr(0);

  for J := 0 to 7 do KeyByte[J] := Ord(tempKey[J + 1]);
  makeKey(keyByte, subKey);

  StrResult := '';

  for I := 0 to Length(tempStr) div 8 - 1 do
  begin
    for J := 0 to 7 do
      StrByte[J] := Ord(tempStr[I * 8 + J + 1]);
    desData(dmEncry, StrByte, OutByte);
    for J := 0 to 7 do
      StrResult := StrResult + Chr(OutByte[J]);
  end;

  Result := StrResult;
end;

////////////////////////////////////////////////////////////////////////

function Tmake.DecryStr(const Str, key: WideString): WideString;
var
  StrByte, OutByte, KeyByte: array[0..7] of Byte;
  StrResult: String;
  mykey,mystr: string;
  I, J: Integer;
begin
  mykey:=key;
  mystr:=str;
  if Length(Key) < 8 then
    while Length(myKey) < 8 do myKey := myKey + Chr(0);

  for J := 0 to 7 do KeyByte[J] := Ord(myKey[J + 1]);
  makeKey(keyByte, subKey);

  StrResult := '';

  for I := 0 to Length(myStr) div 8 - 1 do
  begin
    for J := 0 to 7 do StrByte[J] := Ord(myStr[I * 8 + J + 1]);
    desData(dmDecry, StrByte, OutByte);
    for J := 0 to 7 do
      StrResult := StrResult + Chr(OutByte[J]);
  end;
  while (Length(StrResult) > 0) and  (Ord(StrResult[Length(StrResult)]) = 0) do
    Delete(StrResult, Length(StrResult), 1);
  Result := StrResult;
end;

////////////////////////////////////////////////////////////////////////////

function Tmake.EncryStrHex(const StrHex, key: WideString): WideString;
var
  StrResult, TempResult, Temp: String;
  I: Integer;
begin
  TempResult := EncryStr(Strhex, Key);
  StrResult := '';
  for I := 0 to Length(TempResult) - 1 do
  begin
    Temp := Format('%x', [Ord(TempResult[I + 1])]);
    if Length(Temp) = 1 then Temp := '0' + Temp;
    StrResult := StrResult + Temp;
  end;
  Result := StrResult;
end;


function Tmake.DecryStrHex(const StrHex, key: WideString): WideString;
  function HexToInt(Hex: String): Integer;
  var
    I, Res: Integer;
    ch: Char;
  begin
    Res := 0;
    for I := 0 to Length(Hex) - 1 do
    begin
      ch := Hex[I + 1];
      if (ch >= '0') and (ch <= '9') then
        Res := Res * 16 + Ord(ch) - Ord('0')
      else if (ch >= 'A') and (ch <= 'F') then
        Res := Res * 16 + Ord(ch) - Ord('A') + 10
      else if (ch >= 'a') and (ch <= 'f') then
        Res := Res * 16 + Ord(ch) - Ord('a') + 10
      else raise Exception.Create('Error: not a Hex String');
    end;
    Result := Res;
  end;
var
  Str, Temp: String;
  I: Integer;
begin
  Str := '';
  for I := 0 to Length(StrHex) div 2 - 1 do
  begin
    Temp := Copy(StrHex, I * 2 + 1, 2);
    Str := Str + Chr(HexToInt(Temp));
  end;
  Result := DecryStr(Str, Key);
end;

initialization
  TAutoObjectFactory.Create(ComServer, Tmake, Class_make,
    ciMultiInstance, tmApartment);
end.