Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.
Solved
Base64 Encode/Decode UTF8 Delphi 2010
Posted on 2010-09-03
Hello,
I have a Unit where in Delphi 2007 i was able to encode/decode strings being compatible with the PHP version of Base64...
So, a String base64 encoded in PHP, i was able to decode it in my Delphi app..
Now using Delphi 2010, i wanna make it compatible... but i really don't have idea where is the problem... when i try to encode a text, it comes like "Chinese Characters"... i can change all Strings from the Unit to AnsiString but then i don't have a base64 support for Unicode!
Attached is the Unit... somebody know how to make it compatible with Unicode?
I don't have enough knowledge to change things in this unit where will be able to support unicode... in the official website, it's just abandoned and since 2003 there is no updates!
but i know that its possible, since there are a lot of examples over the web but in .NET or javascript, C# not in Delphi :(
To test the unit, is something like
Example, 2 Edits over the form and 1 button
OnButton Click
Edit2.Text := SZFullEncodeBase64(Edit1.T
Best Regards,
Carlos SZCodeBaseX.pas
I have a Unit where in Delphi 2007 i was able to encode/decode strings being compatible with the PHP version of Base64...
So, a String base64 encoded in PHP, i was able to decode it in my Delphi app..
Now using Delphi 2010, i wanna make it compatible... but i really don't have idea where is the problem... when i try to encode a text, it comes like "Chinese Characters"... i can change all Strings from the Unit to AnsiString but then i don't have a base64 support for Unicode!
Attached is the Unit... somebody know how to make it compatible with Unicode?
I don't have enough knowledge to change things in this unit where will be able to support unicode... in the official website, it's just abandoned and since 2003 there is no updates!
but i know that its possible, since there are a lot of examples over the web but in .NET or javascript, C# not in Delphi :(
To test the unit, is something like
Example, 2 Edits over the form and 1 button
OnButton Click
Edit2.Text := SZFullEncodeBase64(Edit1.T
Best Regards,
Carlos SZCodeBaseX.pas
[X]
Welcome to Experts Exchange
Add your voice to the tech community where 5M+ people just like you are talking about what matters.
- Help others & share knowledge
- Earn cash & points
- Learn & ask questions
4
4-
2
10 Comments
it seems the unit suppose that string is AnsiString, but in D2010 string is WideString.
so, I think you have to change all string types into unit to AnsiString
or maybe there is a compiler directive for that?
so, I think you have to change all string types into unit to AnsiString
or maybe there is a compiler directive for that?
also you have to change PChar to PAnsiChar
try the attached unit. I've done these changes and checked it on your sample.
try the attached unit. I've done these changes and checked it on your sample.
{$O+} // Optimization must be ON
{$R-} // Range checking must be OFF
unit SZCodeBaseX;
/////////////////////////////
// Version 1.3.5
////////////////////////////
{
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at http://www.mozilla.org/MPL/
Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the
specific language governing rights and limitations under the License.
The original code is SZCodeBaseX.pas, released 15. July, 2004.
The initial developer of the original code is
Sasa Zeman (public@szutils.net, www.szutils.net)
Copyright(C) 2004-2007 Sasa Zeman. All Rights Reserved.
}
{--------------------------------------------------------------------
Encode/Decode algorithms for Base16, Base32 and Base64
Reference: RFC 3548
- Universal Encode/Decode algorithms for Base16, Base32 and Base64
- Standard Base16, Base32 and Base64 encoding/decoding functions
- Reference: RFC 3548, full compatibility
- Full MIME suppport
- Supported work with Memory, Stream, String and Files
- Optionally supported work with padding keys (required numbers
of '=' at the end of the encoded array)
- Very flexible work - you may easily create your own Encode/Decode functions
based on your own specific codes, from Base2 up to Base128
----------------------------------
Revision History:
----------------------------------
-------------------------
Version 1.3.5, 2007-07-02
-------------------------
- Bugfix on SZCodeBaseXSetBufferSize;
-------------------------
Version 1.3.4, 2007-03-10
-------------------------
- Cleaning some useless code
- Some minor code tweaks
- Demo update
-------------------------
Version 1.3.3, 2006-12-10
-------------------------
- Better demo
- Some minor code reorganization
-------------------------
Version 1.3.2, 2005-07-09
-------------------------
- Added external functions to calculate Required Output Memory
Thanks to Grant.
-------------------------
Version 1.3.1, 2005-06-18
-------------------------
- fixed runtime error in decoding when range checking is ON.
Thanks to Grant.
-------------------------
Version 1.3.0, 2005-05-03
-------------------------
- Added MIME support
-------------------------
Version 1.2.1, 2004-11-19
-------------------------
- Added support for Memory, Stream and Files
- Added support for Delphi 5 and BCB - pByte issue
-------------------------
Version 1.1.0, 2004-08-21
-------------------------
- Optimized version, more than 35 times speed acceleration,
one of the fastest and the simplest universal Base16/32/64 encoder/decoder
-------------------------
Version 1.0.0, 2004-07-15
-------------------------
- Initial version
----------------------------------
Author : Sasa Zeman
E-mail : public@szutils.net or sasaz72@mail.ru
Web site : www.szutils.net
}
interface
uses Windows, SysUtils, Types, Classes;
//////////////////////////////////////////////////////////////////
// Universal Encode/Decode algorithms for Base16, Base32 and Base64
// Actualy, you can create any variation you need, even by your own
// codes from Base2 to Base128
//////////////////////////////////////////////////////////////////
const
SZCodeBaseXver='1.3.5';
function SZEncodeBaseXMemory( pIN, pOUT: pByte; Size: integer; const Codes: AnsiString; BITS: integer; FullQuantum : integer; MIMELine: integer): integer;
function SZDecodeBaseXMemory( pIN, pOUT: pByte; Size: integer; const Codes: AnsiString; BITS: integer): integer;
function SZEncodeBaseXStream(sIN, sOUT: TStream; Size: integer; const Codes: AnsiString; BITS: integer; FullQuantum : integer; MIMELine: integer ): integer;
function SZDecodeBaseXStream(sIN, sOUT: TStream; const Codes: AnsiString; BITS: integer): integer;
function SZEncodeBaseXString(const S: AnsiString; const Codes: AnsiString; BITS: integer; FullQuantum : integer; MIMELine: integer): AnsiString;
function SZDecodeBaseXString(const S: AnsiString; const Codes: AnsiString; BITS: integer): AnsiString;
function SZEncodeBaseXFile(const FileName: AnsiString; sOUT: TStream; const Codes: AnsiString; BITS: integer; FullQuantum : integer; MIMELine: integer): integer;
// Decoding entire file is not supported, as is not logical - file may
// contain any data, or more than one encoded data
// Use the stream realization for precise and logical decoding - even
// for a part of a stream (fully supported)
//////////////////////////////////////////////////////////////////
// Calculates full reqired memory for output
// based on input size, BITS and needs for padding keys
//////////////////////////////////////////////////////////////////
function SZCalcRequireOutputMemory(TotalIn: integer; BITS, FullQuantum: integer; MIMELine: integer): integer;
// Calculates reqired ammount of padding keys based on output size
function SZCalcRequiredPaddingKeys(Size, FullQuantum: integer):Integer;
//////////////////////////////////////////////////////////////////
// ATTENTION!!!
// Next two functions are for testing purposes only.
// My be deleted in the future.
////////////////////////////////////////////////////////////////////
function SZFullEncodeOnlyBase64(const S: AnsiString; MIMELine: integer = 0): AnsiString;
function SZFullEncodeOnlyBase64_6(const S: AnsiString; MIMELine: integer = 0): AnsiString;
////////////////////////////////////////////////////////////////////
// Base 16
//////////////////////////////////////////////////////////////////
function SZEncodeBase16(pIN, pOUT: PByte; Size: integer; MIMELine: integer = 0): integer; overload;
function SZEncodeBase16(sIN, sOUT: TStream; Size: integer=-1; MIMELine: integer = 0): integer; overload;
function SZEncodeBase16(const S: AnsiString; MIMELine: integer = 0): AnsiString; overload;
function SZEncodeBase16(const FileName: AnsiString; sOUT: TStream; MIMELine: integer = 0): integer; overload;
function SZDecodeBase16(pIN, pOUT: PByte; Size: integer): integer; overload;
function SZDecodeBase16(sIN, sOUT: TStream): integer; overload;
function SZDecodeBase16(const S: AnsiString): AnsiString; overload;
//////////////////////////////////////////////////////////////////
// Base32, Full encoding mean adding padding keys
//////////////////////////////////////////////////////////////////
function SZFullEncodeBase32(pIN, pOUT: PByte; Size: integer; MIMELine: integer = 0): integer; overload;
function SZFullEncodeBase32(sIN, sOUT: TStream; Size: integer=-1; MIMELine: integer = 0): integer; overload;
function SZFullEncodeBase32(const S: AnsiString; MIMELine: integer = 0): AnsiString; overload;
function SZFullEncodeBase32(const FileName: AnsiString; sOUT: TStream; MIMELine: integer = 0): integer; overload;
function SZEncodeBase32(pIN, pOUT: PByte; Size: integer; MIMELine: integer = 0): integer; overload;
function SZEncodeBase32(sIN, sOUT: TStream; Size: integer=-1; MIMELine: integer = 0): integer; overload;
function SZEncodeBase32(const S: AnsiString; MIMELine: integer = 0): AnsiString; overload;
function SZEncodeBase32(const FileName: AnsiString; sOUT: TStream; MIMELine: integer = 0): integer; overload;
function SZDecodeBase32(pIN, pOUT: PByte; Size: integer): integer; overload;
function SZDecodeBase32(sIN, sOUT: TStream): integer; overload;
function SZDecodeBase32(const S: AnsiString): AnsiString; overload;
//////////////////////////////////////////////////////////////////
// Base 64, Full encoding mean adding padding keys
//////////////////////////////////////////////////////////////////
function SZFullEncodeBase64(pIN, pOUT: PByte; Size: integer; MIMELine: integer = 0): integer; overload;
function SZFullEncodeBase64(sIN, sOUT: TStream; Size: integer=-1; MIMELine: integer = 0): integer; overload;
function SZFullEncodeBase64(const S: AnsiString; MIMELine: integer = 0): AnsiString; overload;
function SZFullEncodeBase64(const FileName: AnsiString; sOUT: TStream; MIMELine: integer = 0): integer; overload;
function SZEncodeBase64(pIN, pOUT: PByte; Size: integer; MIMELine: integer = 0): integer; overload;
function SZEncodeBase64(sIN, sOUT: TStream; Size: integer=-1; MIMELine: integer = 0): integer; overload;
function SZEncodeBase64(const S: AnsiString; MIMELine: integer = 0): AnsiString; overload;
function SZEncodeBase64(const FileName: AnsiString; sOUT: TStream; MIMELine: integer = 0): integer; overload;
function SZDecodeBase64(pIN, pOUT: PByte; Size: integer): integer; overload;
function SZDecodeBase64(sIN, sOUT: TStream): integer; overload;
function SZDecodeBase64(const S: AnsiString): AnsiString; overload;
//////////////////////////////////////////////////////////////////
// Base64 URL, Full encoding mean adding padding keys
//////////////////////////////////////////////////////////////////
function SZFullEncodeBase64URL(pIN, pOUT: PByte; Size: integer; MIMELine: integer = 0): integer; overload;
function SZFullEncodeBase64URL(sIN, sOUT: TStream; Size: integer=-1; MIMELine: integer = 0): integer; overload;
function SZFullEncodeBase64URL(const S: AnsiString; MIMELine: integer = 0): AnsiString; overload;
function SZFullEncodeBase64URL(const FileName: AnsiString; sOUT: TStream; MIMELine: integer = 0): integer; overload;
function SZEncodeBase64URL(pIN, pOUT: PByte; Size: integer; MIMELine: integer = 0): integer; overload;
function SZEncodeBase64URL(sIN, sOUT: TStream; Size: integer=-1; MIMELine: integer = 0): integer; overload;
function SZEncodeBase64URL(const S: AnsiString; MIMELine: integer = 0): AnsiString; overload;
function SZEncodeBase64URL(const FileName: AnsiString; sOUT: TStream; MIMELine: integer = 0): integer; overload;
function SZDecodeBase64URL(pIN, pOUT: PByte; Size: integer): integer; overload;
function SZDecodeBase64URL(sIN, sOUT: TStream): integer; overload;
function SZDecodeBase64URL(const S: AnsiString): AnsiString; overload;
//////////////////////////////////////////////////////////////////
// Calculating Required Output Memory
//////////////////////////////////////////////////////////////////
function SZCalcRequiredOutputMemoryForFullEncodeBase64(Size: integer; MIMELine: integer=0): integer;
function SZCalcRequiredOutputMemoryForFullEncodeBase32(Size: integer; MIMELine: integer=0): integer;
function SZCalcRequiredOutputMemoryForEncodeBase64(Size: integer; MIMELine: integer=0): integer;
function SZCalcRequiredOutputMemoryForEncodeBase32(Size: integer; MIMELine: integer=0): integer;
function SZCalcRequiredOutputMemoryForEncodeBase16(Size: integer; MIMELine: integer=0): integer;
//////////////////////////////////////////////////////////////////
// Setting Buffer Size procedure
//////////////////////////////////////////////////////////////////
procedure SZCodeBaseXSetBufferSize(Size:integer);
procedure SZCodeBaseXSetOrigBufferSize;
//////////////////////////////////////////////////////////////////
implementation
const
// Basic size for buffer is 64KB
SZORIGBUFFSIZE = 64*1024;
///////////////////////////////////////////
/// Base 64 definitions
///////////////////////////////////////////
SZCodes64 = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
SZCodes64URL = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_';
SZBITS64 = 6;
// Resulted number of chars must be integral multiple of
// 24 input bits div 6 output group bits
SZFullQuantum64 = 24 div 6;
///////////////////////////////////////////
///////////////////////////////////////////
/// Base 32 definitions
///////////////////////////////////////////
SZCodes32 = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ234567';
SZBITS32 = 5;
// Resulted number of chars must be integral multiple of
// 40 input bits div 5 output group bits
SZFullQuantum32 = 40 div 5;
// If there is no need for padding keys
SZFullQuantum0 = 0;
///////////////////////////////////////////
/// Base 16 definitions
///////////////////////////////////////////
SZCodes16 = '0123456789ABCDEF';
SZBITS16 = 4;
///////////////////////////////////////////
type
TFastDecodeTable=array[0..255] of byte;
var
// Optimized buffer length for encoding files up to 64KB
// Important for speed-up works with large streams
SZBUFFSIZE: integer;
SZFastDecodeTable: TFastDecodeTable;
////////////////////////////
// Basic Functions
////////////////////////////
procedure SZUpdateFastDecodeTable(const Codes: AnsiString);
var
i: integer;
begin
FillChar(SZFastDecodeTable,256,#0);
for i := 1 to length(Codes) do
SZFastDecodeTable[ byte( Codes[i] ) ] := i;
end;
function SZCalcRequiredPaddingKeys(Size, FullQuantum: integer):Integer;
{
Adding necessary padding keys to create a full
RFC 3548 compatibility string
}
var
IM: integer;
begin
if FullQuantum>0 then
IM:=Size mod FullQuantum
else
IM:=0;
if IM>0 then
Result:=FullQuantum-IM
else
Result:=0
end;
function SZCalcRequireOutputMemory(TotalIn: integer; BITS, FullQuantum: integer; MIMELine: integer): integer;
var
TotalOut, IM, MIMEOut: integer;
begin
TotalOut := TotalIn shl 3; // * 8
if TotalOut mod BITS > 0 then
TotalOut:= TotalOut div BITS +1
else
TotalOut:= TotalOut div BITS;
if MIMELine>0 then
MIMEOut:= ( (TotalOut-1) div (MIMELine) ) shl 1 // * 2
else
MIMEOut:= 0;
if FullQuantum>0 then
begin
IM:=TotalOut mod FullQuantum;
if IM>0 then
TotalOut:= TotalOut + FullQuantum-IM;
end;
// Additional space for CRLF (2 bytes) if MIME encoding is required
if MIMELine>0 then
TotalOut:= TotalOut + MIMEOut;
result:=TotalOut;
end;
procedure GetRelevantData(TotalIn: integer; var TotalOut: integer;
BITS, FullQuantum: integer; var IM: integer; MIMELine: integer);
var
MIMEOut: integer;
begin
TotalOut:=TotalIn shl 3; // * 8
if TotalOut mod BITS > 0 then
TotalOut:= TotalOut div BITS +1
else
TotalOut:= TotalOut div BITS;
if MIMELine>0 then
MIMEOut:= ( (TotalOut-1) div (MIMELine) ) shl 1 // * 2
else
MIMEOut:=0;
if FullQuantum>0 then
begin
IM:=TotalOut mod FullQuantum;
if IM>0 then
TotalOut:= TotalOut + FullQuantum-IM;
end
else
IM:=0;
// Additional space for CRLF (2 bytes) if MIME encoding is required
if MIMELine>0 then
TotalOut:= TotalOut + MIMEOut
end;
////////////////////////////
// Memory
////////////////////////////
function SZEncodeBaseXMemoryUpdate(pIN: PByte; var pOUT: PByte; Size: integer; const Codes: AnsiString; BITS: integer; var vB8, VI8: integer; MIMELine: integer; Var MIMECountdown, MIMEBytesCount: integer): integer;
{
Universal Encode algorithm for Base16, Base32 and Base64
Reference: RFC 3548
RFC incompatibility: No padding keys
}
const Mask: array [0..16] of Word=
( 0, 1, 3, 7, 15, 31, 63,
127, 255, 511, 1023, 2047,
4095, 8191, 16383, 32767, 65535
);
var
i,B8, I8, Count: integer;
MIME: Boolean;
begin
MIME:=MIMELine > 0;
Count:=0;
B8 := vB8;
I8 := vI8;
for i := 1 to Size do
begin
B8 := B8 shl 8;
B8 := B8 or pIN^;
I8 := I8 + 8;
while I8 >= BITS do
begin
I8 := (I8 - BITS);
// Get first BITS of bits
PAnsiChar(pOUT)^ := Codes[(B8 shr I8)+1];
inc(pOUT);
inc(Count);
if MIME then
begin
MIMECountdown := MIMECountdown - 1;
if MIMECountdown <= 0 then
begin
MIMECountdown := MIMELine;
MIMEBytesCount := MIMEBytesCount + 2;
// Put CRLF
pOUT^ := 13; inc(pOUT);
pOUT^ := 10; inc(pOUT);
inc(Count,2);
end;
end;
//Return position back for BITS bits
//B8 := B8 - ((B8 shr I8) shl I8);
// The same result as upper code, a bit faster
B8 := B8 and MASK[I8];
end;
inc(pIN);
end;
vB8 := B8;
vI8 := I8;
result:=Count;
end;
function SZEncodeBaseXMemoryFinalyze(var pOUT: PByte; const Codes: AnsiString; BITS: integer; B8, I8: integer): integer;
// Finalyzing encoding with last left bites (if any)
begin
// If something left
if I8 > 0 then
begin
PAnsiChar(pOUT)^ := Codes[ (B8 shl (BITS-I8)) + 1];
inc(pOUT);
result:=1;
end else
result:=0;
end;
function SZEncodeBaseXMemory(pIN, pOUT: pByte; Size: integer; const Codes: AnsiString; BITS: integer; FullQuantum : integer; MIMELine : integer): integer;
var
B8,I8: integer;
TotalOut : integer;
IM : integer;
MIMECountdown : integer;
MIMEBytesCount : integer;
ppIN, ppOUT: pByte;
begin
B8:=0;
I8:=0;
ppIN := pIN;
ppOUT := pOut;
MIMECountdown := MIMELine;
MIMEBytesCount := 0;
TotalOut:=SZEncodeBaseXMemoryUpdate(ppIN, ppOUT, Size, Codes, BITS, B8, I8, MIMELine, MIMECountdown, MIMEBytesCount);
// If something left
if I8>0 then
TotalOut:=TotalOut+
SZEncodeBaseXMemoryFinalyze(ppOut, Codes, BITS, B8, I8);
if FullQuantum>0 then
begin
// Calculate relevant data
//GetRelevantData(TotalIn, TotalOut, BITS, FullQuantum, IM);
// Get required padding keys
IM:=SZCalcRequiredPaddingKeys(TotalOut - MIMEBytesCount, FullQuantum);
if IM>0 then
begin
FillChar( ppOUT^, IM,'=');
PAnsiChar(ppOut):=PAnsiChar(ppOut)+IM;
TotalOut:=TotalOut + IM
end
end;
result:=TotalOut;
end;
function SZDecodeBaseXMemoryUpdate(pIN,pOUT: pByte; Size: integer; const FastDecodeTable: TFastDecodeTable; BITS: integer; var B8, I8 : integer): integer;
{
Universal Decode algorithm for Base16, Base32 and Base64
Reference: RFC 3548 - full compatibility
}
var
i: Integer;
TotalIN, Count: integer;
begin
TotalIN := Size;
// Start decoding
count := 0;
for i := 1 to TotalIN do
begin
if SZFastDecodeTable[pIN^] > 0 then
begin
B8 := B8 shl BITS;
B8 := B8 or (SZFastDecodeTable[pIN^]-1);
I8 := I8 + BITS;
while I8 >= 8 do
begin
I8 := I8 - 8;
pOUT^ := Byte(B8 shr I8);
inc( pOUT );
inc(count)
end;
inc(pIN);
end
else if pIN^=13 then inc(pIN)
else if pIN^=10 then inc(pIN)
else
break
end;
result:=Count;
end;
function SZDecodeBaseXMemory(pIN,pOUT: pByte; Size: integer; const Codes: AnsiString; BITS: integer): integer;
{
Universal Decode algorithm for Base16, Base32 and Base64
Reference: RFC 3548 - full compatibility
}
var
B8, I8 : integer;
begin
B8:=0;
I8:=0;
SZUpdateFastDecodeTable(Codes);
result:=SZDecodeBaseXMemoryUpdate( pIN, pOUT, Size, SZFastDecodeTable, BITS, B8, I8);
end;
function SZDecodeBaseXString(const S: AnsiString; const Codes: AnsiString; BITS: integer): AnsiString;
var
TotalIn : integer;
TotalOut : integer;
pIN,pOUT: pByte;
begin
TotalIn := length(S);
TotalOut := (TotalIn * BITS) shr 3; // div 8;
Setlength(Result,TotalOut);
pIN := @S[1];
pOUT := @Result[1];
TotalOut:=SZDecodeBaseXMemory( pIN, pOUT, TotalIn, Codes, BITS);
if length(Result)<> TotalOut then
Setlength(Result,TotalOut);
end;
function SZEncodeBaseXString(const S: AnsiString; const Codes: AnsiString; BITS: integer; FullQuantum : integer ; MIMELine : integer): AnsiString;
// Universal Encode algorithm for Base16, Base32 and Base64
var
pIN, pOUT: pByte;
TotalIn, TotalOut: integer;
IM: integer;
LOut: integer;
begin
TotalIn := length(S);
// Calculate relevant data
GetRelevantData(TotalIn, TotalOut, BITS, FullQuantum, IM, MIMELine);
SetLength(Result,TotalOut);
pIN :=@S[1];
pOUT:=@Result[1];
LOut:=SZEncodeBaseXMemory(pIn,pOut, TotalIn, Codes, BITS, FullQuantum, MIMELine);
if Lout<>TotalOut then
SetLength(Result,LOut);
end;
//////////////////////////
// Stream
//////////////////////////
function SZEncodeBaseXStreamUpdate(sIN, sOUT: TStream; Size: integer; const Codes: AnsiString; BITS: integer; var vB8, vI8: integer; MIMELine: integer; Var MIMECountdown, MIMEByteCount: integer): integer;
var
pBuffIn, pBuffOut: pByte;
Res,BUFF : Integer;
pIn,pOut: pByte;
LOut,Count,TotalIn, TotalOut, MIMEOut: integer;
begin
BUFF := SZBUFFSIZE;
TotalIn:=Size;
if BUFF > TotalIn then
BUFF := TotalIn + 1;
TotalOut := BUFF shl 3; // * 8
if TotalOut mod BITS > 0 then
TotalOut := TotalOut div BITS +1
else
TotalOut := TotalOut div BITS;
if MIMELine>0 then
MIMEOut := ( (TotalOut-1) div (MIMELine) ) shl 1 // * 2
else
MIMEOut := 0;
TotalOut := TotalOut + MIMEOut;
// Get memory for it
GetMem(pBuffIn,BUFF);
GetMem(pBuffOut,TotalOut);
Count := 0;
repeat
Res := sIn.Read(pBuffIn^, BUFF);
pIn := pBuffIn;
pOut := pBuffOut;
LOut:=SZEncodeBaseXMemoryUpdate(pIn,pOut, Res, Codes, BITS, vB8, vI8, MIMELine, MIMECountdown, MIMEByteCount);
sOut.Write(pBuffOut^,LOut);
Count := Count + LOut;
until (Res <> LongInt(BUFF));
FreeMem(pBuffIn);
FreeMem(pBuffOut);
result:=Count;
end;
function SZEncodeBaseXStreamFinalyze(sOUT: TStream; const Codes: AnsiString; BITS: integer; var B8, I8: integer): integer;
var
pOut: pByte;
b: byte;
begin
pOut:=@b;
Result:=SZEncodeBaseXMemoryFinalyze(pOUT, Codes, BITS, B8, I8);
if Result>0 then
sOut.Write(b,Result);
end;
function SZEncodeBaseXStream(sIN, sOUT: TStream; Size: integer; const Codes: AnsiString; BITS: integer; FullQuantum : integer; MIMELine : integer): integer;
var
B8, I8: integer;
TotalIn : integer;
TotalOut : integer;
IM : integer;
MIMECountdown : integer;
MIMEBytesCount: integer;
begin
if size=0 then
begin
result:=0;
exit
end;
// This is important code if you encode just part of a stream
if size<0 then
TotalIn:= sIn.Size-sIn.Position
else
TotalIn:= Size;
B8:=0;
I8:=0;
MIMECountdown := MIMELine;
MIMEBytesCount := 0;
TotalOut:=SZEncodeBaseXStreamUpdate(sIN, sOUT, TotalIn, Codes, BITS, B8, I8, MIMELine, MIMECountdown, MIMEBytesCount);
// If something left
if I8>0 then
TotalOut:=TotalOut + SZEncodeBaseXStreamFinalyze(sOUT, Codes, BITS, B8, I8);
if FullQuantum>0 then
begin
// Calculate relevant data
// GetRelevantData(TotalIn, TotalOut, BITS, FullQuantum, IM);
// Get required padding keys
IM:=SZCalcRequiredPaddingKeys(TotalOut-MIMEBytesCount, FullQuantum);
if IM > 0 then
begin
sOut.Write(PAnsiChar(StringOfChar('=',IM))^,IM);
TotalOut:=TotalOut+IM
end
end;
result:=TotalOut;
end;
function SZDecodeBaseXStream(sIN, sOUT: TStream; const Codes: AnsiString; BITS: integer): integer;
var
TotalIn : integer;
TotalOut : integer;
pIn,pOut: pByte;
pBuffIn, pBuffOut: pByte;
Res,BUFF : Integer;
LOut,Count: integer;
B8, I8: integer;
begin
BUFF := SZBUFFSIZE;
// This is important code if you encode just a part of a stream
TotalIn := sIn.Size - SIn.Position;
if BUFF > TotalIn then
BUFF := TotalIn + 1;
TotalOut := BUFF;
// Get memory for it
GetMem(pBuffIn,BUFF);
GetMem(pBuffOut,TotalOut);
Count := 0;
B8 := 0;
I8 := 0;
SZUpdateFastDecodeTable(Codes);
repeat
Res := sIn.Read(pBuffIn^, BUFF);
pIn := pBuffIn;
pOut := pBuffOut;
Lout := SZDecodeBaseXMemoryUpdate(pIN, pOUT, Res, SZFastDecodeTable, BITS, B8, I8);
sOut.Write(pBuffOut^,LOut);
Count := Count + LOut;
until (Res <> LongInt(BUFF));
FreeMem(pBuffOut);
FreeMem(pBuffIn);
result := Count;
end;
function SZEncodeBaseXFile(const FileName: AnsiString; sOUT: TStream; const Codes: AnsiString; BITS: integer; FullQuantum : integer; MIMELine: integer ): integer;
var
sIn: TFileStream;
Size: integer;
begin
sIn := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
Size:= sIn.Size;
try
result:= SZEncodeBaseXStream(sIN, sOUT, Size, Codes, BITS, FullQuantum, MIMELine);
finally
sIn.Free;
end;
end;
///////////////////////////////////////////////////
// File to stream
///////////////////////////////////////////////////
function SZFullEncodeBase64(const FileName: AnsiString; sOUT: TStream; MIMELine: integer = 0): integer; overload;
begin
result:=SZEncodeBaseXFile(FileName, sOUT, SZCodes64, SZBITS64, SZFullQuantum64, MIMELine);
end;
function SZFullEncodeBase64URL(const FileName: AnsiString; sOUT: TStream; MIMELine: integer = 0): integer; overload;
begin
result:=SZEncodeBaseXFile(FileName, sOUT, SZCodes64URL, SZBITS64, SZFullQuantum64, MIMELine);
end;
function SZEncodeBase64(const FileName: AnsiString; sOUT: TStream; MIMELine: integer = 0): integer; overload;
begin
result:=SZEncodeBaseXFile(FileName, sOUT, SZCodes64, SZBITS64, SZFullQuantum0, MIMELine);
end;
function SZEncodeBase64URL(const FileName: AnsiString; sOUT: TStream; MIMELine: integer = 0): integer; overload;
begin
result:=SZEncodeBaseXFile(FileName, sOUT, SZCodes64URL, SZBITS64, SZFullQuantum0, MIMELine);
end;
function SZFullEncodeBase32(const FileName: AnsiString; sOUT: TStream; MIMELine: integer = 0): integer; overload;
begin
result:=SZEncodeBaseXFile(FileName, sOUT, SZCodes32, SZBITS32, SZFullQuantum32, MIMELine);
end;
function SZEncodeBase32(const FileName: AnsiString; sOUT: TStream; MIMELine: integer = 0): integer; overload;
begin
result:=SZEncodeBaseXFile(FileName, sOUT, SZCodes32, SZBITS32, SZFullQuantum0, MIMELine);
end;
function SZEncodeBase16(const FileName: AnsiString; sOUT: TStream; MIMELine: integer = 0): integer; overload;
begin
result:=SZEncodeBaseXFile(FileName, sOUT, SZCodes16, SZBITS16, SZFullQuantum0, MIMELine);
end;
////////////////////////////////////////////////////////////
/// Base16
////////////////////////////////////////////////////////////
function SZEncodeBase16(pIN, pOUT: PByte; Size: integer; MIMELine: integer = 0): integer; overload;
begin
result:= SZEncodeBaseXMemory(pIN,pOUT, Size, SZCodes16, SZBITS16, SZFullQuantum0, MIMELine);
end;
function SZEncodeBase16(sIN, sOUT: TStream; Size: integer=-1; MIMELine: integer = 0): integer; overload;
begin
result:=SZEncodeBaseXStream(sIN, sOUT, Size, SZCodes16, SZBITS16, SZFullQuantum0, MIMELine);
end;
function SZEncodeBase16(const S: AnsiString; MIMELine: integer = 0): AnsiString; overload;
begin
Result:=SZEncodeBaseXString(S, SZCodes16, SZBITS16, SZFullQuantum0, MIMELine)
end;
function SZDecodeBase16(pIN, pOUT: PByte; Size: integer): integer; overload;
begin
result:= SZDecodeBaseXMemory(pIN,pOUT, Size, SZCodes16, SZBITS16);
end;
function SZDecodeBase16(sIN, sOUT: TStream): integer; overload;
begin
result:= SZDecodeBaseXStream(sIN,sOUT, SZCodes16, SZBITS16);
end;
function SZDecodeBase16(const S: AnsiString): AnsiString; overload;
begin
Result:=SZDecodeBaseXString(S, SZCodes16, SZBITS16)
end;
////////////////////////////////////////////////////////////
/// Base32
////////////////////////////////////////////////////////////
function SZFullEncodeBase32(pIN, pOUT: PByte; Size: integer; MIMELine: integer = 0): integer; overload;
begin
result:=SZEncodeBaseXMemory(pIN,pOUT, Size, SZCodes32, SZBITS32, SZFullQuantum32, MIMELine);
end;
function SZFullEncodeBase32(sIN, sOUT: TStream; Size: integer=-1; MIMELine: integer = 0): integer; overload;
begin
result:=SZEncodeBaseXStream(sIN,sOUT, Size, SZCodes32, SZBITS32, SZFullQuantum32, MIMELine);
end;
function SZFullEncodeBase32(const S: AnsiString; MIMELine: integer = 0): AnsiString; overload;
begin
Result:=SZEncodeBaseXString(S, SZCodes32, SZBITS32, SZFullQuantum32, MIMELine);
end;
function SZEncodeBase32(pIN, pOUT: PByte; Size: integer; MIMELine: integer = 0): integer; overload;
begin
result:=SZEncodeBaseXMemory(pIN,pOUT, Size, SZCodes32, SZBITS32, SZFullQuantum0, MIMELine);
end;
function SZEncodeBase32(sIN, sOUT: TStream; Size: integer=-1; MIMELine: integer = 0): integer; overload;
begin
result:=SZEncodeBaseXStream(sIN,sOUT, Size, SZCodes32, SZBITS32, SZFullQuantum0, MIMELine);
end;
function SZEncodeBase32(const S: AnsiString; MIMELine: integer = 0): AnsiString; overload;
begin
Result:=SZEncodeBaseXString(S, SZCodes32, SZBITS32, SZFullQuantum0, MIMELine)
end;
function SZDecodeBase32(pIN, pOUT: PByte; Size: integer): integer; overload;
begin
result:=SZDecodeBaseXMemory(pIN,pOUT, Size, SZCodes32, SZBITS32);
end;
function SZDecodeBase32(sIN, sOUT: TStream): integer; overload;
begin
result:=SZDecodeBaseXStream(sIN,sOUT, SZCodes32, SZBITS32);
end;
function SZDecodeBase32(const S: AnsiString): AnsiString; overload;
begin
Result:=SZDecodeBaseXString(S, SZCodes32, SZBITS32)
end;
////////////////////////////////////////////////////////////
/// Base64
////////////////////////////////////////////////////////////
function SZFullEncodeBase64(pIN, pOUT: PByte; Size: integer; MIMELine: integer = 0): integer; overload;
begin
result:=SZEncodeBaseXMemory(pIN,pOUT, Size, SZCodes64, SZBITS64, SZFullQuantum64, MIMELine);
end;
function SZFullEncodeBase64(sIN, sOUT: TStream; Size: integer=-1; MIMELine: integer = 0): integer; overload;
begin
result:=SZEncodeBaseXStream(sIN,sOUT, Size, SZCodes64, SZBITS64, SZFullQuantum64, MIMELine);
end;
function SZFullEncodeBase64(const S: AnsiString; MIMELine: integer = 0): AnsiString; overload;
begin
Result:=SZEncodeBaseXString(S, SZCodes64, SZBITS64, SZFullQuantum64, MIMELine)
end;
function SZEncodeBase64(pIN, pOUT: PByte; Size: integer; MIMELine: integer = 0): integer; overload;
begin
result:=SZEncodeBaseXMemory(pIN,pOUT, Size, SZCodes64, SZBITS64, SZFullQuantum0, MIMELine);
end;
function SZEncodeBase64(sIN, sOUT: TStream; Size: integer=-1; MIMELine: integer = 0): integer; overload;
begin
result:=SZEncodeBaseXStream(sIN,sOUT, Size, SZCodes64, SZBITS64, SZFullQuantum0, MIMELine);
end;
function SZEncodeBase64(const S: AnsiString; MIMELine: integer = 0): AnsiString; overload;
begin
Result:=SZEncodeBaseXString(S, SZCodes64, SZBITS64, SZFullQuantum0, MIMELine)
end;
function SZDecodeBase64(pIN, pOUT: PByte; Size: integer): integer; overload;
begin
result:=SZDecodeBaseXMemory(pIN,pOUT, Size, SZCodes64, SZBITS64);
end;
function SZDecodeBase64(sIN, sOUT: TStream): integer; overload;
begin
result:=SZDecodeBaseXStream(sIN,sOUT, SZCodes64, SZBITS64);
end;
function SZDecodeBase64(const S: AnsiString): AnsiString; overload;
begin
Result:=SZDecodeBaseXString(S, SZCodes64, SZBITS64)
end;
////////////////////////////////////////////////////////////
/// Base64 URL table
////////////////////////////////////////////////////////////
function SZFullEncodeBase64URL(pIN, pOUT: PByte; Size: integer; MIMELine: integer = 0): integer; overload;
begin
result:=SZEncodeBaseXMemory(pIN, pOUT, Size, SZCodes64URL, SZBITS64, SZFullQuantum64, MIMELine);
end;
function SZFullEncodeBase64URL(sIN, sOUT: TStream; Size: integer=-1; MIMELine: integer = 0): integer; overload;
begin
result:=SZEncodeBaseXStream(sIN,sOUT, Size, SZCodes64URL, SZBITS64, SZFullQuantum64, MIMELine);
end;
function SZFullEncodeBase64URL(const S: AnsiString; MIMELine: integer = 0): AnsiString; overload;
begin
Result:=SZEncodeBaseXString(S, SZCodes64URL, SZBITS64, SZFullQuantum64, MIMELine)
end;
function SZEncodeBase64URL(pIN, pOUT: PByte; Size: integer; MIMELine: integer = 0): integer; overload;
begin
result:=SZEncodeBaseXMemory(pIN, pOUT, Size, SZCodes64URL, SZBITS64, SZFullQuantum0, MIMELine);
end;
function SZEncodeBase64URL(const S: AnsiString; MIMELine: integer = 0): AnsiString; overload;
begin
Result:=SZEncodeBaseXString(S, SZCodes64URL, SZBITS64, SZFullQuantum0, MIMELine)
end;
function SZEncodeBase64URL(sIN, sOUT: TStream; Size: integer=-1; MIMELine: integer = 0): integer; overload;
begin
result:=SZEncodeBaseXStream(sIN,sOUT, Size, SZCodes64URL, SZBITS64, SZFullQuantum0, MIMELine);
end;
function SZDecodeBase64URL(pIN, pOUT: PByte; Size: integer): integer; overload;
begin
result:=SZDecodeBaseXMemory(pIN,pOUT, Size, SZCodes64URL, SZBITS64);
end;
function SZDecodeBase64URL(sIN, sOUT: TStream): integer; overload;
begin
result:=SZDecodeBaseXStream(sIN,sOUT, SZCodes64URL, SZBITS64);
end;
function SZDecodeBase64URL(const S: AnsiString): AnsiString; overload;
begin
Result:=SZDecodeBaseXString(S, SZCodes64URL, SZBITS64)
end;
//////////////////////////////////////////////////////////////
procedure SZCodeBaseXSetBufferSize(Size:integer);
begin
// Do not allow Buffers size less than original
// to avoid drastic performace decresing with streams
if size < SZORIGBUFFSIZE then
SZBUFFSIZE := Size
else
SZBUFFSIZE := SZORIGBUFFSIZE;
end;
procedure SZCodeBaseXSetOrigBufferSize;
begin
SZCodeBaseXSetBufferSize(SZORIGBUFFSIZE);
end;
//////////////////////////////////////////////////////////////////
// Calculating Required Output Memory
//////////////////////////////////////////////////////////////////
function SZCalcRequiredOutputMemoryForFullEncodeBase64(Size: integer; MIMELine: integer=0): integer;
begin
Result:=SZCalcRequireOutputMemory(Size, SZBITS64, SZFullQuantum64, MIMELine);
end;
function SZCalcRequiredOutputMemoryForFullEncodeBase32(Size: integer; MIMELine: integer=0): integer;
begin
Result:=SZCalcRequireOutputMemory(Size, SZBITS32, SZFullQuantum32, MIMELine);
end;
function SZCalcRequiredOutputMemoryForFullEncodeBase16(Size: integer; MIMELine: integer=0): integer;
begin
Result:=SZCalcRequireOutputMemory(Size, SZBITS16, SZFullQuantum0, MIMELine);
end;
function SZCalcRequiredOutputMemoryForEncodeBase64(Size: integer; MIMELine: integer=0): integer;
begin
Result:=SZCalcRequireOutputMemory(Size, SZBITS64, SZFullQuantum0, MIMELine);
end;
function SZCalcRequiredOutputMemoryForEncodeBase32(Size: integer; MIMELine: integer=0): integer;
begin
Result:=SZCalcRequireOutputMemory(Size, SZBITS32, SZFullQuantum0, MIMELine);
end;
function SZCalcRequiredOutputMemoryForEncodeBase16(Size: integer; MIMELine: integer=0): integer;
begin
Result:=SZCalcRequireOutputMemory(Size, SZBITS16, SZFullQuantum0, MIMELine);
end;
//////////////////////////////////////////////////////////////
/// END OF ACTUAL CODE
//////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////
//Additional code may be deleted in the future
//////////////////////////////////////////////////////////////
const
codes64: array[0..63] of byte = (
065, 066, 067, 068, 069, 070, 071, 072,
073, 074, 075, 076, 077, 078, 079, 080,
081, 082, 083, 084, 085, 086, 087, 088,
089, 090, 097, 098, 099, 100, 101, 102,
103, 104, 105, 106, 107, 108, 109, 110,
111, 112, 113, 114, 115, 116, 117, 118,
119, 120, 121, 122, 048, 049, 050, 051,
052, 053, 054, 055, 056, 057, 043, 047);
function SZFullEncodeOnlyBase64(const S: AnsiString; MIMELine: integer = 0): AnsiString;
{
Encode algorithm for Base64
Reference: RFC 3548 - full compatibility
ATTENTION! MIMELine here in not in use!
}
type
TBI3= packed array [0..2] of byte;
pBI3= ^TBI3;
TBO4= packed array [0..3] of byte;
pBO4= ^TBO4;
var
i: integer;
pIN: pBI3;
pOUT: pBO4;
TotalIn, TotalOut, TotalInRest: integer;
B32: longword;
begin
TotalIn := length(s);
TotalOut := (TotalIn + 2) div 3 * 4 ;
TotalINRest:= TotalIn - TotalIN div 3 * 3;
SetLength(Result, TotalOut);
pIN := @S[1];
pOUT := @Result[1];
// Start coding
for i := 1 to TotalIn Div 3 do
begin
// Set new DWORD value in format
// 00000000 11111111 22222222 33333333
B32 := (pIN[0] shl 16) or (pIN[1] shl 8) or (pIn[2]);
inc(pIN);
pOUT[3] := Codes64[ B32 and $3F ]; B32:=B32 shr 6;
pOUT[2] := Codes64[ B32 and $3F ]; B32:=B32 shr 6;
pOUT[1] := Codes64[ B32 and $3F ]; B32:=B32 shr 6;
pOUT[0] := Codes64[ B32 ];
inc(pOUT);
end;
if TotalINRest = 1 then
begin
B32:= (pIn[0] shl 4) ;
pOUT[1] := Codes64[ B32 and $3F ]; B32:= B32 shr 6;
pOUT[0] := Codes64[ B32 ];
pOUT[3] := byte('=');
pOUT[2] := byte('=');
end
else
if TotalINRest = 2
then
begin
B32:= ((pIn[0] shl 8) or pIn[1]) shl 2 ;
pOUT[2] := Codes64[ B32 and $3F ]; B32:= B32 shr 6;
pOUT[1] := Codes64[ B32 and $3F ]; B32:= B32 shr 6;
pOUT[0] := Codes64[ B32 ];
pOUT[3] := byte('=');
end
end;
function SZFullEncodeOnlyBase64_6(const S: AnsiString; MIMELine: integer = 0): AnsiString;
{
Encode algorithm for Base64
Reference: RFC 3548 - full compatibility
ATTENTION! MIMELine here in not in use!
}
type
TBI3= packed array [0..2] of byte;
pBI3= ^TBI3;
TBO4= packed array [0..3] of byte;
pBO4= ^TBO4;
var
i: integer;
pIN: pBI3;
pOUT: pBO4;
TotalIn, TotalOut, TotalINRest: integer;
B32: longword;
begin
TotalIn := length(s);
TotalOut := (TotalIn + 2) div 3 * 4 ;
TotalINRest:= TotalIn - TotalIN div 3 * 3;
SetLength(Result, TotalOut);
pIN := @S[1];
pOUT := @Result[1];
// This variation encode directly form input DWORD
// Start coding
for i := 1 to TotalIn Div 3 do
begin
B32:=pLongWord(pIN)^;
inc(pIN);
pOUT[0] := Codes64[((B32 shr 2) and $3F)];
pOUT[1] := Codes64[((B32 shl 4) and $3F) or ((B32 shr 12) and $0F)];
pOUT[2] := Codes64[((B32 shr 6) and $3C) or ((B32 shr 22) and $03)];
pOUT[3] := Codes64[((B32 shr 16) and $3F)];
inc(pOUT);
end;
if TotalINRest = 1 then
begin
B32:= (pIn[0] shl 4) ;
pOUT[1] := Codes64[ B32 and $3F ]; B32:= B32 shr 6;
pOUT[0] := Codes64[ B32 ];
pOUT[3] := byte('=');
pOUT[2] := byte('=');
end
else
if TotalINRest = 2
then
begin
B32:= ((pIn[0] shl 8) or pIn[1]) shl 2 ;
pOUT[2] := Codes64[ B32 and $3F ]; B32:= B32 shr 6;
pOUT[1] := Codes64[ B32 and $3F ]; B32:= B32 shr 6;
pOUT[0] := Codes64[ B32 ];
pOUT[3] := byte('=');
end
end;
Initialization
SZCodeBaseXSetOrigBufferSize;
end.
>> or maybe there is a compiler directive for that?
I know D2009 has not it, but maybe it appears in D2010/Delphi XE?
I know D2009 has not it, but maybe it appears in D2010/Delphi XE?
when encoding WideString -> Base64 String, that Base64 string is ANSIString.
And when decoding, you have to consider the same : source Base64 is ANSIString, and result is widestring.
So it is not just so simple as to change String into AnsiString. You have to choose which need to be changed.
I have a smaller unit for base64, I've upgraded it for Unicode so that you can either use it or see how to change your own unit. Beware, I haven't tested it (don't have Delphi >2009...)
And when decoding, you have to consider the same : source Base64 is ANSIString, and result is widestring.
So it is not just so simple as to change String into AnsiString. You have to choose which need to be changed.
I have a smaller unit for base64, I've upgraded it for Unicode so that you can either use it or see how to change your own unit. Beware, I haven't tested it (don't have Delphi >2009...)
unit Code64;
interface
function Encode64(S: string): string;
function Decode64(S: string): string;
function Encode64Unicode(S: string): string;
function Decode64Unicode(S: string): string;
implementation
const
Codes64 = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
function Encode64(S: string): string;
var
i: Integer;
a: Integer;
x: Integer;
b: Integer;
begin
Result := '';
a := 0;
b := 0;
for i := 1 to Length(s) do
begin
x := Ord(s[i]);
b := b * 256 + x;
a := a + 8;
while a >= 6 do
begin
a := a - 6;
x := b SHR a;//div (1 shl a);
b := b AND ((1 SHL a)-1); //mod (1 shl a);
Result := Result + Codes64[x + 1];
end;
end;
if a > 0 then
begin
x := b shl (6 - a);
Result := Result + Codes64[x + 1];
end;
end;
function Decode64(S: string): string;
var
i: Integer;
a: Integer;
x: Integer;
b: Integer;
begin
Result := '';
a := 0;
b := 0;
for i := 1 to Length(s) do
begin
x := Pos(s[i], codes64) - 1;
if x >= 0 then
begin
b := b * 64 + x;
a := a + 6;
if a >= 8 then
begin
a := a - 8;
x := b shr a;
b := b AND ((1 SHL a)-1);
Result := Result + chr(x);
end;
end
else
Exit;
end;
end;
function Encode64Unicode(S: WideString): ANSIString;
var
i: Integer;
a: Integer;
x: Integer;
b: Integer;
p : pByte;
l :Integer;
begin
Result := '';
a := 0;
b := 0;
l:=Length(s)*SizeOf(WideChar);
p:=pByte(@s[1]);
for i := 0 to L-1 do
begin
x := p^;
Inc(p);
b := b * 256 + x;
a := a + 8;
while a >= 6 do
begin
a := a - 6;
x := b SHR a;//div (1 shl a);
b := b AND ((1 SHL a)-1); //mod (1 shl a);
Result := Result + Codes64[x + 1];
end;
end;
if a > 0 then
begin
x := b shl (6 - a);
Result := Result + Codes64[x + 1];
end;
end;
function Decode64Unicode(S: ANSIString): WideString;
var
i: Integer;
a: Integer;
x: Integer;
b: Integer;
p : pByte;
begin
Result := '';
a := 0;
b := 0;
SetLength(Result, (length(s)+ 2) div 3 * 4);
p:=pByte(@Result[1]);
for i := 1 to Length(s) do
begin
x := Pos(s[i], codes64) - 1;
if x >= 0 then
begin
b := b * 64 + x;
a := a + 6;
if a >= 8 then
begin
a := a - 8;
x := b shr a;
b := b AND ((1 SHL a)-1);
p^:= x;
Inc(p);
//Result := Result + chr(x);
end;
end
else
Exit;
end;
end;
end.
In your unit, you can note that all overloaded functions that works on memory pointers or stream will work as well as they should. Only the string versions need to be changed.
As such, especially
SZDecodeBaseXString
and
SZEncodeBaseXString
need some fixing, and others that call them to specialize (base 16,32,64)
As such, especially
SZDecodeBaseXString
and
SZEncodeBaseXString
need some fixing, and others that call them to specialize (base 16,32,64)
function SZDecodeBaseXString(const S: ANSIString; const Codes: String; BITS: integer): WideString;
var
TotalIn : integer;
TotalOut : integer;
pIN,pOUT: pByte;
begin
TotalIn := length(S);
TotalOut := (TotalIn * BITS) shr 3; // div 8;
Setlength(Result,(TotalOut+1) Div 2);
pIN := @S[1];
pOUT := @Result[1];
TotalOut:=SZDecodeBaseXMemory( pIN, pOUT, TotalIn, Codes, BITS);
if length(Result)<> TotalOut then
Setlength(Result,TotalOut);
end;
function SZEncodeBaseXString(const S: WideString; const Codes: string; BITS: integer; FullQuantum : integer ; MIMELine : integer): ANSIString;
// Universal Encode algorithm for Base16, Base32 and Base64
var
pIN, pOUT: pByte;
TotalIn, TotalOut: integer;
IM: integer;
LOut: integer;
begin
TotalIn := length(S)*SizeOf(WideChar);
// Calculate relevant data
GetRelevantData(TotalIn, TotalOut, BITS, FullQuantum, IM, MIMELine);
SetLength(Result,TotalOut);
pIN :=@S[1];
pOUT:=@Result[1];
LOut:=SZEncodeBaseXMemory(pIn,pOut, TotalIn, Codes, BITS, FullQuantum, MIMELine);
if Lout<>TotalOut then
SetLength(Result,LOut);
end;
function SZDecodeBase64(const S: ANSIString): WideString; overload;
begin
Result:=SZDecodeBaseXString(S, SZCodes64, SZBITS64)
end;
function SZEncodeBase64(const S: WideString; MIMELine: integer = 0): ANSIString; overload;
begin
Result:=SZEncodeBaseXString(S, SZCodes64, SZBITS64, SZFullQuantum0, MIMELine)
end;
Hey, thanks both for reply!
But then, the final conclusion is that for "Arabic, Chineses characters" there is not support?
Example, i can convert to base64 only ANSI characters and not UTF-8(Unicode) characters?
Both examples works perfectly, but i tried to encode and decode arabic chars and of course, returning AnsiString will lost data (wide chars) hehe
But then, the final conclusion is that for "Arabic, Chineses characters" there is not support?
Example, i can convert to base64 only ANSI characters and not UTF-8(Unicode) characters?
Both examples works perfectly, but i tried to encode and decode arabic chars and of course, returning AnsiString will lost data (wide chars) hehe
no, my functions should be able to encode unicode to b64(ansi) and back to unicode. i am gone now and cannot check. aflarin code do have the restriction you are talking about because he did not mix ansi & wide strings (he used ansi everywhere)
>> Only the string versions need to be changed.
I don't think so. If you changed those - What will you do if the encoded text was ANSI? You decoded unicode string will contain rubbish.
So, if you would like to modify the original code, you can ADD new epasquier's functions. Then you will have two ones:
// original
// if your encoded string is ANSI
function SZDecodeBaseXString(const S: ANSIString; const Codes: AnsiString; BITS: integer): AnsiString;
// epasquier's function
// if your encoded string is UNICODE
function SZDecodeBaseXStringW(const
// amd the same for Base64, Base32, Base16
But then it would be worse if they duplicate code. It would be better if the Unicode function will call Ansi function. In addition it will be shorter:
function SZDecodeBaseXStringW(const
begin
Result:= RawByteString( SZDecodeBaseXStringW(S, Codes, BITS) );
end;
But you can manage your encoded unicode string ("Arabic, Chineses characters") without adding Unicode functions, like this:
procedure TForm1.Button2Click(Sender
var
original: WideString;
encoded: AnsiString;
decoded: WideString;
begin
// Test unicode string
original:= 'You can write here your Arabic, Chineses characters';
{ encoding }
// Result is AnsiString
encoded:= SzFullEncodeBase64( RawByteString(original) );
{ decoding }
// SzDecodeBase64 returns AnsiString, but it really contains Unicode, so we save it to Unicode variable
decoded:= RawByteString( SzDecodeBase64( encoded ) );
{ testing }
ShowMessage( decoded );
end;
I don't think so. If you changed those - What will you do if the encoded text was ANSI? You decoded unicode string will contain rubbish.
So, if you would like to modify the original code, you can ADD new epasquier's functions. Then you will have two ones:
// original
// if your encoded string is ANSI
function SZDecodeBaseXString(const S: ANSIString; const Codes: AnsiString; BITS: integer): AnsiString;
// epasquier's function
// if your encoded string is UNICODE
function SZDecodeBaseXStringW(const
// amd the same for Base64, Base32, Base16
But then it would be worse if they duplicate code. It would be better if the Unicode function will call Ansi function. In addition it will be shorter:
function SZDecodeBaseXStringW(const
begin
Result:= RawByteString( SZDecodeBaseXStringW(S, Codes, BITS) );
end;
But you can manage your encoded unicode string ("Arabic, Chineses characters") without adding Unicode functions, like this:
procedure TForm1.Button2Click(Sender
var
original: WideString;
encoded: AnsiString;
decoded: WideString;
begin
// Test unicode string
original:= 'You can write here your Arabic, Chineses characters';
{ encoding }
// Result is AnsiString
encoded:= SzFullEncodeBase64( RawByteString(original) );
{ decoding }
// SzDecodeBase64 returns AnsiString, but it really contains Unicode, so we save it to Unicode variable
decoded:= RawByteString( SzDecodeBase64( encoded ) );
{ testing }
ShowMessage( decoded );
end;
> I don't think so. If you changed those - What will you do if the encoded text was ANSI?
> You decoded unicode string will contain rubbish.
No, if you call a function needing unicode parameter with an ANSI string, Delphi will first convert the ANSI string with its Unicode equivalent. Then the encoding would work and produce an ANSI string (twice the size of the one that an encoding function working with ANSI param would) and then the decode would produce again the same Unicode string that Delphi converted. And if you copy that to an ANSIString variable, you will get the original ANSI string, without problems. But yes, it is better to have 2 set of functions to avoid unnecessary conversions
> You decoded unicode string will contain rubbish.
No, if you call a function needing unicode parameter with an ANSI string, Delphi will first convert the ANSI string with its Unicode equivalent. Then the encoding would work and produce an ANSI string (twice the size of the one that an encoding function working with ANSI param would) and then the decode would produce again the same Unicode string that Delphi converted. And if you copy that to an ANSIString variable, you will get the original ANSI string, without problems. But yes, it is better to have 2 set of functions to avoid unnecessary conversions
Featured Post
Did you know SD-WANs can improve network connectivity? Check out this webinar to learn how an SD-WAN simplified, one-click tool can help you migrate and manage data in the cloud.
Question has a verified solution.
If you are experiencing a similar issue, please ask a related question
Objective:
- This article will help user in how to convert their numeric value become words.
How to use
1. You can copy this code in your Unit as function
2. than you can perform your function by type this code
The Code
Â
(CODE)
The Im…
Introduction
Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview. I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
Monitoring a network: how to monitor network services and why? Michael Kulchisky, MCSE, MCSA, MCP, VTSP, VSP, CCSP outlines the philosophy behind service monitoring and why a handshake validation is critical in network monitoring. Software utilized …
In this video, Percona Solution Engineer Dimitri Vanoverbeke discusses why you want to use at least three nodes in a database cluster.
To discuss how Percona Consulting can help with your design and architecture needs for your database and infras…
Suggested Courses
Course of the Month5 days, 11 hours left to enroll
660 members asked questions and received personalized solutions in the past 7 days.
Join the community of 500,000 technology professionals and ask your questions.