unit1.pas

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

procedure MD5Update(var Context: MD5Context; Input: pChar; Length: longword);
var
	Index: longword;
	PartLen: longword;
	I: longword;
begin
	with Context do begin
		Index := (Count[0] shr 3) and $3f;
		inc(Count[0], Length shl 3);
		if Count[0] < (Length shl 3) then inc(Count[1]);
		inc(Count[1], Length shr 29);
	end;
	PartLen := 64 - Index;
	if Length >= PartLen then begin
		CopyMemory(@Context.Buffer[Index], Input, PartLen);
		Transform(@Context.Buffer, Context.State);
		I := PartLen;
		while I + 63 < Length do begin
			Transform(@Input[I], Context.State);
			inc(I, 64);
		end;
		Index := 0;
	end else I := 0;
	CopyMemory(@Context.Buffer[Index], @Input[I], Length - I);
end;

procedure MD5Final(var Context: MD5Context; var Digest: MD5Digest);
var
	Bits: MD5CBits;
	Index: longword;
	PadLen: longword;
begin
	Decode(@Context.Count, @Bits, 2);
	Index := (Context.Count[0] shr 3) and $3f;
	if Index < 56 then PadLen := 56 - Index else PadLen := 120 - Index;
	MD5Update(Context, @PADDING, PadLen);
	MD5Update(Context, @Bits, 8);
	Decode(@Context.State, @Digest, 4);
	ZeroMemory(@Context, SizeOf(MD5Context));
end;

function MD5String(M: string): MD5Digest;
var
	Context: MD5Context;
begin
	MD5Init(Context);
	MD5Update(Context, pChar(M), length(M));
	MD5Final(Context, Result);
end;

function MD5File(N: string): MD5Digest;
var
	FileHandle: THandle;
	MapHandle: THandle;
	ViewPointer: pointer;
	Context: MD5Context;
begin
	MD5Init(Context);
	FileHandle := CreateFile(pChar(N), GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE,
		nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL or FILE_FLAG_SEQUENTIAL_SCAN, 0);
	if FileHandle <> INVALID_HANDLE_VALUE then try
		MapHandle := CreateFileMapping(FileHandle, nil, PAGE_READONLY, 0, 0, nil);
		if MapHandle <> 0 then try
			ViewPointer := MapViewOfFile(MapHandle, FILE_MAP_READ, 0, 0, 0);
			if ViewPointer <> nil then try
				MD5Update(Context, ViewPointer, GetFileSize(FileHandle, nil));
			finally
				UnmapViewOfFile(ViewPointer);
			end;
		finally
			CloseHandle(MapHandle);
		end;
	finally
		CloseHandle(FileHandle);
	end;
	MD5Final(Context, Result);
end;

function MD5Print(D: MD5Digest): string;
var
	I: byte;
