string to base64Binary

Mesaj gönderen **m_ekici** » 30 Nis 2014 12:56

merhaba arkadaşlar

XML içerindeki base64binary olan alana string değeri encode ederek aktarmam lazım.
embarcadero desteğinde aşağıdaki kodu buldum. fakat bu kodun çevirdiği ile Visual studiodaki base64binary çevrimi farklı. Buradaki sorun ne olabilir?

Kod: Tümünü seç

function TDBF.StringToByteDynArray(const Value:string): TByteDynArray;
var
  ValLength : longint;
begin
  ValLength := Length(Value);
  SetLength(Result, ValLength);
  Move(Pointer(Value)^, Pointer(Result)^, ValLength);
end;

Mesaj gönderen **vkamadan** » 30 Nis 2014 01:25

Merhaba ,
String veriyi Base64 olarak encode etmek için kullandığım yapı aşağıdaki gibidir,

Kod: Tümünü seç

function CalcEncodedSize(InSize: DWord): DWord;
begin
   Result := (InSize div 3) shl 2;
  if (InSize mod 3) > 0 then
    Inc(Result, 4);
end;

procedure Base64Encode(const InBuffer; InSize: DWord;
  var OutBuffer);
var
  X: Integer;
  PIn, POut: TPAByte;
  Acc: Cardinal;
begin
  if InSize > 0 then
  begin
    PIn := @InBuffer;
    POut := @OutBuffer;

    for X := 1 to InSize div 3 do
    begin
      Acc := PIn^[0] shl 16 + PIn^[1] shl 8 + PIn^[2];

      POut^[0] := Byte(cBase64Codec[(Acc shr 18) and $3f]);
      POut^[1] := Byte(cBase64Codec[(Acc shr 12) and $3f]);
      POut^[2] := Byte(cBase64Codec[(Acc shr 6 ) and $3f]);
      POut^[3] := Byte(cBase64Codec[(Acc       ) and $3f]);

      Inc(Cardinal(POut), 4);
      Inc(Cardinal(PIn),  3);
    end;
    case InSize mod 3 of
      1 :
      begin
        Acc := PIn^[0] shl 16;

        POut^[0] := Byte(cBase64Codec[(Acc shr 18) and $3f]);
        POut^[1] := Byte(cBase64Codec[(Acc shr 12) and $3f]);
        POut^[2] := Byte(Base64Filler);
        POut^[3] := Byte(Base64Filler);
      end;
      2 :
      begin
        Acc := PIn^[0] shl 16 + PIn^[1] shl 8;

        POut^[0] := Byte(cBase64Codec[(Acc shr 18) and $3f]);
        POut^[1] := Byte(cBase64Codec[(Acc shr 12) and $3f]);
        POut^[2] := Byte(cBase64Codec[(Acc shr 6 ) and $3f]);
        POut^[3] := Byte(Base64Filler);
      end;
    end;
  end;
end;

procedure Base64EncodeStr(const InText: AnsiString;
  var OutText: AnsiString);
var
  InSize, OutSize: DWord;
  PIn, POut: Pointer;
begin
  // get size of source
  InSize := Length(InText);
  // calculate size for destination
  OutSize := CalcEncodedSize(InSize);

  // prepare AnsiString length to fit result data
  SetLength(OutText, OutSize);

  if OutSize > 0 then
  begin
    PIn := @InText[1];
    POut := @OutText[1];

    // encode !
    Base64Encode(PIn^, InSize, POut^);
  end;
end;

function Base64EncodeString(const InText: AnsiString): AnsiString;
begin
    Base64EncodeStr(InText, Result);
end;

function Base64EncodeToString(const InBuffer;
  InSize: DWord): AnsiString;
var
  POut: Pointer;
begin
  SetLength(Result, CalcEncodedSize(InSize));
  POut := @Result[1];
  Base64Encode(InBuffer, InSize, POut^);
end;

Burada kullanmanız gereken fonksiyon Base64EncodeString fonksiyonudur , parametre geçeceğiniz sting i base64 olarak geri verir ,

Kolay gelsin.

Mesaj gönderen **m_ekici** » 30 Nis 2014 01:50

base64 değil de base64binary e çevirmem lazım.
tanım aşağıdaki gibi bunu nasıl hallederim?

EVRAKLAR = class(TRemotable)
private
FHEADER: HEADER;
FHEADER_Specified: boolean;
FCONTENT: base64Binary;
FCONTENT_Specified: boolean;
....
procedure SetHEADER(Index: Integer; const AHEADER: HEADER);
function HEADER_Specified(Index: Integer): boolean;
procedure SetCONTENT(Index: Integer; const Abase64Binary: base64Binary);
function CONTENT_Specified(Index: Integer): boolean;
public
destructor Destroy; override;
published
.....
property CONTENT: base64Binary
.....

Mesaj gönderen **vkamadan** » 30 Nis 2014 01:54

siz importer in oluşturduğu interface içindeki base64binary tipini String olarak değiştirin ve verdiğim fonksiyon elde edeceğiniz veriyi böyle göndermeyi deneyin (FCONTENT:String)

Mesaj gönderen **m_ekici** » 30 Nis 2014 02:27

TPAByte;
@InBuffer;
@OutBuffer;
cBase64Codec;

bunlar nedir?

Mesaj gönderen **vkamadan** » 30 Nis 2014 02:32

Kusura bakmayın , eksik oldu ,

Kod: Tümünü seç

