home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / archives / uniflex.tar.gz / uniflex.tar / ufuboo.bas < prev    next >
BASIC Source File  |  1993-08-23  |  2KB  |  55 lines
  1. 10   rem This program is used to unpack the UniFLEX kermit BOO files.
  2. 20  width 0
  3. 30  n$ = chr$(0)
  4. 40  z = asc("0")
  5. 50  t = asc("~")-z
  6. 60  k$ = "ufksup.boo"
  7. 70  open old k$ as 1
  8. 80  input #1,f$                        :rem Get the file name
  9. 90  open new f$ as 2
  10. 100  gosub 180
  11. 110  k$ = "ufkrmt.boo"
  12. 120  open old k$ as 1
  13. 130  input #1,f$                        :rem Get the file name
  14. 140  open new f$ as 2
  15. 150  gosub 180
  16. 160  print "Processing completed."
  17. 170  exit
  18. 180  print k$;" ==> ";f$
  19. 190  on error goto 500
  20. 200  input #1,x$                        :rem Get a line.
  21. 210  y$ = ""                            :rem Clear the output buffer.
  22. 220  goto 250
  23. 230  print #2,y$;                       :rem Print output buffer to file.
  24. 240  goto 200                           :rem Get another line.
  25. 250  if len(x$) < 2 goto 230            :rem Is the input buffer empty?
  26. 260  a = asc(x$) - z
  27. 270  if a = t then goto 400             :rem Null repeat character?
  28. 280  if len(x$) < 3 goto 230            :rem Is the input buffer empty?
  29. 290  q$ = mid$(x$,2,3)                  :rem Get the quadruplet to decode.
  30. 300  x$ = mid$(x$,5)
  31. 310  b = asc(q$)-z
  32. 320  q$ = mid$(q$,2)
  33. 330  c = asc(q$)-z
  34. 340  q$ = mid$(q$,2)
  35. 350  d = asc(q$)-z
  36. 360  y$ = y$ + chr$(((a * 4) + (b / 16)) and 255) :rem Decode the quad.
  37. 370  y$ = y$ + chr$(((b * 16) + (c / 4)) and 255)
  38. 380  y$ = y$ + chr$(((c * 64) + d) and 255)
  39. 390  goto 250                           :rem Get another quad.
  40. 400  x$ = mid$(x$,2)                    :rem Expand the nulls.
  41. 410  r = asc(x$) - z                    :rem Get the number of nulls.
  42. 420  x$ = mid$(x$,2)
  43. 430  for i = 1 to r                     :rem Loop, adding nulls to string.
  44. 440     y$ = y$ + n$
  45. 450  next i
  46. 460  print #2,y$;                       :rem Output the nulls to the file.
  47. 470  y$ = ""                            :rem Clear the output buffer.
  48. 480  goto 250
  49. 490  return
  50. 500  if err <> 8 then goto 530
  51. 510  close 1,2
  52. 520  resume 490
  53. 530  print "Error: ",err
  54. 540  stop
  55.