Base91Legacy encoding/decoding procedures

[Theo Gottwald]

Base91 encoding is a method for converting binary data into a text format, specifically designed to be more efficient than traditional Base64 encoding. It's particularly useful in contexts where space is at a premium, such as in network protocols or data storage. Base91 achieves higher efficiency by using a larger set of characters for encoding, thus representing more data per character. 🚀$crlf$crlf
Key Features of Base91: 🗝�$crlf
- Efficiency: Base91 uses 91 characters for encoding, compared to Base64's 64 characters, allowing it to encode data more compactly. 📊$crlf
- Binary-Safe: It can encode any binary data, including images and executable files. 🖼�💾$crlf
- No Padding Required: Unlike Base64, Base91 doesn't require padding characters at the end of the encoded string. ✂️$crlf$crlf
How It Works: 🔍$crlf
Encoding Process: 🔄$crlf
1. It takes binary data and groups the bits. 🧬$crlf
2. These groups of bits are then mapped to one of the 91 characters in the encoding table. 🗺�$crlf
3. This process continues until all binary data is converted into a string of Base91 characters. 🔤$crlf$crlf
Decoding Process: 🔙$crlf
1. The reverse happens. Each Base91 character is mapped back to its binary representation. 🔢$crlf
2. These bits are then reassembled into the original binary data. 🛠�$crlf$crlf
#Base91 #Encoding #Efficiency #DataStorage #NetworkProtocols #BinaryData #TechInnovation #NoPaddingRequired #CompactData 🌐🔐💻📡🔢🛠�🚀🗝�📊🖼�💾✂️🔄🗺�🔤🔍🔙


Needed Shift-Functions:

Code Select Expand

#compile exe  "demo_ShiftFunct.exe"
#dim all
#if %def(%pb_cc32) 'Either PBWin or PBCC, without unneeded console in PBCC.
  #console off
#endif

fastproc ShiftLeft (byval ToShift as long, byval ShiftBits as long) as long
  ! mov ecx, ShiftBits
  ! mov ebx, ToShift
  ! shl ebx, cl
  ! mov ToShift, ebx
end fastproc = ToShift
fastproc ShiftRight (byval ToShift as long, byval ShiftBits as long) as long
  ! mov ecx, ShiftBits
  ! mov ebx, ToShift
  ! shr ebx, cl
  ! mov ToShift, ebx
end fastproc = ToShift
fastproc ShiftLeftSigned (byval ToShift as long, byval ShiftBits as long) as long
  ! mov ecx, ShiftBits
  ! mov ebx, ToShift
  ! sar ebx, cl
  ! mov ToShift, ebx
end fastproc = ToShift
fastproc ShiftRightSigned (byval ToShift as long, byval ShiftBits as long) as long
  ! mov ecx, ShiftBits
  ! mov ebx, ToShift
  ! sal ebx, cl
  ! mov ToShift, ebx
end fastproc = ToShift
'
'PBMain is only to demonstrate the "functions".
function pbmain () as long
  local hTWin as dword

  txt.window "Shift Demo", 50, 50, 12, 45 to hTWin
  txt.print str$(ShiftLeft (14, 1))  + " should be 28"
  txt.print str$(ShiftRight (14, 1))  + " should be 7"
  txt.print str$(ShiftLeftSigned (-14, 1)) + " should be -7"
  txt.print str$(ShiftRightSigned (-14, 1)) + " should be -28"
  txt.print "Shows negatives unsigned shifted"
  txt.print str$(ShiftLeft (-14, 1))
  txt.print str$(ShiftRight (-14, 1)) + " <--- 0 bit shifted into sign"

  txt.waitkey$
  txt.end
end function '


Code Select Expand

' Base91Legacy encoding/decoding procedures. Not much to say about it
' and probably not very useful (?), but a question was asked and I found
' some fun code examples to translate - so here are PB versions of it.
' Public Domain, as usual, by Borje Hagsten 27 Sep, 2023
' Modified by Stuart McLachlan 10 Oct 2023 - (Shift Macros and Bitwise conditional)
'--------------------------------------------------------------------
#COMPILE EXE
#DIM ALL
#INCLUDE "WIN32API.INC"
%IDC_LABEL1    = 101
%IDC_LABEL2    = 102
%IDC_BUTTON1   = 121
%IDC_BUTTON2   = 122
%IDC_TEXTBOX1  = 131
%IDC_TEXTBOX2  = 132
GLOBAL arrB91() AS STRING

MACRO SHIFTL(v,n) = v * (2^n)
MACRO SHIFTR(v,n) = v \ (2^n)