const
 cBase64Codec: array[0..63] of AnsiChar =
    'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
  Base64Filler: AnsiChar = '=';
 type
  TAByte = array[0..MaxInt - 1] of Byte;
  TPAByte = ^TAByte;

Mesaj gönderen **m_ekici** » 30 Nis 2014 03:40

İlgine Tşk. Ederim ama çevirdiğim kodu (XML hatalı diyor) tanımıyor.

Mesaj gönderen **vkamadan** » 02 May 2014 11:51

Merhaba ,
Peki şöyle bir şey deneyebilirmisiniz,
viewtopic.php?f=2&t=32321&p=174483#p174483

Bu adreste Dosyaları ByteDynArray e çevirme örneği mevcut, elinizdeki stringli geçici bir dosyaya atıp dosyayı ByteDynArray e çevirip göndererek sonuca ulaşmayı denermisiniz.

Mesaj gönderen **m_ekici** » 02 May 2014 01:45

Merhaba
Memoda kayıtlı text (AMemo) alanı sıra ile

Memo1.Lines.Text := EncdDecd.EncodeString(AMemo.Text); // encode ediliyor
Memo4.Lines.Text := DecodeString(Memo1.lines.Text); // decoe ediliyor ilk texte düzgün çevrriliyor.

Memo2.Lines.Text := Base64EncodeString(AMemo.Lines.Text); // base64 encode yapılıyor
Memo3.Lines.Text:=Base64DecodeString(Memo2.Lines.Text); // text .................. şekline dönüyor

Mesaj gönderen **m_ekici** » 02 May 2014 02:08

Base64Encode ile EncodeString aynı çevrimi yapıyor. Doğrumudur? bu komutlar çalışırken base64 de biraz daha bekliyor. ama encode edilen textler aynı sadece encodestring de satırsonları var.

Mesaj gönderen **vkamadan** » 02 May 2014 02:12

Merhaba,
EncdDecd.EncodeString
hakkında bir fikrim yok, aynı işi yapıp yapmadıklarını bilemiyorum aynı işi yapıyorlar sa ikisi de aynı sonucu döndürüyor olmalı,

Mesaj gönderen **m_ekici** » 02 May 2014 03:19

Ne çevirmeymiş beeeee

Başkası da benim kadar uğraşmasın
Text --> encode
encode -- text
text --> base64
base64 -->text
text--->base64binary+encode
decode+base64binary ---->text çevrimlerini yapabilirsiniz.

Encodemenu.pas

Kod: Tümünü seç

unit EnCodeMenu;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  cxLabel, base64, Types, cxGraphics, cxControls, cxLookAndFeels, Forms,
  cxLookAndFeelPainters, cxContainer, cxEdit, Vcl.Controls, Vcl.StdCtrls, EncdDecd;


type
  TForm5 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Button2: TButton;
    Memo2: TMemo;
    AMemo: TMemo;
    Button3: TButton;
    Memo3: TMemo;
    Button4: TButton;
    Memo4: TMemo;
    Button5: TButton;
    Memo5: TMemo;
    cxLabel1: TcxLabel;
    cxLabel2: TcxLabel;
    cxLabel3: TcxLabel;
    cxLabel4: TcxLabel;
    cxLabel5: TcxLabel;
    Button6: TButton;
    Memo6: TMemo;
    Button7: TButton;
    Memo7: TMemo;
    cxLabel7: TcxLabel;
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
  private
    function StringToByteDynArray(const Value:widestring): TByteDynArray;
    function ByteDynArrayToString(const Value:TByteDynArray): widestring;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form5: TForm5;
const
  SSon = #13;
  cBase64Codec: array[0..63] of AnsiChar = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
  Base64Filler: AnsiChar = '=';
type
  TAByte = array[0..MaxInt - 1] of Byte;
  TPAByte = ^TAByte;

implementation

{$R *.dfm}

procedure TForm5.Button1Click(Sender: TObject);
var
A, B : AnsiString;
begin // AMemo daki texti memo1 e encode ederek aktarıyor.
A:= AnsiString(AMemo.Lines.Text);
B:=EncdDecd.EncodeString(A);
Memo1.Lines.Text := B;
end;

procedure TForm5.Button2Click(Sender: TObject);
var
A, B : AnsiString;
begin  // AMemo daki text i Memo2 ye base64encode uygulayarak aktarıyor
A:= AnsiString(AMemo.Lines.Text);
base64.Base64Encode(A, B);
Memo2.Lines.Text := B;
end;

procedure TForm5.Button3Click(Sender: TObject);
var
A, B : AnsiString;
begin // Memo 2 deki base64encode uygulanmış text i memo3 e decode uygulayarak açıyor.
A:= AnsiString(Memo2.Lines.Text);
base64.Base64Decode(A, B);
Memo3.Lines.Text := B;
end;

procedure TForm5.Button4Click(Sender: TObject);
begin // Memo 1 teki encodlu text i memo4 e decode yapıyor.
Memo4.Lines.Text := DecodeString(Memo1.lines.Text);
end;

procedure TForm5.Button5Click(Sender: TObject);
var
A, B : AnsiString;
begin
A:= AnsiString(Memo7.Lines.Text);
base64.Base64Decode(A, B);
Memo5.Lines.Text := B;
end;

