2017-12-15

Navigation

Skip Navigation Links

Hash algorithms

Asymmetric Algorithms

Symmetric Cipher Algorithms

Encoding Algorithms

Compression Algorithms

Pseudo Random Number Algorithms

Steganography

Library Wrappers

String Comparison

Others

Syntax highlighting by Prism
PBCrypto.com Mirror

UUEncode

Algorithm creator(s)

n/a


PB author(s)

Borje Hagsten, Don Dickinson


Description

UUEncoding and decoding


Note

n/a


Source

https://forum.powerbasic.com/forum/user-to-user-discussions/source-code/24265-uudecode-complete-routine?t=23628


See also

n/a


Source Code

Download source code file uuencode.bas (Right-click -> "Save as ...")

'##############################################################################
'### Borje Hagsten's implementation 
'##############################################################################

'����������������������������������������������������������������������
' Purpose: UUdecode a given UUencoded text and return the result.
'
' UUencode/decode is not often used today, but sometimes I get UUencoded
' attachments in the mail, so wanted own routine for decoding these.
' Could only find the actual decoding parts described, and most of them
' were not fast enough for my taste anyway, so wrote this complete routine.
'
' Cannot guarantee correctness, but it works fine for me, so probably I
' have managed to do something right..
'
' Hereby released into Public Domain by Borje Hagsten, Dec. 2002
'����������������������������������������������������������������������
FUNCTION uuDecode(BYVAL strIn AS STRING) AS STRING

  LOCAL pos AS LONG, c AS LONG, oldPos AS LONG, _
        pLet AS BYTE PTR, pOut AS BYTE PTR, _
        strLine AS STRING, strOut AS STRING

  IF LCASE$(LEFT$(strIn, 6)) = "begin " THEN        'if there, remove header line
     strIn = MID$(strIn,  INSTR(1, strIn, $LF) + 1) 'hm, should always be LCASE, but can we be sure?
  END IF
  IF LCASE$(RIGHT$(strIn, 5)) = "end" + $CRLF THEN  'if there, remove footer line
     strIn = LEFT$(strIn, LEN(strIn) - 10)
  END IF
  IF RIGHT$(strIn, 2) <> $CRLF THEN strIn = strIn + $CRLF  'make sure input ends with a line feed

  oldPos = 1                       'startpos for MID$
  strOut = STRING$(LEN(strIn), 0)  '3/4 size of strIn should be enough, but let's play it safe
  pOut   = STRPTR(strOut)          'pointer to result-string start
  pLet   = STRPTR(strIn)           'pointer to input-string start

  FOR pos = 1 TO LEN(strIn)        'run through input, character by character, and extract lines
     IF @pLet = 13 THEN            'line end, grab line - without CRLF
        strLine = MID$(strIn, oldPos, pos - oldPos)

        GOSUB UUDecodeLine         'use inline sub for better speed

        INCR pLet : INCR pos       'move past line feed
        oldPos = pos + 1           'store pos for next line
     END IF
     INCR pLet                     'move pointer
  NEXT

  strOut = EXTRACT$(strOut, CHR$(0)) ' extract result
  IF ASC(strOut, -1) = 13 THEN       ' found some results with only $CR at end, which
     strOut = strOut + $LF           ' probably is a padding problem, but this fixes it.
  END IF
  FUNCTION = strOut                  'return result - now hopefully correctly decoded text
EXIT FUNCTION

UUDecodeLine:
  FOR c = 2 TO LEN(strLine) STEP 4
     @pOut = (ASC(strLine, c) - 32) * 4        + (ASC(strLine, c + 1) - 32) \ 16
     INCR pOut
     @pOut = (ASC(strLine, c + 1) MOD 16) * 16 + (ASC(strLine, c + 2) - 32) \ 4
     INCR pOut
     @pOut = (ASC(strLine, c + 2) MOD 4) * 64  + (ASC(strLine, c + 3) - 32)
     INCR pOut
  NEXT
  RETURN

END FUNCTION









'##############################################################################
'### Don Dickinson's implementation 
'##############################################################################

'  uu encoding and decoding for power basic 32-bit
'
'  Written by Don Dickinson - ddickinson@usinternet.com
'  July, 1998
'
'  Hereby Public Domain. Deemed reliable, but use at your own risk, etc.
'  Do with it as you will, provided you hold the author harmless
'  from all effects and side-effects of using this code.
'
'=============================================================================

