'***************************************************************************
'* This is an example of how to UUEncode & UUDecode files in Visual Basic. *
'* You may use this code freely in your application, all I ask is that you *
'* mention me somewhere in your "about" screen (give credit where credit   *
'* is due).  This code was completed at 9:00pm MDT, Saturday, July 28, 2001*
'* in Billings, MT.  I only mention that because people think there is     *
'* nothing but sheep up here.  If you have any questions or comments,      *
'* please email me at one of the following:  tolsen64@hotmail.com,         *
'* tolsen64@yahoo.com, tolsen64@operamail.com, den1tro@ups.com             *
'* I reserve all rights to this code, if you do use it, i'd appreciate an  *
'* email letting me know you found it useful enuff to include it in your   *
'* application.  Thanks for your support.     --Terry R. Olsen             *
'***************************************************************************

Private Sub cmdUUDecode_Click()
 Dim inPathFileName As String
 Dim outPathFileName As String
 Dim inFileNum As Integer
 Dim outFileNum As Integer
 Dim outByte() As Byte
 Dim char As Byte
 Dim inString As String
 Dim numWriteBytes As Long
 Dim outPathName As String
 Dim byteCount As Integer
 
  'Ask the user which file to UUDecode with the CommonDialog control
  On Error GoTo UserCancelled
  CommonDialog1.ShowOpen
  On Error GoTo 0
  inPathFileName = CommonDialog1.FileName 'path/filename of file to decode
  
  For i = Len(inPathFileName) To 1 Step -1  'get the pathname
   If Mid(inPathFileName, i, 1) = "\" Then
    outPathName = Left(inPathFileName, i)
    Exit For
   End If
  Next

  'open the input file and make sure it's valid
  inFileNum = FreeFile
  Open inPathFileName For Input As #inFileNum
  
  Do                                'loop to find beginning of uuencoded data
   Line Input #inFileNum, inString
   If Left(inString, 6) = "begin " Then Exit Do 'Found the uue header
  Loop Until EOF(inFileNum)         'if we hit EOF, invalid file
  
  If EOF(inFileNum) Then
   Close #inFileNum                 'invalid file, close it
   MsgBox "File is not a UUEncoded file.  Please try another.", _
          vbInformation, "File Error"
   Exit Sub
  End If
  
  For i = Len(inString) To 1 Step -1 'get target filename
   If Mid(inString, i, 1) = " " Then
    outPathFileName = outPathName & Mid(inString, i + 1)
    Exit For
   End If
  Next
  
  'Now that we've verified the input file, let's create the output file
  'Open outPathFileName For Output As #outFileNum
  'Close #outFileNum
  outFileNum = FreeFile
  Open outPathFileName For Binary Access Write As #outFileNum
  ProgressBar1.Max = (LOF(inFileNum) / 128) + 1
  ProgressBar1.Value = 0
  'Let's begin UUDecoding!
  Debug.Print "Time Started: " & Time$
  
  Do
   DoEvents                     'let other things happen while decoding
   Line Input #inFileNum, inString
   ProgressBar1.Value = Loc(inFileNum)
   If inString = "end" Then Exit Do 'end of UUDecoding, get out of here
   numWriteBytes = Asc(Left(inString, 1)) - 32 '"M" would result in a 45 here
   ReDim outByte(1 To numWriteBytes)
   byteCount = 0
   For i = 2 To (Len(inString) - 3) Step 4 'start at 2 so we don't decode
                                           'the "M"
    byteCount = byteCount + 1
    char = Asc(Mid(inString, i, 1)) - 32 'convert the character to a byte
    If char = 64 Then char = 0          'convert ` back to space
    outByte(byteCount) = char * 4 'do a SHL char,2
    char = Asc(Mid(inString, i + 1, 1)) - 32
    If char = 64 Then char = 0          'convert ` back to space
    char = char And 48              'strip off un-needed bits
    char = char / 16                'do a SHR char,4
    outByte(byteCount) = outByte(byteCount) + char 'done with byte 1 of 3
    
    byteCount = byteCount + 1
    char = Asc(Mid(inString, i + 1, 1)) - 32
    If char = 64 Then char = 0      'convert ` back to space
    char = char And 15              'strip off 4 MSB's
    outByte(byteCount) = char * 16  'do a SHL char,4
    char = Asc(Mid(inString, i + 2, 1)) - 32
    If char = 64 Then char = 0      'convert ` back to space
    char = char And 60              'strip off un-needed bits
    char = char / 4                 'do a SHR char,2
    outByte(byteCount) = outByte(byteCount) + char 'done with byte 2 of 3
    
    byteCount = byteCount + 1
    char = Asc(Mid(inString, i + 2, 1)) - 32
    If char = 64 Then char = 0      'convert ` back to space
    char = char And 3               'strip off un-needed bits
    outByte(byteCount) = char * 64  'do a SHL char,6
    char = Asc(Mid(inString, i + 3, 1)) - 32
    If char = 64 Then char = 0      'convert ` back to space
    outByte(byteCount) = outByte(byteCount) + char 'done with byte 3 of 3
   Next
    
  'now write our un-encoded bytes to the output file
  Put #outFileNum, , outByte
 Loop Until EOF(inFileNum) 'we should not get here, if we do, error!
 
 ProgressBar1.Value = 0
 Debug.Print "Time Completed: " & Time$