procedure TForm5.Button6Click(Sender: TObject);
var
A, B,C: AnsiString;
barray: TByteDynArray;
begin // AMemo daki text i önce encode sonra base64binary ye aktarıyor
A:= AnsiString(AMemo.Lines.Text);
B:=EncdDecd.EncodeString(A);
barray:= StringToByteDynArray(B);
// base64binary de encode edilerek tutulan text i önce text e aktarıyor sonra decode ile açıyor
C := ByteDynArrayToString(barray);
Memo7.Lines.Text := DecodeString(C);
end;

function TForm5.StringToByteDynArray(const Value:widestring): TByteDynArray;
var
  ValLength : longint;
begin
  ValLength := Length(Value);
  SetLength(Result, ValLength);
  Move(Pointer(Value)^, Pointer(Result)^, ValLength);
end;

function TForm5.ByteDynArrayToString(const Value:TByteDynArray): widestring;
var
  ValLength : longint;
begin
  ValLength := Length(Value);
  SetLength(Result, ValLength);
  Move(Pointer(Value)^, Pointer(Result)^, ValLength);
end;

end.

encodemenu.dfm

Kod: Tümünü seç

object Form5: TForm5
  Left = 0
  Top = 0
  Caption = 'Text Kod '#199'evrimleri'
  ClientHeight = 784
  ClientWidth = 1036
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -13
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 120
  TextHeight = 16
  object Button1: TButton
    Left = 8
    Top = 204
    Width = 113
    Height = 25
    Caption = 'Text > Encode'
    TabOrder = 0
    OnClick = Button1Click
  end
  object Memo1: TMemo
    Left = 8
    Top = 235
    Width = 493
    Height = 161
    TabOrder = 1
  end
  object Button2: TButton
    Left = 8
    Top = 400
    Width = 113
    Height = 25
    Caption = 'Text > Base64'
    TabOrder = 2
    OnClick = Button2Click
  end
  object Memo2: TMemo
    Left = 8
    Top = 432
    Width = 493
    Height = 161
    TabOrder = 3
  end
  object AMemo: TMemo
    Left = 8
    Top = 8
    Width = 493
    Height = 161
    Lines.Strings = (
      '<?xml version="1.0" encoding="ISO-8859-9"?>'
      '<ARP_VOUCHERS>'
      '  <ARP_VOUCHER DBOP="INS" >'
      '    <NUMBER>0000000000000002</NUMBER>'
      '    <DATE>04.04.2014</DATE>'
      '    <TYPE>70</TYPE>'
      '    <TOTAL_CREDIT>5000</TOTAL_CREDIT>'
      '    <RC_TOTAL_CREDIT>5000</RC_TOTAL_CREDIT>'
      '    <CREATED_BY>1</CREATED_BY>'
      '    <DATE_CREATED>04.04.2014</DATE_CREATED>'
      '    <HOUR_CREATED>10</HOUR_CREATED>'
      '    <MIN_CREATED>28</MIN_CREATED>'
      '    <SEC_CREATED>49</SEC_CREATED>'
      '    <CURRSEL_TOTALS>3</CURRSEL_TOTALS>'
      '    <DATA_REFERENCE>1002</DATA_REFERENCE>'
      '        </PAYMENT_LIST>'
      '        <DATA_REFERENCE>1027</DATA_REFERENCE>'
      '        <MONTH>4</MONTH>'
      '        <YEAR>2014</YEAR>'
      '        <AFFECT_RISK>0</AFFECT_RISK>'
      '        <ORGLOGOID></ORGLOGOID>'
      '        <BANKACC_CODE>001   01</BANKACC_CODE>'
      '      </TRANSACTION>'
      '    </TRANSACTIONS>'
      '    <ARP_CODE>0007</ARP_CODE>'
      '    <TIME>169484055</TIME>'
      '    <AFFECT_RISK>0</AFFECT_RISK>'
      '  </ARP_VOUCHER>'
      '</ARP_VOUCHERS>')
    TabOrder = 4
  end
  object Button3: TButton
    Left = 528
    Top = 401
    Width = 113
    Height = 25
    Caption = 'Base64 > Text'
    TabOrder = 5
    OnClick = Button3Click
  end
  object Memo3: TMemo
    Left = 528
    Top = 432
    Width = 493
    Height = 161
    TabOrder = 6
  end
  object Button4: TButton
    Left = 528
    Top = 204
    Width = 113
    Height = 25
    Caption = 'Decode > Text'
    TabOrder = 7
    OnClick = Button4Click
  end
  object Memo4: TMemo
    Left = 528
    Top = 235
    Width = 493
    Height = 161
    TabOrder = 8
  end
  object Button5: TButton
    Left = 528
    Top = 8
    Width = 113
    Height = 25
    Caption = 'Decode > Text'
    TabOrder = 9
    OnClick = Button5Click
  end
  object Memo5: TMemo
    Left = 528
    Top = 39
    Width = 493
    Height = 161
    TabOrder = 10
  end
  object cxLabel1: TcxLabel
    Left = 127
    Top = 208
    Caption = 'VVV'
  end
  object cxLabel2: TcxLabel
    Left = 127
    Top = 406
    Caption = 'VVV'
  end
  object cxLabel3: TcxLabel
    Left = 507
    Top = 454
    Caption = '>'
  end
  object cxLabel4: TcxLabel
    Left = 663
    Top = 406
    Caption = '^^^'
  end
  object cxLabel5: TcxLabel
    Left = 663
    Top = 209
    Caption = '^^^'
  end
  object Button6: TButton
    Left = 8
    Top = 601
    Width = 161
    Height = 25
    Caption = 'Text > Base64binary'
    TabOrder = 16
    OnClick = Button6Click
  end
  object Memo6: TMemo
    Left = 8
    Top = 632
    Width = 493
    Height = 161
    TabOrder = 17
  end
  object Button7: TButton
    Left = 528
    Top = 601
    Width = 161
    Height = 25
    Caption = 'Base64binary > Text'
    TabOrder = 18
  end
  object Memo7: TMemo
    Left = 528
    Top = 632
    Width = 493
    Height = 161
    TabOrder = 19
  end
  object cxLabel7: TcxLabel
    Left = 507
    Top = 654
    Caption = '>'
  end