'
'  Debug constants
'
'  if debug constants are on, you need pb/cc as
'  they output debug messages via the print
'  statement to a console window
'=============================================================================
%DEBUG_UUCODE = %False

'
'  Function prototypes
'=============================================================================
Declare Function uuDecode(sBuffer As String) As String
Declare Function uuEncode(sBuffer As String) As String
Declare Function uuEncodeFile(sInFile As String, sOutFile As String, _
                  iAppend As Long) As Long
Declare Function uuDecodeFile(zInFile As String, zOutFile As String) As Long


'
'  uuDecode
'
'  Decodes a block
'=============================================================================
Function uuDecode(sBuffer As String) As String

    Dim iLoop As Long
    Dim sOutBuffer As String

    For iLoop = 1 To Len(sBuffer) Step 4
        sOutBuffer = sOutBuffer + _
            Chr$((Asc(Mid$(sBuffer, iLoop, 1)) - 32) * 4 + _
            (Asc(Mid$(sBuffer, iLoop + 1, 1)) - 32) \ 16)

        sOutBuffer = sOutBuffer + _
            Chr$((Asc(Mid$(sBuffer, iLoop + 1, 1)) Mod 16) * 16 + _
            (Asc(Mid$(sBuffer, iLoop + 2, 1)) - 32) \ 4)

        sOutBuffer = sOutBuffer + _
            Chr$((Asc(Mid$(sBuffer, iLoop + 2, 1)) Mod 4) * 64 + _
            Asc(Mid$(sBuffer, iLoop + 3, 1)) - 32)

    Next iLoop

    Function = sOutBuffer

End Function

'
'  uuEncode
'
'  Encodes a block
'=============================================================================
Function uuEncode(sBuffer As String) As String

   Dim iLoop As Long
   Dim sOutBuffer As String

   '- make sure it is a 3 byte multiple
   If Len(sBuffer) Mod 3 <> 0 Then sBuffer = sBuffer + _
         Space$(3 - Len(sBuffer) Mod 3)

   For iLoop = 1 To Len(sBuffer) Step 3
      sOutBuffer = sOutBuffer + _
            Chr$(Asc(Mid$(sBuffer, iLoop, 1)) \ 4 + 32)

      sOutBuffer = sOutBuffer + _
            Chr$((Asc(Mid$(sBuffer, iLoop, 1)) Mod 4) * 16 + _
            Asc(Mid$(sBuffer, iLoop + 1, 1)) \ 16 + 32)

      sOutBuffer = sOutBuffer + _
            Chr$((Asc(Mid$(sBuffer, iLoop + 1, 1)) Mod 16) * 4 + _
            Asc(Mid$(sBuffer, iLoop + 2, 1)) \ 64 + 32)

      sOutBuffer = sOutBuffer + _
            Chr$(Asc(Mid$(sBuffer, iLoop + 2, 1)) Mod 64 + 32)

   Next iLoop

   Function = sOutBuffer

End Function


