mibuso.com
Home› NAV/Navision Classic Client

Post of Code: Base64 encoding and decoding

Dennis_DecoeneDennis_Decoene Member Posts: 123
edited 2011-11-03 in NAV/Navision Classic Client
Hi guys,

I've written some functions that will allow you to encode/decode Base64.
Maybe you might find it useful. The main purpouse of course would be to convert a binary file to text for easy transfer.

I was thinking of a way to encode a DLL into base64 and have the resulting text stored in a navision codeunit. When you want to access this dll, you could chek if it exists. If not, you can make it and register it on the fly!!!

Even version checking and upgrading the dll would be possible... No more hassle with getting the client up to date =P~

Well, this thingy here was sort of proof of concept for me. Maybe I will take it further.

Let me know what you think.
OBJECT Codeunit 99000 Base64 Management
{
  OBJECT-PROPERTIES
  {
    Date=12/04/05;
    Time=15:04:40;
    Modified=Yes;
    Version List=;
  }
  PROPERTIES
  {
    OnRun=BEGIN
            gtxt_Plaintext := 'Base64 encoding is great for storing binary files as printable text!!!';
            gtxt_Encoded := Fct_Base64Encode(gtxt_Plaintext);
            gtxt_Decoded := Fct_Base64Decode(gtxt_Encoded);
            MESSAGE('Plain: %1\Encoded: %2\Decoded: %3',gtxt_Plaintext,gtxt_Encoded,gtxt_Decoded);
          END;

  }
  CODE
  {
    VAR
      gtxt_Plaintext@1100074002 : Text[1024];
      gtxt_Encoded@1100074001 : Text[1024];
      gtxt_Decoded@1100074000 : Text[1024];

    PROCEDURE Fct_Base64Encode@1100074001(ptxt_Source@1100074000 : Text[1024]) rtxt_Encoded : Text[1024];
    VAR
      ltxt_Base64@1100074005 : Text[64];
      ltxt_SourceBits@1100074001 : Text[24];
      ltxt_PartBits@1100074003 : Text[8];
      lint_Index@1100074006 : Integer;
      c@1100074002 : Integer;
      i@1100074004 : Integer;
    BEGIN
      ltxt_Base64 := 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';

      c := 1;

      REPEAT
        ltxt_SourceBits := Fct_IntToBin(ptxt_Source[c]);
        ltxt_SourceBits += Fct_IntToBin(ptxt_Source[c + 1]);
        ltxt_SourceBits += Fct_IntToBin(ptxt_Source[c + 2]);
        FOR i := 1 TO 4 DO BEGIN
          ltxt_PartBits := '00' + COPYSTR(ltxt_SourceBits, (i*6)-5,6);
          lint_Index := Fct_BinToInt(ltxt_PartBits);
          IF lint_Index <> 0 THEN
            rtxt_Encoded += FORMAT(ltxt_Base64[lint_Index+1])
          ELSE
            rtxt_Encoded += '=';
        END;

        c += 3;
      UNTIL c > STRLEN(ptxt_Source);
    END;

    PROCEDURE Fct_Base64Decode@1100074003(ptxt_Source@1100074000 : Text[1024]) rtxt_Decoded : Text[1024];
    VAR
      ltxt_Base64@1100074006 : Text[64];
      ltxt_SourceBits@1100074005 : Text[24];
      ltxt_PartBits@1100074004 : Text[8];
      ltxt_Char@1100074007 : Text[1];
      lint_Index@1100074003 : Integer;
      c@1100074002 : Integer;
      i@1100074001 : Integer;
      iPos@1100074008 : Integer;
    BEGIN
      ltxt_Base64 := 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';

      c := 1;

      REPEAT
        ltxt_SourceBits := COPYSTR(Fct_IntToBin(STRPOS(ltxt_Base64,FORMAT(ptxt_Source[c]))-1),3,6);
        ltxt_SourceBits += COPYSTR(Fct_IntToBin(STRPOS(ltxt_Base64,FORMAT(ptxt_Source[c+1]))-1),3,6);
        ltxt_SourceBits += COPYSTR(Fct_IntToBin(STRPOS(ltxt_Base64,FORMAT(ptxt_Source[c+2]))-1),3,6);
        ltxt_SourceBits += COPYSTR(Fct_IntToBin(STRPOS(ltxt_Base64,FORMAT(ptxt_Source[c+3]))-1),3,6);

        FOR i := 1 TO 3 DO BEGIN
          ltxt_PartBits := COPYSTR(ltxt_SourceBits, (i*8)-7,8);
          lint_Index := Fct_BinToInt(ltxt_PartBits);
          ltxt_Char[1] := lint_Index;
          rtxt_Decoded += ltxt_Char;
        END;

        c += 4;
      UNTIL c > STRLEN(ptxt_Source);
    END;

    PROCEDURE Fct_IntToBin@1100074000(pint_Number@1100074000 : Integer) rtxt_Binary : Text[8];
    BEGIN
      WHILE pint_Number > 0 DO BEGIN
        rtxt_Binary := FORMAT(pint_Number MOD 2) + rtxt_Binary;
        pint_Number := pint_Number DIV 2;
      END;

      WHILE STRLEN(rtxt_Binary) < 8 DO
        rtxt_Binary := '0' + rtxt_Binary;
    END;

    PROCEDURE Fct_BinToInt@1100074002(ptxt_binary@1100074000 : Text[8]) rint_Number : Integer;
    VAR
      i@1100074001 : Integer;
      c@1100074002 : Integer;
      f@1100074003 : Integer;
    BEGIN
      FOR i := 1 TO 8 DO BEGIN
        IF ptxt_binary[i] = '1' THEN BEGIN
          FOR c := 1 TO 9-i DO BEGIN
            IF c = 1 THEN
              f := 1
            ELSE
              f := f * 2;
          END;
          rint_Number += f;
        END;
      END;
    END;

    BEGIN
    END.
  }
}