'======================================================================
FUNCTION PBMAIN () AS LONG
  LOCAL hDlg AS DWORD

  DIALOG NEW 0, "Base91 encryption",,, 185, 115, %WS_CAPTION OR _
             %WS_SYSMENU OR %WS_MINIMIZEBOX, 0 TO hDlg

  '------------------------------------------------------------------
  CONTROL ADD LABEL, hDlg, %IDC_LABEL1, "Plain text", 5, 1, 60, 9
  CONTROL ADD TEXTBOX, hDlg, %IDC_TEXTBOX1, "Hello World!", 5, 10, 120, 45, _
            %WS_CHILD OR %WS_VISIBLE OR %WS_VSCROLL OR %ES_MULTILINE OR _
            %ES_WANTRETURN, %WS_EX_CLIENTEDGE

  CONTROL ADD LABEL, hDlg, %IDC_LABEL2, "Encrypted text", 5, 56, 60, 9
  CONTROL ADD TEXTBOX, hDlg, %IDC_TEXTBOX2, "", 5, 65, 120, 45, _
            %WS_CHILD OR %WS_VISIBLE OR %WS_VSCROLL OR %ES_MULTILINE OR _
            %ES_WANTRETURN, %WS_EX_CLIENTEDGE

  CONTROL ADD BUTTON, hDlg, %IDC_BUTTON1, "Encode", 130, 10, 50, 14
  CONTROL ADD BUTTON, hDlg, %IDC_BUTTON2, "Decode", 130, 65, 50, 14

  '-------------------------------------------------------------------
  DIALOG SHOW MODAL hDlg, CALL DlgProc

END FUNCTION

'======================================================================
CALLBACK FUNCTION DlgProc() AS LONG
  LOCAL sBuf AS STRING

  SELECT CASE CB.MSG
  CASE %WM_INITDIALOG
      REDIM arrB91(90)  ' build zero-based (0-90) global Base91Legacy array
      ARRAY ASSIGN arrB91() = "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", _
                              "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "a", "b", _
                              "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", _
                              "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", "0", "1", "2", "3", _
                              "4", "5", "6", "7", "8", "9", "!", "#", "$", "%", "&", "(", ")", "*", _
                              "+", ",", ".", "/", ":", ";", "<", "=", ">", "?", "@", "[", "]", "^", _
                              "_", "`", "{", "|", "}", "~", CHR$(34)

  CASE %WM_COMMAND
      SELECT CASE CB.CTL
      CASE %IDC_BUTTON1  'Encode
          IF CB.CTLMSG = %BN_CLICKED OR CB.CTLMSG = 1 THEN
              CONTROL GET TEXT CB.HNDL, %IDC_TEXTBOX1 TO sBuf
              CONTROL SET TEXT CB.HNDL, %IDC_TEXTBOX1, ""
              CONTROL SET TEXT CB.HNDL, %IDC_LABEL1, ""
              CONTROL SET TEXT CB.HNDL, %IDC_LABEL2, sBuf
              CONTROL SET TEXT CB.HNDL, %IDC_TEXTBOX2, Base91Encode(sBuf)
          END IF

      CASE %IDC_BUTTON2 ' Decode
          IF CB.CTLMSG = %BN_CLICKED OR CB.CTLMSG = 1 THEN
              CONTROL GET TEXT CB.HNDL, %IDC_TEXTBOX2 TO sBuf
              CONTROL SET TEXT CB.HNDL, %IDC_TEXTBOX2, ""
              CONTROL SET TEXT CB.HNDL, %IDC_LABEL1, sBuf
              CONTROL SET TEXT CB.HNDL, %IDC_LABEL2, ""
              CONTROL SET TEXT CB.HNDL, %IDC_TEXTBOX1, Base91Decode(sBuf)
          END IF

      CASE %IDCANCEL
          IF CB.CTLMSG = %BN_CLICKED OR CB.CTLMSG = 1 THEN
              DIALOG END CB.HNDL, 0
          END IF
      END SELECT

  END SELECT

END FUNCTION

'==============================================
FUNCTION Base91Encode(sBuf AS STRING) AS STRING
  LOCAL b, i, j, n, v AS LONG
  LOCAL sOut AS STRING

  FOR i = 1 TO LEN(sBuf)
      j = ASC(sBuf, i)
      SHIFT LEFT j, n
      b OR= j
      n += 8

      IF n > 13 THEN
          v = b AND 8191
          IF v > 88 THEN
            SHIFT RIGHT b, 13
            n -= 13
          ELSE
              v = b AND 16383
              SHIFT RIGHT b, 14
              n -= 14
          END IF
          sOut += arrB91(INT((v MOD 91))) & arrB91(INT((v / 91)))
      END IF
  NEXT i

  IF n THEN
      sOut += arrB91(INT((b MOD 91)))
      IF n > 7 OR b > 90 THEN
          sOut += arrB91(INT((b / 91)))
      END IF
  END IF

  FUNCTION = sOut
END FUNCTION