end

EncdDecd.pas

Kod: Tümünü seç

{*******************************************************}
{                                                       }
{                Delphi Runtime Library                 }
{                                                       }
{ Copyright(c) 1995-2011 Embarcadero Technologies, Inc. }
{                                                       }
{*******************************************************}

unit Soap.EncdDecd;

interface

uses System.Classes, System.SysUtils;

procedure EncodeStream(Input, Output: TStream);
procedure DecodeStream(Input, Output: TStream);
function  EncodeString(const Input: string): string;
function  DecodeString(const Input: string): string;

function  DecodeBase64(const Input: AnsiString): TBytes;
function  EncodeBase64(const Input: Pointer; Size: Integer): AnsiString;

implementation

uses System.RTLConsts;

const
  EncodeTable: array[0..63] of AnsiChar =
    AnsiString('ABCDEFGHIJKLMNOPQRSTUVWXYZ') +
    AnsiString('abcdefghijklmnopqrstuvwxyz') +
    AnsiString('0123456789+/');

  DecodeTable: array[#0..#127] of Integer = (
    Byte('='), 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64,
           64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64,
           64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 62, 64, 64, 64, 63,
           52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 64, 64, 64, 64, 64, 64,
           64,  0,  1,  2,  3,  4,  5,  6,  7,  8,  9, 10, 11, 12, 13, 14,
           15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 64, 64, 64, 64, 64,
           64, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40,
           41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 64, 64, 64, 64, 64);

type
  PPacket = ^TPacket;
  TPacket = packed record
    case Integer of
      0: (b0, b1, b2, b3: Byte);
      1: (i: Integer);
      2: (a: array[0..3] of Byte);
      3: (c: array[0..3] of AnsiChar);
  end;

  TPointerStream = class(TCustomMemoryStream)
  public
    constructor Create(P: Pointer; Size: Integer);
    function Write(const Buffer; Count: Longint): Longint; override;
  end;

procedure EncodePacket(const Packet: TPacket; NumChars: Integer; OutBuf: PAnsiChar);
begin
  OutBuf[0] := EnCodeTable[Packet.a[0] shr 2];
  OutBuf[1] := EnCodeTable[((Packet.a[0] shl 4) or (Packet.a[1] shr 4)) and $0000003f];
  if NumChars < 2 then
    OutBuf[2] := '='
  else OutBuf[2] := EnCodeTable[((Packet.a[1] shl 2) or (Packet.a[2] shr 6)) and $0000003f];
  if NumChars < 3 then
    OutBuf[3] := '='
  else OutBuf[3] := EnCodeTable[Packet.a[2] and $0000003f];
end;

function DecodePacket(InBuf: PAnsiChar; var nChars: Integer): TPacket;
begin
  Result.a[0] := (DecodeTable[InBuf[0]] shl 2) or
    (DecodeTable[InBuf[1]] shr 4);
  NChars := 1;
  if InBuf[2] <> '=' then
  begin
    Inc(NChars);
    Result.a[1] := Byte((DecodeTable[InBuf[1]] shl 4) or (DecodeTable[InBuf[2]] shr 2));
  end;
  if InBuf[3] <> '=' then
  begin
    Inc(NChars);
    Result.a[2] := Byte((DecodeTable[InBuf[2]] shl 6) or DecodeTable[InBuf[3]]);
  end;
end;

procedure EncodeStream(Input, Output: TStream);
type
  PInteger = ^Integer;
var
  InBuf: array[0..509] of Byte;
  OutBuf: array[0..1023] of AnsiChar;
  BufPtr: PAnsiChar;
  I, J, K, BytesRead: Integer;
  Packet: TPacket;
begin
  K := 0;
  repeat
    BytesRead := Input.Read(InBuf, SizeOf(InBuf));
    I := 0;
    BufPtr := OutBuf;
    while I < BytesRead do
    begin
      if BytesRead - I < 3 then
        J := BytesRead - I
      else J := 3;
      Packet.i := 0;
      Packet.b0 := InBuf[I];
      if J > 1 then
        Packet.b1 := InBuf[I + 1];
      if J > 2 then
        Packet.b2 := InBuf[I + 2];
      EncodePacket(Packet, J, BufPtr);
      Inc(I, 3);
      Inc(BufPtr, 4);
      Inc(K, 4);
      if K > 75 then
      begin
        BufPtr[0] := #$0D;
        BufPtr[1] := #$0A;
        Inc(BufPtr, 2);
        K := 0;
      end;
    end;
    Output.Write(Outbuf, BufPtr - PChar(@OutBuf));
  until BytesRead = 0;
end;