const
	Digits: array[0..15] of char =
		('0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'a', 'b', 'c', 'd', 'e', 'f');
begin
	Result := '';
	for I := 0 to 15 do Result := Result + Digits[(D[I] shr 4) and $0f] + Digits[D[I] and $0f];
end;

function MD5Match(D1, D2: MD5Digest): boolean;
var
	I: byte;
begin
	I := 0;
	Result := TRUE;
	while Result and (I < 16) do begin
		Result := D1[I] = D2[I];
		inc(I);
	end;
end;


function Tmake.RivestFile(const FileName: WideString): WideString;
begin
   Result := MD5Print(MD5File(FileName));
end;

function Tmake.RivestStr(const Str: WideString): WideString;
begin
   Result := MD5Print(MD5String(Str));
end;

///////////////////////////////////////////////////////////////////////////
//
// 以下开始base64加密算法
//
///////////////////////////////////////////////////////////////////////////


function MimeDecodePartial (const InputBuffer; const InputBytesCount: Cardinal; 
  out OutputBuffer; var ByteBuffer: Cardinal; var ByteBufferSpace: Cardinal): Cardinal;
var
 lByteBuffer, lByteBufferSpace, c: Cardinal;
 InPtr, OuterLimit  : ^Byte;
 OutPtr             : PByte3;
begin
 if InputBytesCount > 0 then
  begin
   InPtr := @InputBuffer;
   Cardinal (OuterLimit) := Cardinal (InPtr) + InputBytesCount;
   OutPtr := @OutputBuffer;
   lByteBuffer := ByteBuffer;
   lByteBufferSpace := ByteBufferSpace;
   while InPtr <> OuterLimit do
    begin
     c := MIME_DECODE_TABLE[InPtr^];
     Inc (InPtr);
     if c = $FF then Continue;
     lByteBuffer := lByteBuffer shl 6;
     lByteBuffer := lByteBuffer or c;
     Dec (lByteBufferSpace);
     if lByteBufferSpace <> 0 then Continue;
     OutPtr^.b3 := Byte (lByteBuffer);
     lByteBuffer := lByteBuffer shr 8;
     OutPtr^.b2 := Byte (lByteBuffer);
     lByteBuffer := lByteBuffer shr 8;
     OutPtr^.b1 := Byte (lByteBuffer);
     lByteBuffer := 0;
     Inc (OutPtr);
     lByteBufferSpace := 4;
    end;
   ByteBuffer := lByteBuffer;
   ByteBufferSpace := lByteBufferSpace;
   Result := Cardinal (OutPtr) - Cardinal (@OutputBuffer);
  end
 else
  Result := 0;
end;

function MimeDecodePartialEnd (out OutputBuffer; const ByteBuffer: Cardinal; 
  const ByteBufferSpace: Cardinal): Cardinal;
var
 lByteBuffer : Cardinal;
begin
 case ByteBufferSpace of
  1:
   begin
    lByteBuffer := ByteBuffer shr 2;
    PByte3 (@OutputBuffer)^.b2 := Byte (lByteBuffer);
    lByteBuffer := lByteBuffer shr 8;
    PByte3 (@OutputBuffer)^.b1 := Byte (lByteBuffer);
    Result := 2;
   end;
  2:
   begin
    lByteBuffer := ByteBuffer shr 4;
    PByte3 (@OutputBuffer)^.b1 := Byte (lByteBuffer);
    Result := 1;
   end;
  else
   Result := 0;
 end;
end;


procedure MimeEncodeNoCRLF (const InputBuffer; const InputByteCount: Cardinal; out OutputBuffer);
var
 b, OuterLimit      : Cardinal;
 InPtr, InnerLimit  : ^Byte;
 OutPtr             : PByte4;
begin
 if InputByteCount = 0 then Exit;
 InPtr := @InputBuffer;
 OutPtr := @OutputBuffer;

 OuterLimit := InputByteCount div 3 * 3;

 InnerLimit := @InputBuffer;
 Inc (Cardinal (InnerLimit), OuterLimit);
 while InPtr <> InnerLimit do
  begin
   b := InPtr^;
   b := b shl 8;
   Inc (InPtr);
   b := b or InPtr^;
   b := b shl 8;
   Inc (InPtr);
   b := b or InPtr^;
   Inc (InPtr);
   OutPtr^.b4 := MIME_ENCODE_TABLE[b and $3F];
   b := b shr 6;
   OutPtr^.b3 := MIME_ENCODE_TABLE[b and $3F];
   b := b shr 6;
   OutPtr^.b2 := MIME_ENCODE_TABLE[b and $3F];
   b := b shr 6;
   OutPtr^.b1 := MIME_ENCODE_TABLE[b];
   Inc (OutPtr);
  end;
 case InputByteCount - OuterLimit of
  1:
   begin
    b := InPtr^;
    b := b shl 4;
    OutPtr.b2 := MIME_ENCODE_TABLE[b and $3F];
    b := b shr 6;
    OutPtr.b1 := MIME_ENCODE_TABLE[b];
    OutPtr.b3 := MIME_PAD_CHAR;
    OutPtr.b4 := MIME_PAD_CHAR;
   end;
  2:
   begin
    b := InPtr^;
    Inc (InPtr);
    b := b shl 8;
    b := b or InPtr^;
    b := b shl 2;
    OutPtr.b3 := MIME_ENCODE_TABLE[b and $3F];
    b := b shr 6;
    OutPtr.b2 := MIME_ENCODE_TABLE[b and $3F];
    b := b shr 6;
    OutPtr.b1 := MIME_ENCODE_TABLE[b];
    OutPtr.b4 := MIME_PAD_CHAR;         { Pad remaining byte. }
   end;
 end;
end;


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

 MimeEncodeNoCRLF (InputBuffer, BytesRead, OutputBuffer);
 OutputStream.Write (OutputBuffer, (BytesRead + 2) div 3 * 4);
end;

procedure MimeDecodeStream (const InputStream: TStream; const OutputStream: TStream);
var
 ByteBuffer, ByteBufferSpace: Cardinal;
 InputBuffer        : array[0..BUFFER_SIZE - 1] of Byte;
 OutputBuffer       : array[0.. (BUFFER_SIZE + 3) div 4 * 3 - 1] of Byte;
 BytesRead          : Cardinal;
begin
 ByteBuffer := 0;
 ByteBufferSpace := 4;
 BytesRead := InputStream.Read (InputBuffer, SizeOf (InputBuffer));
 while BytesRead > 0 do
  begin
   OutputStream.Write(OutputBuffer, MimeDecodePartial(InputBuffer, BytesRead,
     OutputBuffer, ByteBuffer, ByteBufferSpace));
   BytesRead := InputStream.Read (InputBuffer, SizeOf (InputBuffer));
  end;
 OutputStream.Write (OutputBuffer, MimeDecodePartialEnd (OutputBuffer, ByteBuffer, 
   ByteBufferSpace));
end;

function MimeDecode (const InputBuffer; const InputBytesCount: Cardinal;
  out OutputBuffer): Cardinal;
var
 ByteBuffer, ByteBufferSpace: Cardinal;
begin
 ByteBuffer := 0;
 ByteBufferSpace := 4;
 Result := MimeDecodePartial(InputBuffer, InputBytesCount,
  OutputBuffer, ByteBuffer, ByteBufferSpace);
 Inc (Result, MimeDecodePartialEnd(Pointer (Cardinal(@OutputBuffer) + Result)^,
  ByteBuffer, ByteBufferSpace));
end;

procedure DecodeHttpBasicAuthentication (const BasicCredentials: AnsiString; out UserId, PassWord: AnsiString);
label
 Fail;
const
 LBasic = 6;                { Length ('Basic ') }
var
 DecodedPtr, p      : PAnsiChar;
 i, l               : Cardinal;
begin
 p := Pointer (BasicCredentials);
 if p = nil then goto Fail;
 
 l := Cardinal (Pointer (p - 4)^);
 if l <= LBasic then goto Fail;
 
 Dec (l, LBasic);
 Inc (p, LBasic);
 
 GetMem (DecodedPtr, (l + 3) div 4 * 3 { MimeDecodedSize (l) });
 l := MimeDecode (p^, l, DecodedPtr^);
 i := 0;
 p := DecodedPtr;
 while (l > 0) and (p[i] <> ':') do
  begin
   Inc (i);
   Dec (l);
  end;
 SetString (UserId, DecodedPtr, i);
 if l > 1 then
  SetString (PassWord, DecodedPtr + i + 1, l - 1)
 else
  PassWord := '';
 
 FreeMem (DecodedPtr);
 Exit;
 
 Fail:
 UserId := '';
 PassWord := '';
end;

function MimeEncodedSize (const i: Cardinal): Cardinal;
begin
 Result := (i + 2) div 3 * 4 + (i - 1) div MIME_DECODED_LINE_BREAK * 2;
end;

function MimeEncodedSizeNoCRLF (const i: Cardinal): Cardinal;
begin
 Result := (i + 2) div 3 * 4;
end;

function MimeDecodedSize (const i: Cardinal): Cardinal;
begin
 Result := (i + 3) div 4 * 3;
end;

procedure MimeEncodeFullLines (const InputBuffer; const InputByteCount: Cardinal; out OutputBuffer);
var
 b, OuterLimit      : Cardinal;
 InPtr, InnerLimit  : ^Byte;
 OutPtr             : PByte4;
begin
 if InputByteCount = 0 then Exit;
 InPtr := @InputBuffer;
 OutPtr := @OutputBuffer;
 
 InnerLimit := InPtr;
 Inc (Cardinal (InnerLimit), MIME_DECODED_LINE_BREAK);
 
 OuterLimit := Cardinal (InPtr);
 Inc (OuterLimit, InputByteCount);

 while Cardinal (InnerLimit) <= OuterLimit do
  begin

   while InPtr <> InnerLimit do
    begin
     b := InPtr^;
     b := b shl 8;
     Inc (InPtr);
     b := b or InPtr^;
     b := b shl 8;
     Inc (InPtr);
     b := b or InPtr^;
     Inc (InPtr);
     OutPtr^.b4 := MIME_ENCODE_TABLE[b and $3F];
     b := b shr 6;
     OutPtr^.b3 := MIME_ENCODE_TABLE[b and $3F];
     b := b shr 6;
     OutPtr^.b2 := MIME_ENCODE_TABLE[b and $3F];
     b := b shr 6;
     OutPtr^.b1 := MIME_ENCODE_TABLE[b];
     Inc (OutPtr);
    end;
   OutPtr^.b1 := 13;
   OutPtr^.b2 := 10;