'
'  pb_uuenc.bas
'
'  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