UserCancelled:
End Sub

Private Sub cmdUUEncode_Click()
 Dim inPathFileName As String
 Dim inFileName As String
 Dim outFileName As String
 Dim inFileNum As Integer
 Dim outFileNum As Integer
 Dim inByte() As Byte
 Dim char As Byte
 Dim outString As String
 Dim numReadBytes As Long
 
Do
 'Ask the user which file to encode with the CommonDialog control
 On Error GoTo UserCancelled
 CommonDialog1.ShowOpen
 On Error GoTo 0
 inPathFileName = CommonDialog1.FileName    'Got our path/filenam
 
 For i = Len(inPathFileName) To 1 Step -1   'Strip off the pathname
  If Mid(inPathFileName, i, 1) = "\" Then
   inFileName = Mid(inPathFileName, i + 1)
   Exit For
  End If
 Next
 
 outFileName = Left(inPathFileName, Len(inPathFileName) - 4) & ".uue"
 
 'Don't let the user re-encode an already-encoded file.
 If UCase(Right(inPathFileName, 3)) = "UUE" Then
  MsgBox "That file is already encoded.  Try another one", vbInformation, _
         "Error!"
 End If
Loop Until UCase(Right(inPathFileName, 3)) <> "UUE"
 
 'open our input and output files.
 inFileNum = FreeFile
 Open inPathFileName For Binary Access Read Lock Read As #inFileNum
 outFileNum = FreeFile
 Open outFileName For Output As #outFileNum
 ProgressBar1.Max = LOF(inFileNum) + 1
 ProgressBar1.Value = 0
 
 'Write the header to the UUEncoded file.
 Print #outFileNum, "begin 644 " & inFileName
 
 'Begin our UUEncode loop.
 Debug.Print "Time Started: " & Time$
 Do
  DoEvents      'allow other things to happen while UUEncoding
  
  'Read in 45 bytes of data if we haven't hit EndOfFile.
  numReadBytes = LOF(inFileNum) - Loc(inFileNum) + 1 'How many bytes are left?
  If numReadBytes > 45 Then numReadBytes = 45   'more than 45, so read 45
  ReDim inByte(1 To numReadBytes)
  Get #inFileNum, , inByte
  ProgressBar1.Value = ProgressBar1.Value + numReadBytes
  
  'Start encoding of the bytes we've just read in.
  For i = 1 To (numReadBytes - 2) Step 3
   char = inByte(i) And 252  'strip off the 2 LSB's
   If char = 0 Then
    char = 96                'use a ` instead of a space
   Else
    char = (char / 4) + 32    'do a SHR char,2 then add 32 to result
   End If
   outString = outString & Chr(char) 'out Byte 1 of 4
   
   If (i + 1) <= numReadBytes Then
    char = inByte(i + 1) And 240      'strip off the 4 LSB's
    char = char / 16                  'do a SHR char,4
   Else
    char = 0
   End If
   char = char + ((inByte(i) And 3) * 16) + 32
   If char = 32 Then char = 96       'use a ` instead of a space
   outString = outString & Chr(char) 'out Byte 2 of 4
   
   If (i + 2) <= numReadBytes Then
    char = inByte(i + 2) And 192     'strip off the 6 LSB's
    char = char / 64                 'do a SHR char,6
   Else
    char = 0
   End If
   If (i + 1) <= numReadBytes Then
    char = char + ((inByte(i + 1) And 3) * 4)
    char = char + ((inByte(i + 1) And 12) * 4) + 32
    If char = 32 Then char = 96      'use a ` instead of a space
    outString = outString & Chr(char) 'out Byte 3 of 4
   End If
   
   If (i + 2) <= numReadBytes Then
    char = inByte(i + 2) And 63    'Strip off the 2 MSB's
    char = char + 32
    If char = 32 Then char = 96    'use a ` instead of a space
    outString = outString & Chr(char) 'out Byte 4 of 4
   End If
  Next
  
  outString = Chr(numReadBytes + 32) & outString 'add the length character
  Print #outFileNum, outString  'print it to the output file
  outString = ""                'reset our output string to nothing
 Loop Until EOF(inFileNum)
  
 Close #inFileNum
 Print #outFileNum, "end"
 Print #outFileNum, "This file created by vbUUE, copyright Terry R. Olsen"
 Close #outFileNum              'done UUEncoding, close output file
 ProgressBar1.Value = 0
 Debug.Print "Time Completed: " & Time$
 
UserCancelled:
End Sub