procedure DecodeStream(Input, Output: TStream);
var
  InBuf: array[0..75] of AnsiChar;
  OutBuf: array[0..60] of Byte;
  InBufPtr, OutBufPtr: PAnsiChar;
  I, J, K, BytesRead: Integer;
  Packet: TPacket;

  procedure SkipWhite;
  var
    C: AnsiChar;
    NumRead: Integer;
  begin
    while True do
    begin
      NumRead := Input.Read(C, 1);
      if NumRead = 1 then
      begin
        if C in ['0'..'9','A'..'Z','a'..'z','+','/','='] then
        begin
          Input.Position := Input.Position - 1;
          Break;
        end;
      end else Break;
    end;
  end;

  function ReadInput: Integer;
  var
    WhiteFound, EndReached : Boolean;
    CntRead, Idx, IdxEnd: Integer;
  begin
    IdxEnd:= 0;
    repeat
      WhiteFound := False;
      CntRead := Input.Read(InBuf[IdxEnd], (SizeOf(InBuf)-IdxEnd));
      EndReached := CntRead < (SizeOf(InBuf)-IdxEnd);
      Idx := IdxEnd;
      IdxEnd := CntRead + IdxEnd;
      while (Idx < IdxEnd) do
      begin
        if not (InBuf[Idx] in ['0'..'9','A'..'Z','a'..'z','+','/','=']) then
        begin
          Dec(IdxEnd);
          if Idx < IdxEnd then
            Move(InBuf[Idx+1], InBuf[Idx], IdxEnd-Idx);
          WhiteFound := True;
        end
        else
          Inc(Idx);
      end;
    until (not WhiteFound) or (EndReached);
    Result := IdxEnd;
  end;

begin
  repeat
    SkipWhite;
    BytesRead := ReadInput;
    InBufPtr := InBuf;
    OutBufPtr := @OutBuf;
    I := 0;
    while I < BytesRead do
    begin
      Packet := DecodePacket(InBufPtr, J);
      K := 0;
      while J > 0 do
      begin
        OutBufPtr^ := AnsiChar(Packet.a[K]);
        Inc(OutBufPtr);
        Dec(J);
        Inc(K);
      end;
      Inc(InBufPtr, 4);
      Inc(I, 4);
    end;
    Output.Write(OutBuf, OutBufPtr - PAnsiChar(@OutBuf));
  until BytesRead = 0;
end;

function EncodeString(const Input: string): string;
var
  InStr, OutStr: TStringStream;
begin
  InStr := TStringStream.Create(Input);
  try
    OutStr := TStringStream.Create('');
    try
      EncodeStream(InStr, OutStr);
      Result := OutStr.DataString;
    finally
      OutStr.Free;
    end;
  finally
    InStr.Free;
  end;
end;

function DecodeString(const Input: string): string;
var
  InStr, OutStr: TStringStream;
begin
  InStr := TStringStream.Create(Input);
  try
    OutStr := TStringStream.Create('');
    try
      DecodeStream(InStr, OutStr);
      Result := OutStr.DataString;
    finally
      OutStr.Free;
    end;
  finally
    InStr.Free;
  end;
end;

constructor TPointerStream.Create(P: Pointer; Size: Integer);
begin
  SetPointer(P, Size);
end;

function TPointerStream.Write(const Buffer; Count: Longint): Longint;
var
  Pos, EndPos, Size: Longint;
  Mem: Pointer;
begin
  Pos := Self.Position;

  if (Pos >= 0) and (Count > 0) then
  begin
    EndPos := Pos + Count;
    Size:= Self.Size;
    if EndPos > Size then
      raise EStreamError.CreateRes(@SMemoryStreamError);

    Mem := Self.Memory;
    System.Move(Buffer, Pointer(Longint(Mem) + Pos)^, Count);
    Self.Position := Pos;
    Result := Count;
    Exit;
  end;
  Result := 0;
end;

function DecodeBase64(const Input: AnsiString): TBytes;
var
  InStr: TPointerStream;
  OutStr: TBytesStream;
  Len: Integer;
begin
  InStr := TPointerStream.Create(PAnsiChar(Input), Length(Input));
  try
    OutStr := TBytesStream.Create;
    try
      DecodeStream(InStr, OutStr);
      Result := OutStr.Bytes;
      Len := OutStr.Size;
    finally
      OutStr.Free;
    end;
  finally
    InStr.Free;
  end;
  SetLength(Result, Len);
end;

function EncodeBase64(const Input: Pointer; Size: Integer): AnsiString;
var
  InStr: TPointerStream;
  OutStr: TBytesStream;
begin  
  InStr := TPointerStream.Create(Input, Size);
  try
    OutStr := TBytesStream.Create;
    try
      EncodeStream(InStr, OutStr);
      SetString(Result, PAnsiChar(OutStr.Memory), OutStr.Size);
    finally
      OutStr.Free;
    end;
  finally
    InStr.Free;
  end;
end;


end.

base64.pas

Kod: Tümünü seç

unit Base64;

{$O+}

interface

// !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// !! THE COMPILER SWITCH MAY BE USED TO ADJUST THE BEHAVIOR !!
// !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

// enable "SpeedDecode"
// the switch to gain speed while decoding the message, however, the codec
// will raise different exceptions/access violations or invalid output if
// the incoming data is invalid or missized.

// disable "SpeedDecode"
// the switch to enable a data check, that will scan the data to decode to
// be valid. This method is to be used if you cannot guarantee to validity
// of the data to be decoded.

{.DEFINE SpeedDecode}

{$IFNDEF SpeedDecode}
{$DEFINE ValidityCheck}
{$ENDIF}


uses SysUtils;