'==============================================
FUNCTION Base91Decode(sBuf AS STRING) AS STRING
  LOCAL b, i, j, n, v AS LONG
  LOCAL sOut AS STRING
  v = -1

  FOR i = 1 TO LEN(sBuf)
      ARRAY SCAN arrB91(), = MID$(sBuf, i, 1), TO j
      IF j = 0 THEN ITERATE FOR
      DECR j
      IF v < 0 THEN
          v = j
      ELSE
          v += j * 91
          b OR= SHIFTL(v,n)
          n += IIF((v AND 8191) > 88, 13, 14)
          DO
              sOut += CHR$(b AND &HFF)
              SHIFT RIGHT b, 8
              n -= 8
          LOOP WHILE (n > 7)
          v = -1
      END IF
  NEXT
  IF (v + 1) THEN
      SHIFT LEFT v, n
      sOut += CHR$((b OR v) AND &HFF)
  END IF

  FUNCTION = sOut
END FUNCTION
'


Version 2, slightly improved:

Code Select Expand

' Base91Legacy encoding/decoding procedures improved for robustness and readability.
' Original by Borje Hagsten and Stuart McLachlan, enhanced by OpenAI.
'--------------------------------------------------------------------
#COMPILE EXE
#DIM ALL
#INCLUDE "WIN32API.INC"

%IDC_LABEL1    = 101
%IDC_LABEL2    = 102
%IDC_BUTTON1   = 121
%IDC_BUTTON2   = 122
%IDC_TEXTBOX1  = 131
%IDC_TEXTBOX2  = 132
GLOBAL arrB91() AS STRING

MACRO SHIFTL(v,n) = v * (2^n)
MACRO SHIFTR(v,n) = v \ (2^n)

'======================================================================
FUNCTION PBMAIN () AS LONG
  LOCAL hDlg AS DWORD

  DIALOG NEW 0, "Base91 encryption",,, 185, 115, %WS_CAPTION OR _
             %WS_SYSMENU OR %WS_MINIMIZEBOX, 0 TO hDlg

  CONTROL ADD LABEL, hDlg, %IDC_LABEL1, "Plain text", 5, 1, 60, 9
  CONTROL ADD TEXTBOX, hDlg, %IDC_TEXTBOX1, "Hello World!", 5, 10, 120, 45, _
            %WS_CHILD OR %WS_VISIBLE OR %WS_VSCROLL OR %ES_MULTILINE OR _
            %ES_WANTRETURN, %WS_EX_CLIENTEDGE

  CONTROL ADD LABEL, hDlg, %IDC_LABEL2, "Encrypted text", 5, 56, 60, 9
  CONTROL ADD TEXTBOX, hDlg, %IDC_TEXTBOX2, "", 5, 65, 120, 45, _
            %WS_CHILD OR %WS_VISIBLE OR %WS_VSCROLL OR %ES_MULTILINE OR _
            %ES_WANTRETURN, %WS_EX_CLIENTEDGE

  CONTROL ADD BUTTON, hDlg, %IDC_BUTTON1, "Encode", 130, 10, 50, 14
  CONTROL ADD BUTTON, hDlg, %IDC_BUTTON2, "Decode", 130, 65, 50, 14

  DIALOG SHOW MODAL hDlg, CALL DlgProc

END FUNCTION

'======================================================================
CALLBACK FUNCTION DlgProc() AS LONG
  LOCAL sInput, sOutput AS STRING

  SELECT CASE CB.MSG
  CASE %WM_INITDIALOG
      REDIM arrB91(90)  ' build zero-based (0-90) global Base91Legacy array
      ARRAY ASSIGN arrB91() = "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", _
                              "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "a", "b", _
                              "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", _
                              "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", "0", "1", "2", "3", _
                              "4", "5", "6", "7", "8", "9", "!", "#", "$", "%", "&", "(", ")", "*", _
                              "+", ",", ".", "/", ":", ";", "<", "=", ">", "?", "@", "[", "]", "^", _
                              "_", "`", "{", "|", "}", "~", CHR$(34)

  CASE %WM_COMMAND
      SELECT CASE CB.CTL
      CASE %IDC_BUTTON1  'Encode
          IF CB.CTLMSG = %BN_CLICKED OR CB.CTLMSG = 1 THEN
              CONTROL GET TEXT CB.HNDL, %IDC_TEXTBOX1 TO sInput
              sOutput = Base91Encode(sInput)
              CONTROL SET TEXT CB.HNDL, %IDC_TEXTBOX2, sOutput
          END IF

      CASE %IDC_BUTTON2 'Decode
          IF CB.CTLMSG = %BN_CLICKED OR CB.CTLMSG = 1 THEN
              CONTROL GET TEXT CB.HNDL, %IDC_TEXTBOX2 TO sInput
              sOutput = Base91Decode(sInput)
              CONTROL SET TEXT CB.HNDL, %IDC_TEXTBOX1, sOutput