home *** CD-ROM | disk | FTP | other *** search
/ Media Share 9 / MEDIASHARE_09.ISO / basic / sortsubs.zip / SORTSUBS.BAS < prev    next >
BASIC Source File  |  1993-07-11  |  4KB  |  165 lines
  1. 'SortSubs PowerBASIC Sub/Function Organizer
  2. '(C) Copyright 1993 by Tim Gerchmez
  3.  
  4. 'This source code is freeware - free for
  5. 'noncommercial use.  Modified versions of
  6. 'this program, whether in source or .exe
  7. 'format, may not be distributed.
  8.  
  9. cls:print "SortSubs PowerBASIC Sub/Function Organizer"
  10.     print "(C) Copyright 1993 by Tim Gerchmez."
  11.     print "Freeware - No Charge for Noncommercial Use."
  12.     print
  13. cd$=curdir$
  14. line input "Path: ";p$
  15. if p$="" then goto skippath
  16. if right$(p$,1)="\" then p$=left$(p$,len(p$)-1)
  17. chdir p$
  18. skippath:
  19. if dir$("*.bas")="" then
  20.     print "No BASIC Files in This Directory."
  21.     chdir cd$
  22.     end
  23. end if
  24. cls:files "*.bas":print
  25. line input "File to Sort (No Path): ";f$
  26. if f$="" then chdir cd$:end
  27. if instr(f$,".")=0 then f$=f$+".bas"
  28. print "Use Dividers between Subs? (Y/N): ";:locate,,1
  29. while not instat:wend
  30. a$=inkey$
  31. if lcase$(a$)="y" then divider%=1 else divider%=0
  32. print:print:print "Checking File - ";
  33. open "i",#1,f$:ct%=0
  34. while eof(1)=0
  35. line input #1,a$:a$=lcase$(a$)
  36. if left$(a$,4)="sub " or left$(a$,9)="function " then
  37.     ct%=ct%+1
  38. end if
  39. wend
  40. close #1:print ct%;"Subs/Functions Found."
  41. if ct%=0 then chdir cd$:end
  42. redim sf$(1:ct%),sg$(1:ct%):print:print "Loading Sub/Function Names...":c%=0
  43. open "i",#1,f$
  44. while eof(1)=0
  45. line input #1,a$:b$=lcase$(a$)
  46. if left$(b$,4)="sub " or left$(b$,9)="function " then
  47.     c%=c%+1
  48.     sf$(c%)=a$
  49. end if
  50. wend
  51. close #1
  52. for t%=1 to c%
  53.     a$=lcase$(sf$(t%))
  54.     if left$(a$,4)="sub " then
  55.         sg$(t%)=right$(a$,len(a$)-4)
  56.     end if
  57.     if left$(a$,9)="function " then
  58.         sg$(t%)=right$(a$,len(a$)-9)
  59.     end if
  60. next t%
  61. print "Sorting..."
  62. array sort sg$(),collate ucase,tagarray sf$()
  63. erase sg$
  64. open "o",#2,"temp.$$$"
  65. print "Writing File (May Take Awhile)... ";:locate,,1
  66.  
  67. 'Pass1 - Write Non Sub/Fn Text
  68.  
  69. close #1
  70. open "i",#1,f$
  71. while eof(1)=0
  72. line input #1,a$
  73. for t%=1 to c%
  74. if a$=sf$(t%) then
  75.     do
  76.     line input #1,a$
  77.     a$=lcase$(a$)
  78.  
  79. 'Strip Quoted Material
  80.     qm%=0:q$=""
  81.     for zz%=1 to len(a$)
  82.     q%=asc(mid$(a$,zz%,1))
  83.     if q%=34 then qm%=1-qm%
  84.     if qm%=0 and q%<>34 then q$=q$+chr$(q%)
  85.     next zz%
  86.     a$=q$
  87.  
  88. 'Strip REMs
  89.     zz% = INSTR(a$, "rem ")
  90.     if zz%<>0 then
  91.         a$ = LTRIM$(LEFT$(a$, zz% - 1))
  92.         if zz%=1 then a$=""
  93.     end if
  94.     zz% = INSTR(a$, "'")
  95.     IF zz% <> 0 THEN
  96.         a$ = LTRIM$(LEFT$(a$, zz% - 1))
  97.         if zz%=1 then a$=""
  98.     end if
  99.  
  100. 'If no END SUB then loop
  101.     if instr(a$,"end sub") <> 0 then goto nextpointx
  102.     if instr(a$,"end function") <> 0 then goto nextpointx
  103.     loop
  104. end if
  105. next t%
  106. if a$<>"" then print #2,a$
  107. nextpointx:
  108. wend
  109.  
  110. 'Pass2 - Write Sub/Fn Text
  111. close #1
  112. for t%=1 to c%
  113. close #1
  114. open "i",#1,f$
  115. while eof(1)=0
  116. line input #1,a$
  117. if a$=sf$(t%) then
  118.     print #2,chr$(13);chr$(10);
  119.     if divider%=1 then print #2,"'";string$(78,"-")
  120.     print #2,a$
  121.  
  122.     do
  123.     line input #1,a$
  124.     print #2,a$
  125.     a$=lcase$(a$)
  126.  
  127. 'Strip Quoted Material
  128.     qm%=0:q$=""
  129.     for zz%=1 to len(a$)
  130.     q%=asc(mid$(a$,zz%,1))
  131.     if q%=34 then qm%=1-qm%
  132.     if qm%=0 then q$=q$+chr$(q%)
  133.     next zz%
  134.     a$=q$
  135.  
  136. 'Strip REMs
  137.     zz% = INSTR(a$, "rem ")
  138.     if zz%<>0 then
  139.         a$ = LTRIM$(LEFT$(a$, zz% - 1))
  140.         if zz%=1 then a$=""
  141.     end if
  142.     zz% = INSTR(a$, "'")
  143.     IF zz% <> 0 THEN
  144.         a$ = LTRIM$(LEFT$(a$, zz% - 1))
  145.         if zz%=1 then a$=""
  146.     end if
  147.  
  148. 'If no END SUB then loop
  149.     if instr(a$,"end sub") <> 0 then goto nextpoint
  150.     if instr(a$,"end function") <> 0 then goto nextpoint
  151.     loop
  152. end if
  153. wend
  154. nextpoint:
  155. next t%
  156. close #1:close #2
  157. q%=instr(f$,".")
  158. on error resume next
  159. z$=left$(f$,q%-1)+".bak"
  160. kill z$
  161. name f$ as z$
  162. name "temp.$$$" as f$
  163. chdir cd$
  164. print:print:print "Done!"
  165.