// bestimmt die Größe der Base64-Darstellung
function CalcEncodedSize(InSize: Cardinal): Cardinal;
// bestimmt die Größe der binären Darstellung
function CalcDecodedSize(const InBuffer; InSize: Cardinal): Cardinal;

// codiert einen Buffer in die zugehörige Base64-Darstellung
procedure Base64Encode(const InBuffer; InSize: Cardinal; var OutBuffer); overload; register;
// decodiert die Base64-Darstellung in einen Buffer
{$IFDEF SpeedDecode}
procedure Base64Decode(const InBuffer; InSize: Cardinal; var OutBuffer); overload; register;
{$ENDIF}
{$IFDEF ValidityCheck}
function Base64Decode(const InBuffer; InSize: Cardinal; var OutBuffer): Boolean; overload; register;
{$ENDIF}

// codiert einen String in die zugehörige Base64-Darstellung
procedure Base64Encode(const InText: PAnsiChar; var OutText: PChar); overload;
// decodiert die Base64-Darstellung eines Strings in den zugehörigen String
procedure Base64Decode(const InText: PAnsiChar; var OutText: PChar); overload;

// codiert einen String in die zugehörige Base64-Darstellung
procedure Base64Encode(const InText: AnsiString; var OutText: AnsiString); overload;
// decodiert die Base64-Darstellung eines Strings in den zugehörigen String
procedure Base64Decode(const InText: AnsiString; var OutText: AnsiString); overload;


implementation

const
cBase64Codec: array[0..63] of AnsiChar =
'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
Base64Filler = '=';

function Base64Encode(const InText: string): string; overload;
begin
Result := Base64Encode(InText);
end;

function Base64Decode(const InText: string): string; overload;
begin
Result := Base64Decode(InText);
end;

function CalcEncodedSize(InSize: Cardinal): Cardinal;
begin
// no buffers passed along, calculate outbuffer size needed
Result := (InSize div 3) shl 2;
if ((InSize mod 3) > 0)
then Inc(Result, 4);
end;

function CalcDecodedSize(const InBuffer; InSize: Cardinal): Cardinal;
type
BA = array of Byte;
begin
Result := 0;
if InSize = 0 then
Exit;
if InSize mod 4 <> 0 then
Exit;
Result := InSize div 4 * 3;
if (BA(InBuffer)[InSize - 2] = Ord(Base64Filler))
then Dec(Result, 2)
else if BA(InBuffer)[InSize - 1] = Ord(Base64Filler)
then Dec(Result);
end;

procedure Base64Encode(const InBuffer; InSize: Cardinal; var OutBuffer
); register;
var
ByThrees, LeftOver: Cardinal;
// reset in- and outbytes positions
asm
// load addresses for source and destination
// PBYTE(InBuffer);
mov ESI, [EAX]
// PBYTE(OutBuffer);
mov EDI, [ECX]
// ByThrees := InSize div 3;
// LeftOver := InSize mod 3;
// load InSize (stored in EBX)
mov EAX, EBX
// load 3
mov ECX, $03
// clear upper 32 bits
xor EDX, EDX
// divide by ECX
div ECX
// save result
mov ByThrees, EAX
// save remainder
mov LeftOver, EDX
// load addresses
lea ECX, cBase64Codec[0]
// while I < ByThrees do
// begin
xor EAX, EAX
xor EBX, EBX
xor EDX, EDX
cmp ByThrees, 0
jz @@LeftOver
@@LoopStart:
// load the first two bytes of the source triplet
LODSW
// write Bits 0..5 to destination
mov BL, AL
shr BL, 2
mov DL, BYTE PTR [ECX + EBX]
// save the Bits 12..15 for later use [1]
mov BH, AH
and BH, $0F
// save Bits 6..11
rol AX, 4
and AX, $3F
mov DH, BYTE PTR [ECX + EAX]
mov AX, DX
// store the first two bytes of the destination quadruple
STOSW
// laod last byte (Bits 16..23) of the source triplet
LODSB
// extend bits 12..15 [1] with Bits 16..17 and save them
mov BL, AL
shr BX, 6
mov DL, BYTE PTR [ECX + EBX]
// save bits 18..23
and AL, $3F
xor AH, AH
mov DH, BYTE PTR [ECX + EAX]
mov AX, DX
// store the last two bytes of the destination quadruple
STOSW
dec ByThrees
jnz @@LoopStart
@@LeftOver:
// there are up to two more bytes to encode
cmp LeftOver, 0
jz @@Done
// clear result
xor EAX, EAX
xor EBX, EBX
xor EDX, EDX
// get left over 1
LODSB
// load the first six bits
shl AX, 6
mov BL, AH
// save them
mov DL, BYTE PTR [ECX + EBX]
// another byte ?
dec LeftOver
jz @@SaveOne
// save remaining two bits
shl AX, 2
and AH, $03
// get left over 2
LODSB
// load next 4 bits
shl AX, 4
mov BL, AH
// save all 6 bits
mov DH, BYTE PTR [ECX + EBX]
shl EDX, 16
// save last 4 bits
shr AL, 2
mov BL, AL
// save them
mov DL, BYTE PTR [ECX + EBX]
// load base 64 'no more data flag'
mov DH, Base64Filler
jmp @@WriteLast4
@@SaveOne:
// adjust the last two bits
shr AL, 2
mov BL, AL
// save them
mov DH, BYTE PTR [ECX + EBX]
shl EDX, 16
// load base 64 'no more data flags'
mov DH, Base64Filler
mov DL, Base64Filler
// ignore jump, as jump reference is next line !
// jmp @@WriteLast4
@@WriteLast4:
// load and adjust result
mov EAX, EDX
ror EAX, 16
// save it to destination
STOSD
@@Done:
end;