Comments

  • fbfb Member Posts: 246
    How about a streaming version of 'Encode'... 
    PROCEDURE Base64EncodeStream(VAR inStr : InStream;VAR outStr : OutStream);
    VAR
      b : Binary[3];
      nRead : Integer;
      c : ARRAY [4] OF Char;
      nWritten : Integer;
      txt64Chars : Text[64];
    BEGIN
      txt64Chars := 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
      txt64Chars += 'abcdefghijklmnopqrstuvwxyz';
      txt64Chars += '0123456789+/';

      WHILE NOT inStr.EOS DO BEGIN

        // read up to 3 bytes...
        nRead := inStr.READ(b);

        // zero out bytes not read...
        IF nRead < 3 THEN
          b[3] := 0;
        IF nRead < 2 THEN
          b[2] := 0;

        // c[1] is high 6 bits of b[1]...
        c[1] := b[1] DIV 4;

        // c[2] is low 2 bits of b[1] and high 4 bits of b[2]...
        c[2] := ((b[1] MOD 4) * 16) + (b[2] DIV 16);

        // c[3] is low 4 bits of b[2] and high 2 bits of b[3]...
        c[3] := ((b[2] MOD 16) * 4) + (b[3] DIV 64);

        // c[4] is low 6 bits of b[3]...
        c[4] := b[3] MOD 64;

        // convert c[1..4] to the Base64Encoded char...
        c[1] := txt64Chars[c[1] + 1];
        c[2] := txt64Chars[c[2] + 1];
        IF nRead > 1 THEN
          c[3] := txt64Chars[c[3] + 1]
        ELSE
          c[3] := '=';
        IF nRead > 2 THEN
          c[4] := txt64Chars[c[4] + 1]
        ELSE
          c[4] := '=';

        // write 'em out...
        outStr.WRITE(c[1]);
        outStr.WRITE(c[2]);
        outStr.WRITE(c[3]);
        outStr.WRITE(c[4]);
        nWritten += 1;

        // write a cr/lf every 72 chars...
        IF nWritten = 18 THEN BEGIN
          c[1] := 13;
          outStr.WRITE(c[1]);
          c[1] := 10;
          outStr.WRITE(c[1]);
          nWritten := 0;
        END;

      END;

      // write the trailing cr/lf...
      IF nWritten <> 0 THEN BEGIN
        c[1] := 13;
        outStr.WRITE(c[1]);
        c[1] := 10;
        outStr.WRITE(c[1]);
      END;
    END;
  • Dennis_DecoeneDennis_Decoene Member Posts: 123
    Your method of getting the right bits is far superior than mine. I guess I was asleep during that math class... :whistle:
  • fbfb Member Posts: 246
    ...far superior...
    Aw, shucks... :oops:

    Anyway, here's the decode...: 
    PROCEDURE Base64DecodeStream(VAR inStr : InStream;VAR outStr : OutStream);
    VAR
      b : Binary[3];
      c : ARRAY [4] OF Char;
      idxChar : Integer;
      inPos : Integer;
      nEqualSigns : Integer;
      txt64Chars : Text[64];
      Text000 : TextConst 'ENU=Invalid character ''%1'' encountered at position %2.';
      Text001 : TextConst 'ENU=Unexpected end-of-stream encountered at position %1.';
    BEGIN
      txt64Chars := 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
      txt64Chars += 'abcdefghijklmnopqrstuvwxyz';
      txt64Chars += '0123456789+/';

      inPos := 0;
      WHILE NOT inStr.EOS DO BEGIN

        // read 1st char (ignore leading white space)...
        inStr.READ(c[1],1);
        inPos += 1;
        WHILE (c[1] IN [9, 10, 13, 32]) AND (NOT inStr.EOS) DO BEGIN
          inStr.READ(c[1],1);
          inPos += 1;
        END;

        IF NOT inStr.EOS THEN BEGIN

          // check 1st char...
          idxChar := STRPOS(txt64Chars, FORMAT(c[1]));
          IF idxChar = 0 THEN ERROR(Text000, FORMAT(c[1]), inPos);
          c[1] := idxChar - 1;

          // get/check 2nd char...
          inStr.READ(c[2],1);
          inPos += 1;
          idxChar := STRPOS(txt64Chars, FORMAT(c[2]));
          IF idxChar = 0 THEN ERROR(Text000, FORMAT(c[2]), inPos);
          c[2] := idxChar - 1;

          // get/check 3rd char...
          IF inStr.EOS THEN ERROR(Text001, inPos);
          inStr.READ(c[3],1);
          inPos += 1;
          nEqualSigns := 0;
          IF c[3] = '=' THEN BEGIN
            c[3] := 0;
            nEqualSigns += 1;
          END ELSE BEGIN
            idxChar := STRPOS(txt64Chars, FORMAT(c[3]));
            IF idxChar = 0 THEN ERROR(Text000, FORMAT(c[3]), inPos);
            c[3] := idxChar - 1;
          END;

          // get/check 4th char...
          IF inStr.EOS THEN ERROR(Text001, inPos);
          inStr.READ(c[4],1);
          inPos += 1;
          IF (nEqualSigns > 0) AND (c[4] <> '=') THEN
            ERROR(Text000, FORMAT(c[4]), inPos);
          IF c[4] = '=' THEN BEGIN
            c[4] := 0;
            nEqualSigns += 1;
          END ELSE BEGIN
            idxChar := STRPOS(txt64Chars, FORMAT(c[4]));
            IF idxChar = 0 THEN ERROR(Text000, FORMAT(c[4]), inPos);
            c[4] := idxChar - 1;
          END;

          // b[1] is c[1] and bits(5,6) of c[2]...
          b[1] := (c[1] * 4) + (c[2] DIV 16);
          outStr.WRITE(b[1]);

          // b[2] is low 4 bits of c[2] and bits(3..6) of c[3]...
          IF nEqualSigns < 2 THEN BEGIN
            b[2] := ((c[2] MOD 16) * 16) + (c[3] DIV 4);
            outStr.WRITE(b[2]);
          END;

          // b[3] is low 2 bits of c[3] and the 6 bits in c[4]...
          IF nEqualSigns = 0 THEN BEGIN
            b[3] := ((c[3] MOD 4) * 64) + c[4];
            outStr.WRITE(b[3]);
          END;

        END;
      END;
    END;
  • Remco_ReinkingRemco_Reinking Member Posts: 74
    How about this one:

    It is really fast and uses automation from Commerce Gateway, as used in codeunit "BizTalk XML DOM Management"
    CREATE( CGBase64);
