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