{$IFDEF SpeedDecode}
procedure Base64Decode(const InBuffer; InSize: Cardinal; var OutBuffer);
overload; register;
{$ENDIF}
{$IFDEF ValidityCheck}
function Base64Decode(const InBuffer; InSize: Cardinal; var OutBuffer):
Boolean; overload; register;
{$ENDIF}
const
{$IFDEF SpeedDecode}
cBase64Codec: array[0..127] of Byte =
{$ENDIF}
{$IFDEF ValidityCheck}
cBase64Codec: array[0..255] of Byte =
{$ENDIF}
(
$FF, $FF, $FF, $FF, $FF, {005>} $FF, $FF, $FF, $FF, $FF, // 000..009
$FF, $FF, $FF, $FF, $FF, {015>} $FF, $FF, $FF, $FF, $FF, // 010..019
$FF, $FF, $FF, $FF, $FF, {025>} $FF, $FF, $FF, $FF, $FF, // 020..029
$FF, $FF, $FF, $FF, $FF, {035>} $FF, $FF, $FF, $FF, $FF, // 030..039
$FF, $FF, $FF, $3E, $FF, {045>} $FF, $FF, $3F, $34, $35, // 040..049
$36, $37, $38, $39, $3A, {055>} $3B, $3C, $3D, $FF, $FF, // 050..059
$FF, $FF, $FF, $FF, $FF, {065>} $00, $01, $02, $03, $04, // 060..069
$05, $06, $07, $08, $09, {075>} $0A, $0B, $0C, $0D, $0E, // 070..079
$0F, $10, $11, $12, $13, {085>} $14, $15, $16, $17, $18, // 080..089
$19, $FF, $FF, $FF, $FF, {095>} $FF, $FF, $1A, $1B, $1C, // 090..099
$1D, $1E, $1F, $20, $21, {105>} $22, $23, $24, $25, $26, // 100..109
$27, $28, $29, $2A, $2B, {115>} $2C, $2D, $2E, $2F, $30, // 110..119
$31, $32, $33, $FF, $FF, {125>} $FF, $FF, $FF // 120..127

{$IFDEF ValidityCheck}
{125>} , $FF, $FF, // 128..129
$FF, $FF, $FF, $FF, $FF, {135>} $FF, $FF, $FF, $FF, $FF, // 130..139
$FF, $FF, $FF, $FF, $FF, {145>} $FF, $FF, $FF, $FF, $FF, // 140..149
$FF, $FF, $FF, $FF, $FF, {155>} $FF, $FF, $FF, $FF, $FF, // 150..159
$FF, $FF, $FF, $FF, $FF, {165>} $FF, $FF, $FF, $FF, $FF, // 160..169
$FF, $FF, $FF, $FF, $FF, {175>} $FF, $FF, $FF, $FF, $FF, // 170..179
$FF, $FF, $FF, $FF, $FF, {185>} $FF, $FF, $FF, $FF, $FF, // 180..189
$FF, $FF, $FF, $FF, $FF, {195>} $FF, $FF, $FF, $FF, $FF, // 190..199
$FF, $FF, $FF, $FF, $FF, {205>} $FF, $FF, $FF, $FF, $FF, // 200..209
$FF, $FF, $FF, $FF, $FF, {215>} $FF, $FF, $FF, $FF, $FF, // 210..219
$FF, $FF, $FF, $FF, $FF, {225>} $FF, $FF, $FF, $FF, $FF, // 220..229
$FF, $FF, $FF, $FF, $FF, {235>} $FF, $FF, $FF, $FF, $FF, // 230..239
$FF, $FF, $FF, $FF, $FF, {245>} $FF, $FF, $FF, $FF, $FF, // 240..249
$FF, $FF, $FF, $FF, $FF, {255>} $FF // 250..255
{$ENDIF}
);
asm
push EBX
mov ESI, [EAX]
mov EDI, [ECX]
{$IFDEF ValidityCheck}
mov EAX, InSize
and EAX, $03
cmp EAX, $00
jz @@DecodeStart
jmp @@ErrorDone
@@DecodeStart:
{$ENDIF}
mov EAX, InSize
shr EAX, 2
jz @@Done
lea ECX, cBase64Codec[0]
xor EBX, EBX
dec EAX
jz @@LeftOver
push EBP
mov EBP, EAX
@@LoopStart:
// load four bytes into EAX
LODSD
// save them to EDX as AX is used to store results
mov EDX, EAX
// get bits 0..5
mov BL, DL
// decode
mov AH, BYTE PTR [ECX + EBX]
{$IFDEF ValidityCheck}
// check valid code
cmp AH, $FF
jz @@ErrorDoneAndPopEBP
{$ENDIF}
// get bits 6..11
mov BL, DH
// decode
mov AL, BYTE PTR [ECX + EBX]
{$IFDEF ValidityCheck}
// check valid code
cmp AL, $FF
jz @@ErrorDoneAndPopEBP
{$ENDIF}
// align last 6 bits
shl AL, 2
// get first 8 bits
ror AX, 6
// store first byte
STOSB
// align remaining 4 bits
shr AX, 12
// get next two bytes from source quad
shr EDX, 16
// load bits 12..17
mov BL, DL
// decode
mov AH, BYTE PTR [ECX + EBX]
{$IFDEF ValidityCheck}
// check valid code
cmp AH, $FF
jz @@ErrorDoneAndPopEBP
{$ENDIF}
// align ...
shl AH, 2
// ... and adjust
rol AX, 4
// get last bits 18..23
mov BL, DH
// decord
mov BL, BYTE PTR [ECX + EBX]
{$IFDEF ValidityCheck}
// check valid code
cmp BL, $FF
jz @@ErrorDoneAndPopEBP
{$ENDIF}
// enter in destination word
or AH, BL
// and store to destination
STOSW
// more coming ?
dec EBP
jnz @@LoopStart
pop EBP
// no
// last four bytes are handled separately, as special checking is needed
// on the last two bytes (may be end of data signals '=' or '==')
@@LeftOver:
// get the last four bytes
LODSD
// save them to EDX as AX is used to store results
mov EDX, EAX
// get bits 0..5
mov BL, DL
// decode
mov AH, BYTE PTR [ECX + EBX]
{$IFDEF ValidityCheck}
// check valid code
cmp AH, $FF
jz @@ErrorDone
{$ENDIF}
// get bits 6..11
mov BL, DH
// decode
mov AL, BYTE PTR [ECX + EBX]
{$IFDEF ValidityCheck}
// check valid code
cmp AL, $FF
jz @@ErrorDone
{$ENDIF}
// align last 6 bits
shl AL, 2
// get first 8 bits
ror AX, 6
// store first byte
STOSB
// get next two bytes from source quad
shr EDX, 16
// check DL for "end of data signal"
cmp DL, Base64Filler
jz @@SuccessDone
// align remaining 4 bits
shr AX, 12
// load bits 12..17
mov BL, DL
// decode
mov AH, BYTE PTR [ECX + EBX]
{$IFDEF ValidityCheck}
// check valid code
cmp AH, $FF
jz @@ErrorDone
{$ENDIF}
// align ...
shl AH, 2
// ... and adjust
rol AX, 4
// store second byte
STOSB
// check DH for "end of data signal"
cmp DH, Base64Filler
jz @@SuccessDone
// get last bits 18..23
mov BL, DH
// decord
mov BL, BYTE PTR [ECX + EBX]
{$IFDEF ValidityCheck}
// check valid code
cmp BL, $FF
jz @@ErrorDone
{$ENDIF}
// enter in destination word
or AH, BL
// AH - AL for saving last byte
mov AL, AH
// store third byte
STOSB
@@SuccessDone:
{$IFDEF ValidityCheck}
mov Result, $01
jmp @@Done
@@ErrorDoneAndPopEBP:
pop EBP
@@ErrorDone:
mov Result, $00
{$ENDIF}
@@Done:
pop EBX
end;