CREATE( DOMDoc);
CREATE( ADOStream);
DOMNode := DOMDoc.createElement('b64'); // just a dummy to do the conversion
CGBase64.Encode( iTxtFileName, DOMNode);
ADOStream.Type := 2; // text
ADOStream.Charset := 'us-ascii';
ADOStream.Open;
ADOStream.WriteText( DOMNode.nodeTypedValue);
IF EXISTS( iTxtFileName+'.b64') THEN
  ERASE( iTxtFileName+'.b64');
ADOStream.SaveToFile( iTxtFileName+'.b64');
ADOStream.Flush;
ADOStream.Close;
CLEAR( ADOStream);
CLEAR( DOMNode);
CLEAR( DOMDoc);
CLEAR( CGBase64);

with variables :

CGBase64    Automation  'CG Request Client'.Base64
DOMNode    Automation  'Microsoft XML, v6.0'.IXMLDOMNode
DOMDoc      Automation  'Microsoft XML, v6.0'.DOMDocument
ADOStream  Automation  'Microsoft ActiveX Data Objects 2.7 Library'.Stream


    Did some small test with a PDFfile, and this one was about 1000 times faster (10 sec compared with 0,01 sec)
  • mdPartnerNLmdPartnerNL Member Posts: 802
    And this took you how many hours to find? :)
  • DuikmeesterDuikmeester Member Posts: 308
    Create a pdf from a report which you can open thru web services.
    PROCEDURE MakePDF@11002001(AccountNo@11002002 : Code[20];VAR Base64@11002000 : BigText);
    VAR
      Document@11002004 : Automation "{F5078F18-C551-11D3-89B9-0000F81FE221} 6.0:{88D96A05-F192-11D4-A65F-0040963251E5}:'Microsoft XML, v6.0'.DOMDocument60";
      Element@11002006 : Automation "{F5078F18-C551-11D3-89B9-0000F81FE221} 6.0:{2933BF80-7B36-11D2-B20E-00C04F983E60}:'Microsoft XML, v6.0'.IXMLDOMNode";
      Stream@11002005 : Automation "{B691E011-1797-432E-907A-4D8C69339129} 6.0:{00000566-0000-0010-8000-00AA006D2EA4}:'Microsoft ActiveX Data Objects 6.0 Library'.Stream";
      Account@11002003 : Record 167;
      TempPath@11002001 : Text[1024];
    BEGIN
      Account.GET(AccountNo);
      TempPath :=
        TEMPORARYPATH + 'temp.pdf';
      Account.FINDSET;
      REPORT.SAVEASPDF(REPORT::"MPS - Job",TempPath,Account);

      CREATE(Document);
      Element := Document.createElement('base64');
      Element.dataType := 'bin.base64';

      CREATE(Stream);
      Stream.Type := 1;
      Stream.Open;
      Stream.LoadFromFile(TempPath);
      Element.nodeTypedValue := Stream.Read;
      Stream.Close;
      Base64.ADDTEXT(Element.text);
    END;
  • mdPartnerNLmdPartnerNL Member Posts: 802
    Thanks, but I think your posting in the wrong topic!
Sign In or Register to comment.