unit1.~pas

Base64算法完整源码与调用方法 Base64算法完整源码与调用方法

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 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 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;
   Inc (Cardinal (OutPtr), 2);

   Inc (InnerLimit, MIME_DECODED_LINE_BREAK);
  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;

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;

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

procedure TForm1.Button1Click(Sender: TObject);
begin
//function MimeEncodeString (const s: AnsiString): AnsiString;//加密字符串函数；
//function MimeDecodeString (const s: AnsiString): AnsiString;//解密字符串函数；
  if MimeEncodeString(Edit1.Text)=Edit2.Text then
    ShowMessage('注册成功！')
  else
    ShowMessage('注册失败！');
///////////////////////////////////////////////////////////////////////////////
                         //Base64 DEMO V1.0//
                          //作者：ksaiy//
//欢迎使用由ksaiy制作的Base64加密算法演示程序，此算法为标准的Base64算法，你可以
//根据的的自己需要进行变形。具体怎么操作可以登录我们的网站查询详细的资料。我们专
//门为软件开发者提供软件加密安全测试服务和软件加密解决方案，具体的可以参看我们的
//网站上的资料。我们的网站：http://www.ksaiy.com  http://www.magicoa.com
//技术支持:[e-mail] 在线QQ：40188696 UC：934155
                            //End //

                  //注意：转载请保留以上信息。//                            
///////////////////////////////////////////////////////////////////////////////
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Close;
end;

end.