procedure Base64Encode(const InText: PAnsiChar; var OutText: PChar);
var
InSize, OutSize: Cardinal;
begin
// get size of source
InSize := Length(InText);
// calculate size for destination
OutSize := CalcEncodedSize(InSize);
// reserve memory
OutText := StrAlloc(Succ(OutSize));
OutText[OutSize] := #0;
// encode !
Base64Encode(InText, InSize, OutText);
end;

procedure Base64Encode(const InText: AnsiString; var OutText: AnsiString);
overload;
var
InSize, OutSize: Cardinal;
PIn, POut: Pointer;
begin
// get size of source
InSize := Length(InText);
// calculate size for destination
OutSize := CalcEncodedSize(InSize);
// prepare string length to fit result data
SetLength(OutText, OutSize);
PIn := @InText[1];
POut := @OutText[1];
// encode !
Base64Encode(PIn, InSize, POut);
end;

procedure Base64Decode(const InText: PAnsiChar; var OutText: PChar);
overload;
var
InSize, OutSize: Cardinal;
begin
// get size of source
InSize := Length(InText);
// calculate size for destination
OutSize := CalcDecodedSize(InText, InSize);
// reserve memory
OutText := StrAlloc(Succ(OutSize));
OutText[OutSize] := #0;
// encode !
{$IFDEF SpeedDecode}
Base64Decode(InText, InSize, OutText);
{$ENDIF}
{$IFDEF ValidityCheck}
if not Base64Decode(InText, InSize, OutText) then
OutText[0] := #0;
{$ENDIF}
end;

procedure Base64Decode(const InText: AnsiString; var OutText: AnsiString);
overload;
var
InSize, OutSize: Cardinal;
PIn, POut: Pointer;
begin
// get size of source
InSize := Length(InText);
// calculate size for destination
PIn := @InText[1];
OutSize := CalcDecodedSize(PIn, InSize);
// prepare string length to fit result data
SetLength(OutText, OutSize);
FillChar(OutText[1], OutSize, '.');
POut := @OutText[1];
// encode !
{$IFDEF SpeedDecode}
Base64Decode(PIn, InSize, POut);
{$ENDIF}
{$IFDEF ValidityCheck}
if not Base64Decode(PIn, InSize, POut) then
SetLength(OutText, 0);
{$ENDIF}
end;

end.

Delphi Forum

string to base64Binary

string to base64Binary

Re: string to base64Binary

Re: string to base64Binary

Re: string to base64Binary

Re: string to base64Binary

Re: string to base64Binary

Re: string to base64Binary

Re: string to base64Binary

Re: string to base64Binary

Re: string to base64Binary

Re: string to base64Binary

Re: string to base64Binary