'
'  uuDecodeFile
'
'  Decodes the input file and puts it in the binary output file.
'=============================================================================
Function uuDecodeFile(sInFile As String, sOutFile As String) As Long

   Dim iInput As Long
   Dim iOutput As Long
   Dim iFoundHeader As Long
   Dim sInput As String
   Dim sOutput As String

   On Error Resume Next

   '- The output file can't exist and the input must exist or we bail.
   If Dir$(sInFile) = "" Then
      $If %DEBUG_UUCODE
      Print "Input not found"
      $EndIf

      Function = %False
      '============
      Exit Function
      '============
   End If

   If Dir$(sOutFile) <> "" Then
      $If %DEBUG_UUCODE
      Print "Output exists"
      $EndIf
      Function = %False
      '============
      Exit Function
      '============
   End If

   '- Open the input and output files
   iInput = FreeFile
   Open sInFile For Input As #iInput
   If Err Then
      $If %DEBUG_UUCODE
      Print "Can't open input"
      $EndIf
      Function = %false
      '============
      Exit Function
      '============
   End If

   iOutput = FreeFile
   Open sOutFile For Binary As #iOutput
   If Err Then
      $If %DEBUG_UUCODE
      Print "Can't open output"
      $EndIf
      Function = %false
      Close iInput
      '============
      Exit Function
      '============
   End If

   '- If we get this far, both files are open
   '  and ready to go.
   '

   '- Loop through input until we find the header.
   iFoundHeader = %False
   Do Until Eof(iInput)
      Line Input #iInput, sInput
      If Left$(UCase$(Trim$(sInput)), 5) = "BEGIN" Then
         iFoundHeader = %True
         Exit Do
      End If
   Loop

   If iFoundHeader = %False Then
      $If %DEBUG_UUCODE
      Print "Header not found"
      $EndIf
      Function = %False
   Else

      '- Loop through and decode the file
      Do Until Eof(iInput)
         Line Input #iInput, sInput
         If UCase$(Trim$(sInput)) = "END" Then
            Exit Do
         End If
         If Trim$(sInput) <> "" Then
            sOutput = Left$(uuDecode(Mid$(sInput, 2, Len(sInput) - 1)), Asc(Left$(sInput, 1)) - 32)
            Put$ #iOutput, sOutput
         End If
      Loop
      Function = %True
   End If

   Close #iInput
   Close #iOutput

End Function

'
'  uuEncodeFile
'
'  Takes and input file and uuencodes it to the output file. If iAppend
'  is non-zero, it appends the output to an existing file, otherwise
'  it overwrites the other file.
'=============================================================================
Function uuEncodeFile(sInFile As String, sOutFile As String, _
                  iAppend As Long) As Long

   Dim iLoop As Long
   Dim iInput As Long
   Dim iOutput As Long
   Dim iFullLines As Long
   Dim sInput As String
   Dim sOutput As String
   Dim sFileName As String

   On Error Resume Next

   '- The output file can't exist (unless being appended to)
   '  And the Input must exist Or we bail.
   '
   If (Dir$(sOutFile) = "") And (iAppend = %True) Then
      $If %DEBUG_UUCODE
      Print "Output doesn't exit and we're trying to append"
      $EndIf
      Function = %False
      '============
      Exit Function
      '============
   End If

   If (Dir$(sOutFile) <> "") and (iAppend = %False) Then
      $If %DEBUG_UUCODE
      Print "Output exists and we're appending"
      $EndIf
      Function = %False
      '============
      Exit Function
      '============
   End If

   '- Open the input and output files
   iInput = FreeFile
   Open sInFile For Binary As #iInput
   If Err Then
      $If %DEBUG_UUCODE
      Print "Input file can't be opened. Error =" + str$(err)
      $EndIf
      Function = %false
      '============
      Exit Function
      '============
   End If

   iOutput = FreeFile
   If iAppend Then
      Open sOutFile For Append As #iOutput
   Else
      Open sOutFile For Output As #iOutput
   End If

   If Err Then
      $If %DEBUG_UUCODE
      Print "Output file can't be opened. Error =" + str$(err)
      $EndIf
      Function = %false
      Close iInput
      '============
      Exit Function
      '============
   End If

   '- We need the file name without path for encoding
   sFileName = sInFile
   For iLoop = Len(sInFile) - 1 To 1 Step -1
      If Mid$(sInFile, iLoop, 1) = "\" Then
         sFileName = Mid$(sInFile, iLoop + 1)
         Exit For
      End If
   Next

   '- If we get this far, both files are open
   '  and ready to go.
   '

   '- uuCoded Header
    Print #iOutput, ""
    Print #iOutput, "begin 644 " + sFileName

   '- determine how many full lines we get, 45 bytes gets
   '  expanded to 60 bytes
   '
   iFullLines = Lof(iInput) \ 45
   sInput = Space$(45)
   For iLoop = 1 To iFullLines
      Get #iInput,, sInput
      Print #iOutput, "M" + uuEncode(sInput)
   Next iLoop

   '- Write out the rest of the file
   sInput = Space$(Lof(iInput) Mod 45)
   Get iInput,, sInput
   Print #iOutput, Chr$(Len(sInput) + 32) + uuEncode(sInput)
   Print #iOutput, "'"
   Print #iOutput, "end"

   '- Clean up and return OK
   Close #iInput
   Close #iOutput
   Function = %True

End Function


Mirror provided by Knuth Konrad