home *** CD-ROM | disk | FTP | other *** search
/ High Voltage Shareware / high1.zip / high1 / DIR3 / FMSFMT10.ZIP / FMSFMT.BAS < prev    next >
BASIC Source File  |  1993-12-29  |  29KB  |  1,047 lines
  1. DECLARE SUB Trim (TrimParm$)
  2. DECLARE SUB SQOutBlanks (Strng$)
  3. DECLARE SUB SubZero (Work$)
  4. DECLARE SUB NameSizeDateDesc (InStrng$, IsOK%)
  5. DECLARE SUB TrimTrail (TrimParm$, TrimThis$)
  6. DECLARE SUB RemoveBlanks (Strng$)
  7. DECLARE SUB IncludeParse (IncludeThis$, ParseThis$, Words$(), NumFound%)
  8. ' to do: support chaining
  9. '        support chained target
  10. DEFINT A-Z
  11. COMMON SHARED StartNameAt, StartDateAt, StartSizeAt, StartDescAt, OutTemplate$, GotName, GotSize, GotDate, GotDesc, StartIsFMS, DIZUsed
  12. DECLARE FUNCTION NameKey$ (X$)
  13. DECLARE FUNCTION ParmValue$ (Rec$, ParmKey$, Default$)
  14. DECLARE FUNCTION DateKey$ (X$)
  15.  
  16. DIM TargetHold$(23), MergeHold$(23)
  17. ON ERROR GOTO 0
  18. PRINT "FMSFMT ver 1.0 12-29-93  An RBBS Utility to Reformat/Merge Directories"
  19. PRINT "Copyright (c) 1993 by Ken Goosens"
  20. PRINT
  21. FALSE = 0
  22. TRUE = NOT FALSE
  23. InvalidFileChars$ = "/\[]:|<>+=;,*?" + CHR$(34)
  24. NumInvalid = 0
  25. NewRow = 15
  26. StartDir$ = "CDMASTER.DIR"
  27. MergeTo$ = ""
  28. NewDir$ = "MASTER.DIR"
  29. AddCat$ = ""
  30. SearchCats$ = ","
  31. ReplaceCats$ = ","
  32. NumSubs = 0
  33. NumBad = 0
  34. HoldCat$ = "   "
  35. StartNameAt = 1
  36. StartDateAt = 24
  37. StartSizeAt = 15
  38. StartDescAt = 34
  39. ConvertFields = FALSE
  40. CombineExtended = FALSE
  41. TruncateDesc = TRUE
  42. TargetSortedByDate = TRUE
  43. LineFeed$ = CHR$(10)
  44. CarriageReturn$ = CHR$(13)
  45. EndofWord$ = " " + LineFeed$ + CarriageReturn$
  46. WorkCmnd$ = COMMAND$ + " "
  47. IF LEN(WorkCmnd$) > 1 THEN
  48.    ConfigFile$ = LEFT$(WorkCmnd$, INSTR(WorkCmnd$, " ") - 1)
  49.    CALL Trim(ConfigFile$)
  50. END IF
  51. IF ConfigFile$ = "" OR LEFT$(ConfigFile$, 1) = "/" THEN
  52.    ConfigFile$ = "FMSFMT.CFG"
  53. END IF
  54. WorkIn$ = WorkCmnd$
  55. GOSUB ParseCmnd
  56.  
  57.    ON ERROR GOTO 40200
  58.    IF Sharing THEN
  59.       OPEN ConfigFile$ FOR INPUT SHARED AS #4
  60.    ELSE
  61.       OPEN ConfigFile$ FOR INPUT AS #4
  62.    END IF
  63.    ON ERROR GOTO 0
  64.    'ON ERROR GOTO 50000
  65.  
  66. RunAgain:  ' entry point when making multiple runs from config
  67.  
  68. IsOK = TRUE
  69. GOSUB ReadConfig
  70. IF NewLen > 0 AND NewLen < 76 THEN
  71.    PRINT "/NewLen= in config must set at least 76 chars, not"; NewLen
  72.    GOTO 50100
  73. END IF
  74. IF Title$ <> "" THEN
  75.    PRINT Title$
  76. END IF
  77. 'ON ERROR GOTO 40000
  78. KeyLen = 13 + TargetSortedByDate * 7
  79. HighValues$ = STRING$(KeyLen, 255)
  80. LowValues$ = STRING$(KeyLen, 0)
  81. KeyFrom$ = LowValues$
  82. ON ERROR GOTO 40000
  83. IF Sharing THEN
  84.    OPEN StartDir$ FOR INPUT SHARED AS #1
  85. ELSE
  86.    OPEN StartDir$ FOR INPUT AS #1
  87. END IF
  88. ON ERROR GOTO 50000
  89. IF MergeTo$ <> "" THEN KeyTo$ = LowValues$
  90. GOSUB OpenTarget
  91.  
  92. ON ERROR GOTO 50050
  93. OPEN NewDir$ FOR OUTPUT AS #3
  94. ON ERROR GOTO 0
  95. IF INSTR(ToHeader$, " NOSORT ") > 0 THEN TargetSortedByDate = FALSE
  96. OutLen = LEN(ToRec$)
  97. IF OutLen < 76 AND OutLen > 0 THEN
  98.    PRINT "Target file "; MergeTo$; " NOT an FMS file"
  99.    PRINT "First line must be at least 76 chars long, not"; OutLen
  100.    GOTO 50100
  101. END IF
  102. IF NewLen > 75 THEN
  103.    OutLen = NewLen
  104. END IF
  105. AddingCat = (AddCat$ <> "")
  106. AddingDate = (AddDate$ <> "")
  107. AddingDesc = (AddDesc$ <> "")
  108. OutTemplate$ = SPACE$(OutLen)
  109. StartCatCode = OutLen - 2
  110. DoubleHV$ = STRING$(2,255)
  111. IF KeyTo$ <> HighValues$ AND MergeTo$ <> "" THEN
  112.    KeyTo$ = LowValues$
  113. END IF
  114. IF StartNameAt <> 1 OR StartDate <> 24 OR StartSizeAt <> 15 OR StartDescAt <> 35 THEN
  115.       ConvertFields = TRUE
  116. END IF
  117. PRINT "Convert fields.. ";
  118. IF ConvertFields THEN
  119.    PRINT "Yes"
  120. ELSE
  121.    PRINT "No"
  122. END IF
  123. PRINT "Name begins col "; StartNameAt
  124. PRINT "Size begins col "; StartSizeAt
  125. PRINT "Date begins col "; StartDateAt
  126. PRINT "Desc begins col "; StartDescAt
  127. PRINT "Start dir format ";
  128. IF StartIsFMS THEN
  129.    PRINT "FMS"
  130. ELSE
  131.    PRINT "Non-FMS"
  132. END IF
  133. PRINT "Extended descriptions in start ";
  134. IF NoExtended THEN
  135.    PRINT "<none>"
  136. ELSE
  137.    IF ExtendedBeforeName THEN
  138.       PRINT "Before name"
  139.    ELSE
  140.       PRINT "After name"
  141.    END IF
  142. END IF
  143. PRINT "Use DIZ for desc ";
  144. IF StartUseDIZ THEN
  145.    PRINT "Yes"
  146. ELSE
  147.    PRINT "No"
  148. END IF
  149. PRINT "Adding cat code. ";
  150. IF AddingCat THEN
  151.    PRINT AddCat$
  152. ELSE
  153.    PRINT "<none>"
  154. END IF
  155. PRINT "Adding date .... ";
  156. IF AddingDate THEN
  157.    PRINT AddDate$
  158. ELSE
  159.    PRINT "<none>"
  160. END IF
  161. PRINT "Adding desc .... ";
  162. IF AddingDesc THEN
  163.    PRINT AddDesc$
  164. ELSE
  165.    PRINT "<none>"
  166. END IF
  167. PRINT "Sub cat codes... ";
  168. IF LEN(ReplaceCats$) > 1 THEN
  169.    PRINT "Yes"
  170.   'print SearchCats$
  171.   'print Replacecats$
  172.   'end
  173. ELSE
  174.    PRINT "No"
  175. END IF
  176. PRINT "Files sorted by. ";
  177. IF TargetSortedByDate THEN
  178.    PRINT "Date"
  179. ELSE
  180.    PRINT "Name"
  181. END IF
  182. PRINT "Combine Extended ";
  183. IF CombineExtended THEN
  184.    PRINT "Yes"
  185. ELSE
  186.    PRINT "No"
  187. END IF
  188. PRINT "Starting dir.... "; StartDir$; "  ";
  189. MergeCol = POS(0)
  190. MaxCol = MergeCol
  191. PRINT
  192. PRINT "Merging into.... ";
  193. IF MergeTo$ = "" THEN
  194.    PRINT "<none>";
  195. ELSE
  196.    PRINT MergeTo$; "  ";
  197. END IF
  198. TargetCol = POS(0)
  199. IF TargetCol > MaxCol THEN MaxCol = TargetCol
  200. PRINT
  201. PRINT "New dir......... "; NewDir$; "  ";
  202. NewCol = POS(0)
  203. PRINT
  204. PRINT "Length new dir.."; OutLen
  205. PRINT "Header.......... ";
  206. IF Header$ = "" THEN
  207.    PRINT "<none>"
  208. ELSE
  209.    PRINT Header$
  210. END IF
  211. PRINT : PRINT "A to abort, anything else runs";
  212. IF RunBatch THEN
  213.    PRINT " (run batch)"
  214. ELSE
  215.    INPUT ""; ANS$
  216.    ANS$ = UCASE$(ANS$)
  217.    IF ANS$ = "A" THEN END
  218. END IF
  219.  
  220. IF NewCol > MaxCol THEN MaxCol = NewCol
  221. MergeCol = MaxCol
  222. TargetCol = MaxCol
  223. NewCol = MaxCol
  224. SubCol = MaxCol - 1
  225. NewRow = CSRLIN - 4
  226. TargetRow = NewRow - 1
  227. MergeRow = TargetRow - 1
  228. SubRow = MergeRow - 1
  229. AddingCat = (AddCat$ <> "")
  230. GotName = (StartNameAt > 0)
  231. GotSize = (StartSizeAt > 0)
  232. GotDate = (StartDateAt > 0)
  233. GotDesc = (StartDescAt > 0)
  234. GOSUB ReadMerge
  235. IF KeyTo$ < HighValues$ THEN
  236.    GOSUB ReadTarget
  237. END IF
  238. IF Header$ <> "" THEN
  239.    LSET OutTemplate$ = SPACE$(OutLen)
  240.    LSET OutTemplate$ = Header$
  241.    MID$(OutTemplate$, StartCatCode) = "  ."
  242.    GOSUB OutPutNew
  243. END IF
  244.  
  245. WHILE KeyTo$ < HighValues$ OR KeyFrom$ < HighValues$
  246.  
  247.    WHILE KeyTo$ < KeyFrom$
  248.       GOSUB OutPutTarget
  249.       GOSUB ReadTarget
  250.    WEND
  251.    WHILE KeyFrom$ < KeyTo$
  252.       GOSUB OutPutMerge
  253.       GOSUB ReadMerge
  254.    WEND
  255.    WHILE KeyTo$ = KeyFrom$ AND KeyFrom$ <> HighValues$
  256.       GOSUB OutPutMerge
  257.       GOSUB ReadMerge
  258.    WEND
  259.  
  260. WEND
  261. GOSUB PositionDown
  262. IF NumInvalid > 0 THEN
  263.    PRINT NumInvalid; " lines excluded because of invalid chars in names"
  264. END IF
  265. IF NumBad > 0 THEN
  266.    PRINT NumBad; " lines excluded because of invalid file size/extensions"
  267. END IF
  268. NumInvalid = 0
  269. NumBad = 0
  270. CLOSE 1,2,3
  271. IF NOT EOF(4) THEN GOTO RunAgain  ' more runs in config?
  272. CLOSE 4
  273. END
  274.  
  275. '-------------------  GOSUBS --------------------
  276.  
  277. ParseCmnd:
  278.  
  279.    IF LEFT$(WorkCmnd$, 2) = "H " THEN
  280.       GOSUB HelpScreen
  281.    END IF
  282.    X = INSTR(WorkCmnd$, "/BATCH")
  283.    RunBatch = (X > 0) OR RunBatch
  284.    X = INSTR(WorkCmnd$,"/TITLE=")
  285.    IF X > 0 THEN 
  286.       Title$ = Title$ + RIGHT$(WorkIn$, LEN(WorkIn$) - 7) + CHR$(13)
  287.    END IF
  288.    X = INSTR(WorkCmnd$,"/HEADER=")
  289.    IF X > 0 THEN
  290.       Header$ = RIGHT$(WorkCmnd$, LEN(WorkCmnd$) - 8)
  291.       CALL Trim (Header$)
  292.    END IF
  293.    X = INSTR (WorkCmnd$,"/ADDDESC=")
  294.    IF X > 0 THEN
  295.      AddDesc$ = RIGHT$(WorkIn$, LEN(WorkIn$) - 9)
  296.      CALL Trim (AddDesc$)
  297.    END IF
  298.    CALL SQOutBlanks(WorkCmnd$)
  299.    X = INSTR(WorkCmnd$,"/SHARING")
  300.    Sharing = (X > 0 OR Sharing)
  301.    StartDir$ = ParmValue$(WorkCmnd$, "/STARTDIR=", StartDir$)
  302.    StartIsFMS = StartIsFMS OR (INSTR(WorkCmnd$, "/STARTISFMS") > 0)
  303.    ConvertFields = ConvertFields OR (INSTR(WorkCmnd$, "/CONVERTFIELDS") > 0)
  304.    CombineExtended = CombineExtended OR (INSTR(WorkCmnd$, "/COMBINEEXTENDED") > 0)
  305.    TruncateDesc = TruncateDesc OR (INSTR(WorkCmnd$, "/TRUNCATEDESC") > 0)
  306.    ExtendedBeforeName = ExtendedBeforeName OR (INSTR(WorkCmnd$,"/EXTENDEDBEFORENAME") > 0)
  307.    IF INSTR(WorkCmnd$,"/EXTENDEDAFTERNAME") > 0 THEN ExtendedBeforeName = FALSE
  308.    IF INSTR(WorkCmnd$,"/TARGETSORTEDBYDATE") > 0 THEN TargetSortedByDate = TRUE
  309.    IF INSTR(WorkCmnd$,"/TARGETSORTEDBYNAME") > 0 THEN TargetSortedByDate = FALSE
  310.    IF INSTR(WorkCmnd$,"/STARTUSEDIZ") > 0 THEN StartUseDIZ = TRUE
  311.    IF INSTR(WorkCmnd$,"/TARGETUSEDIZ") > 0 THEN TargetUseDIZ = TRUE
  312.  
  313.    IF INSTR(WorkCmnd$,"/NOEXTENDED") > 0 THEN NoExtended = TRUE
  314.    StartNameAt = VAL(ParmValue$(WorkCmnd$, "/STARTNAMEAT=", STR$(StartNameAt)))
  315.    StartDateAt = VAL(ParmValue$(WorkCmnd$, "/STARTDATEAT=", STR$(StartDateAt)))
  316.    StartSizeAt = VAL(ParmValue$(WorkCmnd$, "/STARTSIZEAT=", STR$(StartSizeAt)))
  317.    StartDescAt = VAL(ParmValue$(WorkCmnd$, "/STARTDESCAT=", STR$(StartDescAt)))
  318.    NewLen = VAL(ParmValue$(WorkCmnd$, "/NEWLEN=", STR$(NewLen)))
  319.    MergeTo$ = ParmValue$(WorkCmnd$, "/MERGETO=", MergeTo$)
  320.    NewDir$ = ParmValue$(WorkCmnd$, "/NEWDIR=", NewDir$)
  321.    AddCat$ = ParmValue$(WorkCmnd$, "/ADDCAT=", AddCat$)
  322.    AddDate$ = ParmValue$(WorkCmnd$, "/ADDDATE=", AddDate$)
  323.    IF AddDate$ = "TODAY" THEN
  324.       X$ = DATE$
  325.       AddDate$ = LEFT$(X$, 6) + RIGHT$(X$, 2)
  326.    END IF
  327.    X$ = ParmValue$(WorkCmnd$, "/REPLACECAT=", "/")
  328.    IF X$ <> "/" THEN
  329.       IF LEN(X$) >= 6 THEN
  330.          SearchCats$ = SearchCats$ + LEFT$(X$, 3) + ","
  331.          ReplaceCats$ = ReplaceCats$ + RIGHT$(X$, 3) + ","
  332.       ELSE
  333.          DO WHILE LEFT$(X$, 3) <> "END" AND NOT EOF(4)
  334.             LINE INPUT #4, X$
  335.             NumCnfg = NumCnfg + 1
  336.             LOCATE CnfgRow, CnfgCol
  337.             PRINT NumCnfg;
  338.  
  339.             IF LEN(X$) >= 6 THEN
  340.                SearchCats$ = SearchCats$ + LEFT$(X$, 3) + ","
  341.                ReplaceCats$ = ReplaceCats$ + RIGHT$(X$, 3) + ","
  342.             END IF
  343.          LOOP
  344.       END IF
  345.    END IF
  346.  
  347. RETURN
  348.  
  349. HelpScreen:
  350.  
  351. RETURN
  352.  
  353. ReadConfig:
  354.  
  355.    PRINT "Config file..... "; ConfigFile$; " ";
  356.    CnfgCol = POS(0)
  357.    CnfgRow = CSRLIN
  358.    NumCnfg = 0
  359.    WorkCmnd$ = ""
  360.    WHILE NOT EOF(4) AND LEFT$(WorkCmnd$,4) <> "/RUN"
  361.       NumCnfg = NumCnfg + 1
  362.       LOCATE CnfgRow, CnfgCol
  363.       PRINT NumCnfg;
  364.       LINE INPUT #4,WorkCmnd$
  365.       IF LEFT$(WorkCmnd$, 1) <> "*" AND WorkCmnd$ <> "" THEN
  366.          WorkIn$ = WorkCmnd$
  367.          WorkCmnd$ = UCASE$(WorkCmnd$) + " "
  368.          GOSUB ParseCmnd
  369.       END IF
  370.    WEND
  371. ExitConfig:  
  372.    PRINT
  373. RETURN
  374.  
  375. OpenTarget:
  376.  
  377.    IF MergeTo$ = "" THEN
  378.       KeyTo$ = STRING$(KeyLen, 255)
  379.       RETURN
  380.    END IF
  381.    ON ERROR GOTO 40100
  382.    CLOSE 2
  383.    IF Sharing THEN
  384.       OPEN MergeTo$ FOR INPUT SHARED AS #2
  385.    ELSE
  386.       OPEN MergeTo$ FOR INPUT AS #2
  387.    END IF
  388.    ON ERROR GOTO 50000
  389.    IF NOT EOF(2) THEN
  390.       LINE INPUT #2, ToRec$
  391.       ToHeader$ = ToRec$
  392.       IF LEFT$(ToHeader$, 4) <> "\FMS" THEN
  393.          ToHeader$ = ""
  394.       END IF
  395.    ELSE
  396.       KeyTo$ = HighValues$
  397.    END IF
  398.    Temp = INSTR(ToHeader$, " CH(")
  399.    IF Temp > 0 THEN
  400.       EndPos = INSTR(Temp, ToHeader$, ")")
  401.       IF EndPos > 0 THEN
  402.          ChainTo$ = MID$(ToHeader$, Temp + 4, EndPos - Temp - 4)
  403.       END IF
  404.       ChainTo$ = "" 'temporary override to inactivate feature
  405.    ELSE
  406.       ChainTo$ = ""
  407.    END IF
  408.    TargetSortedByDate = (INSTR(ToHeader$, " NOSORT") = 0)
  409.    'ON ERROR GOTO 40100
  410.    CLOSE 2
  411.    ON ERROR GOTO 40100
  412.    IF Sharing THEN
  413.       OPEN MergeTo$ FOR INPUT SHARED AS #2
  414.    ELSE
  415.       OPEN MergeTo$ FOR INPUT AS #2
  416.    END IF
  417.    ON ERROR GOTO 0
  418.  
  419. RETURN
  420.  
  421. ReadMerge:
  422.  
  423.    NewItem = FALSE
  424.    DO
  425.       IF EOF(1) AND FromHold$ = "" THEN
  426.          KeyFrom$ = HighValues$
  427.          NewItem = TRUE
  428.          CLOSE 1
  429.       ELSE
  430.          IF FromHold$ <> "" THEN
  431.             FromRec$ = FromHold$
  432.             FromHold$ = ""
  433.          ELSE
  434.             LINE INPUT #1, FromRec$
  435.          END IF
  436.          X = INSTR(FromRec$, "Directory of ")
  437.          IF X > 0 THEN
  438.             FileLoc$ = MID$(FromRec$,X+12)
  439.             CALL Trim (FileLoc$)
  440.             X = INSTR(FileLoc$," ")
  441.             IF X > 0 THEN
  442.                FileLoc$ = LEFT$(FileLoc$,X-1)
  443.             END IF
  444.             IF RIGHT$(FileLoc$,1) <> "\" THEN FileLoc$ = FileLoc$ + "\"
  445.          END IF
  446.          TypeLine$ = LEFT$(FromRec$, 1)
  447.          IF NoExtended AND TypeLine$ = " " THEN TypeLine$ = "?"
  448.          SELECT CASE TypeLine$
  449.          
  450.          CASE " "
  451.             IF NumMergeHold < 23 THEN
  452.                NumMergeHold = NumMergeHold + 1
  453.                MergeHold$(NumMergeHold) = FromRec$
  454.             END IF
  455.          CASE "*", "\"
  456.             LSET OutTemplate$ = FromRec$ 
  457.             GOSUB OutPutNew
  458.          CASE ""
  459.             ' skip empty lines
  460.          CASE ELSE
  461.                       ' get any extended desc after name
  462.             IF (NOT NoExtended) AND NOT ExtendedBeforeName THEN
  463.                IF NOT EOF(1) THEN
  464.                   FromHold$ = FromRec$
  465.                   LINE INPUT #1, FromRec$
  466.                   WHILE LEFT$(FromRec$,1) = " "
  467.                      IF NumMergeHold < 23 THEN
  468.                         NumMergeHold = NumMergeHold + 1
  469.                         MergeHold$(NumMergeHold) = FromRec$
  470.                      END IF
  471.                      IF NOT EOF(1) THEN
  472.                         LINE INPUT #1, FromRec$
  473.                      ELSE
  474.                         FromRec$ = ""
  475.                      END IF
  476.                   WEND
  477.                   SWAP FromHold$,FromRec$
  478.                END IF
  479.             END IF
  480.  
  481.             NewItem = TRUE
  482.             IF TargetSortedByDate THEN
  483.                IF AddingDate THEN
  484.                   X$ = AddDate$
  485.                ELSE
  486.                   X$ = MID$(FromRec$, StartDateAt, 8)
  487.                END IF
  488.                LSET KeyFrom$ = MID$(X$, 7, 2) + MID$(X$, 1, 2) + MID$(X$, 4, 2)
  489.                CALL SubZero(KeyFrom$)
  490.             ELSE
  491.                LSET KeyFrom$ = MID$(FromRec$, StartNameAt, 13)
  492.             END IF
  493.             LOCATE MergeRow, MergeCol
  494.             PRINT KeyFrom$;
  495.          END SELECT
  496.       END IF
  497.    LOOP UNTIL NewItem
  498.  
  499. RETURN
  500.  
  501. ReadTarget:
  502.  
  503.    NewItem = FALSE
  504.    DO
  505.       IF EOF(2) AND TargetHold$ = "" THEN
  506.          IF ChainTo$ = "" THEN
  507.             NewItem = TRUE
  508.             KeyTo$ = HighValues$
  509.             CLOSE 2
  510.          ELSE
  511.             MergeTo$ = ChainTo$
  512.             GOSUB OpenTarget
  513.          END IF
  514.       ELSE
  515.          IF TargetHold$ <> "" THEN
  516.             ToRec$ = TargetHold$
  517.             TargetHold$ = ""
  518.          ELSE
  519.             LINE INPUT #2, ToRec$
  520.          END IF
  521.          TypeLine$ = LEFT$(ToRec$, 1)
  522.          SELECT CASE TypeLine$
  523.          CASE " "
  524.             IF NumTargetHold < 23 THEN
  525.                NumTargetHold = NumTargetHold + 1
  526.                TargetHold$(NumTargetHold) = ToRec$
  527.             END IF
  528.          CASE "*", "\"
  529.             GOSUB OutPutTarget
  530.          CASE ""
  531.             ' skip blank lines
  532.          CASE ELSE
  533.             IF NOT TargetSortedByDate THEN ' Get extended after name
  534.                IF NOT EOF(2) THEN
  535.                   TargetHold$ = ToRec$
  536.                   LINE INPUT #2, ToRec$
  537.                   WHILE LEFT$(ToRec$,1) = " "
  538.                      IF NumTargetHold < 23 THEN
  539.                         NumTargetHold = NumTargetHold + 1
  540.                         TargetHold$(NumTargetHold) = ToRec$
  541.                      END IF
  542.                      IF NOT EOF(2) THEN
  543.                         LINE INPUT #2, ToRec$
  544.                      ELSE
  545.                         ToRec$ = ""
  546.                      END IF
  547.                   WEND
  548.                   SWAP TargetHold$,ToRec$
  549.                END IF
  550.             END IF
  551.  
  552.             NewItem = TRUE
  553.             IF TargetSortedByDate THEN
  554.                LSET KeyTo$ = DateKey$(ToRec$)
  555.             ELSE
  556.                LSET KeyTo$ = NameKey$(ToRec$)
  557.             END IF
  558.             LOCATE TargetRow, TargetCol
  559.             PRINT KeyTo$;
  560.          END SELECT
  561.       END IF
  562.    LOOP UNTIL NewItem
  563.  
  564. RETURN
  565.  
  566. OutPutMerge:
  567.  
  568.    IF StartNameAt > LEN(FromRec$) THEN ' Check for valid file name
  569.       Work$ = "*"
  570.    ELSE
  571.       Work$ = MID$(FromRec$,StartNameAt, 13) + "*"
  572.    END IF
  573.    I = 1
  574.    DO UNTIL INSTR(InvalidFileChars$, MID$(Work$, I, 1)) > 0
  575.       I = I + 1
  576.    LOOP
  577.    IF I < LEN(Work$) OR LEFT$(Work$, 1) = "." THEN
  578.       NumMergeHold = 0    'invalid file name
  579.       NumInvalid = NumInvalid + 1
  580.       RETURN
  581.    END IF
  582.    DIZUsed = FALSE
  583.    IF StartUseDIZ THEN
  584.       CALL GetDIZ (FileLoc$+MID$(FromRec$,StartNameAt,13),DIZOK)
  585.       IF NOT DIZOK THEN IF FileLoc$ <> "" THEN CALL GetDIZ (MID$(FromRec$,StartNameAt,13),DIZOK)
  586.       IF DIZOK THEN CALL CheckExist ("FILE_ID.DIZ",DIZOK)
  587.       IF DIZOK THEN  ' strategy:  substitute formated entry for input
  588.          OPEN "FILE_ID.DIZ" FOR INPUT AS #5
  589.          WorkRec$ = ""
  590.               ' build the main FMS entry
  591.          LSET OutTemplate$ = SPACE$(OutLen)
  592.          IF ConvertFields THEN
  593.             IsOK = TRUE
  594.             CALL NameSizeDateDesc (FromRec$,IsOK)
  595.          ELSE
  596.             LSET OutTemplate$ = FromRec$
  597.          END IF
  598.               ' do the short main entry description
  599.          LastToWrite = OutLen - 3
  600.          PosToWrite = 34
  601.          NumInHold = 0
  602.          GOSUB FillLine
  603.          IF PosToWrite > 34 THEN
  604.             WorkRec$ = OutTemplate$
  605.          END IF
  606.          WHILE NextChar$ <> ""     ' now do any extended descriptions
  607.             PosToWrite = 3
  608.             LSET OutTemplate$ = SPACE$(OutLen)
  609.             GOSUB FillLine
  610.             IF PosToWrite > 3 THEN
  611.                WorkRec$ = WorkRec$ + DoubleHV$ + OutTemplate$
  612.             END IF
  613.          WEND
  614.          CLOSE 5
  615.          DIZUsed = (WorkRec$ <> "")
  616.          IF DIZUsed THEN
  617.             FromRec$ = WorkRec$
  618.          END IF
  619.       END IF
  620.    END IF
  621.    GOSUB BurstExtended   ' break apart when extended aggregated
  622.    IF NumMergeHold > 0 THEN
  623.       GOSUB BuildOneLineExtended
  624.       IF ExtendedBeforeName EQV TargetSortedByDate THEN
  625.          Frst = 1
  626.          Lst = NumMergeHold
  627.          Inc = 1
  628.       ELSE
  629.          Frst = NumMergeHold
  630.          Lst = 1
  631.          Inc = -1
  632.       END IF
  633.       IF TargetSortedByDate THEN
  634.          GOSUB MergeOutPutHold
  635.       END IF
  636.    END IF
  637.    IF StartIsFMS THEN
  638.       LSET HoldCat$ = RIGHT$(FromRec$, 3)
  639.       MID$ (FromRec$, LEN(FromRec$) - 2, 3) = "   "
  640.    ELSE
  641.       LSET HoldCat$ = "UNC"
  642.    END IF
  643.    LSET OutTemplate$ = SPACE$ (OutLen)
  644.    IF ConvertFields AND NOT DIZUsed THEN
  645.       IsOK = TRUE
  646.       CALL NameSizeDateDesc (FromRec$,IsOK)
  647.    ELSE
  648.       LSET OutTemplate$ = FromRec$
  649.    END IF
  650.    IF NOT IsOK THEN
  651.       NumBad = NumBad + 1
  652.       RETURN
  653.    END IF
  654.    MID$ (OutTemplate$, StartCatCode) = HoldCat$
  655.    GOSUB SetConstants
  656.    IF NumMergeHold > 0 THEN
  657.       IF NOT TargetSortedByDate THEN
  658.          GOSUB MergeOutPutHold
  659.       END IF
  660.    END IF
  661.    OneLineExtended$ = ""
  662.  
  663. RETURN
  664.  
  665. FillLine:
  666.  
  667.    LastEnd = 0
  668.    StartPos = PosToWrite
  669.    DO
  670.       GOSUB GetNextChar
  671.       SELECT CASE NextChar$
  672.          CASE LineFeed$,""
  673.             ' skip
  674.          CASE CarriageReturn$," "
  675.             IF PosToWrite > StartPos THEN  ' don't put at begin of line
  676.                MID$(OutTemplate$,PosToWrite) = " "
  677.                LastEnd = PosToWrite
  678.                PosToWrite = PosToWrite + 1
  679.              END IF
  680.          CASE ELSE
  681.             MID$(OutTemplate$,PosToWrite) = NextChar$
  682.             PosToWrite = PosToWrite + 1
  683.       END SELECT
  684.    LOOP UNTIL NextChar$ = "" OR PosToWrite > LastToWrite
  685.    LastChar$ = NextChar$
  686.    GOSUB GetNextChar
  687.    WordContinues = (INSTR(EndofWord$,LastChar$) = 0) AND (INSTR(EndofWord$,NextChar$) = 0)
  688.    IF WordContinues THEN
  689.       IF LastEnd > 0 THEN
  690.          HoldChars$ = MID$(OutTemplate$,LastEnd+1,LastToWrite-LastEnd) + NextChar$
  691.          MID$(OutTemplate$,LastEnd+1) = SPACE$(LastToWrite - LastEnd)
  692.          NextPos = 1
  693.          NumInHold = LEN(HoldChars$)
  694.       END IF
  695.    ELSE
  696.       HoldChars$ = NextChar$
  697.       NextPos = 1
  698.       NumInHold = 1
  699.    END IF
  700.  
  701. RETURN
  702.  
  703. GetNextChar:
  704.  
  705.    IF NumInHold > 0 THEN
  706.       NextChar$ = MID$(HoldChars$,NextPos,1)
  707.       NextPos = NextPos + 1
  708.       NumInHold = NumInHold - 1
  709.    ELSE
  710.       IF EOF(5) THEN
  711.          NextChar$ = ""
  712.       ELSE
  713.          NextChar$ = INPUT$ (1,#5)
  714.       END IF
  715.    END IF
  716.  
  717. RETURN
  718.  
  719. BurstExtended:  ' breaks out extended off single line
  720.                 ' pretends read in name+extended
  721.  
  722.    I = INSTR(FromRec$,DoubleHV$)
  723.    IF I = 0 THEN RETURN
  724.    LenLine = I - 1
  725.    NumMergeHold = (LEN(FromRec$) - I + 1) / (I + 1)
  726.    IF ExtendedBeforeName THEN
  727.       StartAt = LenLine - 1
  728.       Inc = -I-1
  729.    ELSE
  730.       StartAt = I + 2
  731.       Inc = I + 1
  732.    END IF
  733.    FOR I = 1 TO NumMergeHold
  734.       MergeHold$ (I) = MID$(FromRec$,StartAt,LenLine)
  735.       StartAt = StartAt + Inc
  736.    NEXT
  737.    FromRec$ = LEFT$(FromRec$,LenLine)
  738.  
  739. RETURN
  740.  
  741. BuildOneLineExtended:
  742.  
  743.    IF NumMergeHold = 0 OR NOT CombineExtended THEN RETURN
  744.    FOR I = 1 TO NumMergeHold
  745.       IF ExtendedBeforeName THEN
  746.          OneLineExtended$ = DoubleHV$ + MergeHold$(I) + OneLineExtended$
  747.       ELSE
  748.          OneLineExtended$ = OneLineExtended$ + DoubleHV$ + MergeHold$(I)
  749.       END IF
  750.    NEXT
  751.    NumMergeHold = 0
  752. ' print "Ole=\";onelineextended$;">":input xxx$
  753. RETURN
  754.  
  755. MergeOutputHold:
  756.  
  757.    FOR I = Frst TO Lst STEP Inc    'output extended desc
  758.       IF StartIsFMS THEN
  759.          MID$(MergeHold$(I), LEN(MergeHold$ (I)) - 2, 3) = "   "
  760.       END IF
  761.       LSET OutTemplate$ = SPACE$(OutLen)
  762.       LSET OutTemplate$ = MergeHold$(I)
  763.       MID$(OutTemplate$, StartCatCode) = "  ."
  764.       GOSUB OutPutNew
  765.    NEXT
  766.    NumMergeHold = 0
  767.  
  768. RETURN
  769.  
  770. SetConstants: ' formats & outputs the merge line
  771.  
  772.    IF AddingDate THEN
  773.       MID$(OutTemplate$, 24, 8 ) = AddDate$
  774.    END IF
  775.    IF AddingDesc AND NOT DIZUsed THEN
  776.       MID$(OutTemplate$, 34) = AddDesc$
  777.    END IF
  778.    IF AddingCat THEN
  779.       MID$(OutTemplate$, StartCatCode) = AddCat$
  780.    ELSE
  781.       NewCatPos = INSTR(SearchCats$, ","+RIGHT$(OutTemplate$,3)+",") + 1
  782.       IF NewCatPos > 1 THEN
  783.          MID$(OutTemplate$, StartCatCode) = MID$(ReplaceCats$,NewCatPos,3)
  784.          NumSubs = NumSubs + 1
  785.          LOCATE SubRow,SubCol
  786.          PRINT NumSubs;
  787.       END IF
  788.    END IF
  789.    GOSUB OutPutNew
  790.  
  791. RETURN
  792.  
  793. OutPutTarget:
  794.  
  795.    IF TargetSortedByDate THEN
  796.       GOSUB TargetOutputHold
  797.    END IF
  798.    LSET HoldCat$ = RIGHT$(ToRec$, 3)
  799.    MID$(ToRec$, LEN(ToRec$) - 2, 3) = "   "
  800.    LSET OutTemplate$ = ToRec$
  801.    MID$(OutTemplate$, StartCatCode, 3) = HoldCat$
  802.    GOSUB OutPutNew
  803.    IF NOT TargetSortedByDate THEN
  804.       GOSUB TargetOutputHold
  805.    END IF
  806.  
  807. RETURN
  808.  
  809. TargetOutputHold:
  810.  
  811.    FOR I = 1 TO NumTargetHold     'extended desc
  812.       LSET OutTemplate$ = SPACE$(OutLen)
  813.       LSET HoldCat$ = RIGHT$(TargetHold$(I), 3)
  814.       MID$(TargetHold$(I), LEN(TargetHold$(I)) - 2, 3) = "   "
  815.       LSET OutTemplate$ = TargetHold$(I)
  816.       MID$(OutTemplate$, StartCatCode, 3) = HoldCat$
  817.       GOSUB OutPutNew
  818.    NEXT
  819.    NumTargetHold = 0
  820.  
  821. RETURN
  822.  
  823. OutPutNew:
  824.  
  825.    ' if chaining then ...
  826. ON ERROR GOTO 50070
  827. 10 PRINT #3, OutTemplate$;OneLineExtended$
  828.    LOCATE NewRow, NewCol
  829.    PRINT LEFT$(OutTemplate$, 13);
  830. ON ERROR GOTO 0
  831. RETURN
  832.  
  833. PositionDown:
  834.    LOCATE 22,1: PRINT SPACE$(79);
  835.    LOCATE 23,1: PRINT SPACE$(79);
  836.    LOCATE 22,1
  837. RETURN
  838.  
  839. 40000 GOSUB PositionDown
  840.       PRINT "Error"; ERR
  841.       PRINT " Unable to open StartDir file "; StartDir$
  842.       GOTO 50100
  843. 40100 GOSUB PositionDown
  844.       PRINT "Error"; ERR
  845.       PRINT "Unable to open MergeTo file "; MergeTo$
  846.       GOTO 50100
  847. 40200 PRINT
  848.       PRINT "Missing Config File ";ConfigFile$
  849.       GOTO 50100
  850. 50000 GOSUB PositionDown
  851. 50050 GOSUB PositionDown
  852.       PRINT "Error";ERR
  853.       PRINT "Unable to create NewDir file ";NewDir$
  854.       GOTO 50100
  855. 50070 GOSUB PositionDown
  856.       PRINT "Error";ERR
  857.       PRINT "Unable to write to NewDir file ";NewDir$
  858.       GOTO 50100
  859.  
  860. 50090 PRINT "Unexpected Error"; ERR
  861. 50100 PRINT "Aborting..."
  862.       END
  863.  
  864. FUNCTION DateKey$ (X$) STATIC
  865.    DateKey$ = MID$(X$, 30, 2) + MID$(X$, 24, 2) + MID$(X$, 27, 2)
  866. END FUNCTION
  867.  
  868. FUNCTION NameKey$ (X$) STATIC
  869.   IF LEFT$(X$, 1) = "=" THEN
  870.      NameKey$ = MID$(X$, 2, 13)
  871.   ELSE
  872.      NameKey$ = LEFT$(X$, 13)
  873.   END IF
  874. END FUNCTION
  875.  
  876.       SUB NameSizeDateDesc (InStrng$, IsOK) STATIC
  877.       DIM Wrds$(25)
  878.       LenIn = LEN(InStrng$)
  879.       IF GotName AND StartNameAt <= LenIn THEN  ' Reformat Name
  880.          Work$ = MID$(InStrng$, StartNameAt, 13)
  881.          CALL Trim(Work$)
  882.          BlankPos = INSTR(Work$, " ")
  883.          DotPos = INSTR(Work$, ".")
  884.          IF DotPos = 0 AND BlankPos > 0 THEN
  885.             DotPos = BlankPos
  886.             MID$(Work$, BlankPos, 1) = "."
  887.          END IF
  888.          CALL RemoveBlanks(Work$)
  889.          MID$(OutTemplate$, 1, 13) = Work$
  890.          IF Work$ = "" OR DotPos > 9 OR DotPos = 1 THEN IsOK = 0
  891.       END IF
  892.       IF GotSize AND StartSizeAt <= LenIn THEN  ' Reformat Size
  893.          Work$ = MID$(InStrng$, StartSizeAt)
  894.          CALL Trim(Work$)
  895.          X = INSTR(Work$," ")
  896.          IF X > 1 THEN
  897.             IF X > 10 THEN X = 10
  898.             Work$ = LEFT$(Work$,X-1)
  899.          END IF
  900.          L = LEN(Work$)
  901.          CALL AnyBut (Work$,"0123456789,",NumOK)
  902.          IF NumOK = 0 THEN IsOK = 0
  903.          MID$(OutTemplate$, 22 - L, L) = Work$' Right Justify
  904.       END IF
  905.       IF GotDate AND StartDateAt <= LenIn - 8 THEN
  906.          Work$ = MID$(InStrng$, StartDateAt)
  907.          Wrds$(1) = ""
  908.          Wrds$(2) = ""
  909.          Wrds$(3) = ""
  910.          CALL IncludeParse ("0123456789",Work$,Wrds$(),NumFound)
  911.          MID$(OutTemplate$, 24, 8) = RIGHT$("00"+Wrds$(1),2) + "-" + _
  912.                                      RIGHT$("00"+Wrds$(2),2) + "-" + _
  913.                                      RIGHT$("00"+Wrds$(3),2)
  914.       END IF
  915.       IF GotDesc AND StartDesc <= LenIn THEN
  916.          Work$ = MID$(InStrng$, StartDescAt)
  917.          CALL Trim(Work$)
  918.          MID$(OutTemplate$, 34) = Work$
  919.       END IF
  920.       'LOCATE 3,1
  921.       'PRINT Instrng$;"->";
  922.       'LOCATE 4,1
  923.       'PRINT OutTemplate$;"<-";
  924.       'x$ = input$(1)
  925.       END SUB
  926.  
  927. FUNCTION ParmValue$ (Rec$, ParmKey$, Default$) STATIC
  928.    X = INSTR(Rec$, ParmKey$)
  929.    IF X = 0 THEN
  930.       ParmValue$ = Default$
  931.    ELSE
  932.       X$ = MID$(Rec$, X + LEN(ParmKey$), INSTR(X + 1, Rec$, "/") - X - LEN(ParmKey$))
  933.       CALL Trim(X$)
  934.       ParmValue$ = X$
  935.    END IF
  936. END FUNCTION
  937.  
  938.       SUB RemoveBlanks (Strng$) STATIC
  939.       EndPos = LEN(Strng$)
  940.       BlankPos = INSTR(Strng$, " ")
  941.       WHILE BlankPos < EndPos AND BlankPos > 0
  942.          MID$(Strng$, BlankPos) = MID$(Strng$, BlankPos + 1)
  943.          EndPos = EndPos - 1
  944.          BlankPos = INSTR(Strng$, " ")
  945.       WEND
  946.       Strng$ = LEFT$(Strng$, EndPos + (BlankPos > 0))
  947.       END SUB
  948.  
  949.       SUB SQOutBlanks (Strng$) STATIC
  950.       EndPos = LEN(Strng$)
  951.       BlankPos = INSTR(Strng$, " ")
  952.       IF BlankPos < 1 THEN EXIT SUB
  953.       WHILE BlankPos < EndPos
  954.          MID$(Strng$, BlankPos) = MID$(Strng$, BlankPos + 1)
  955.          EndPos = EndPos - 1
  956.          BlankPos = INSTR(Strng$, " ")
  957.       WEND
  958.       MID$(Strng$, EndPos) = "/"
  959.       Strng$ = LEFT$(Strng$, EndPos)
  960.       END SUB
  961.  
  962.       SUB SubZero (Work$) STATIC
  963.          X = INSTR(Work$, " ")
  964.          WHILE X > 0          ' substitute 0 for blank
  965.             MID$(Work$, X, 1) = "0"
  966.             X = INSTR(Work$, " ")
  967.          WEND
  968.       END SUB
  969.  
  970.       SUB Trim (TrimParm$) STATIC
  971.       WasL = INSTR(TrimParm$, " ")
  972.       IF WasL < 1 THEN
  973.          EXIT SUB
  974.       END IF
  975.       IF WasL = 1 THEN
  976.          WHILE LEFT$(TrimParm$, 1) = " "
  977.             TrimParm$ = RIGHT$(TrimParm$, LEN(TrimParm$) - 1)
  978.          WEND
  979.       END IF
  980.       CALL TrimTrail(TrimParm$, " ")
  981.       END SUB
  982.  
  983.       SUB TrimTrail (TrimParm$, TrimThis$) STATIC
  984.       IF RIGHT$(TrimParm$, 1) <> TrimThis$ THEN
  985.          EXIT SUB
  986.       END IF
  987.       WasJ = LEN(TrimParm$) - 1
  988. 108   IF WasJ > 0 THEN
  989.          IF MID$(TrimParm$, WasJ, 1) = TrimThis$ THEN
  990.             WasJ = WasJ - 1
  991.             GOTO 108
  992.          END IF
  993.       END IF
  994.       TrimParm$ = LEFT$(TrimParm$, WasJ)
  995.       END SUB
  996.  
  997. SUB IncludeParse (IncludeThis$, PassedParse$, Wrds$(), NumFound) STATIC
  998.    NumFound = 0
  999.    StartAt = 1
  1000.    ParseThis$ = PassedParse$ + CHR$(0)
  1001.    FOR I = 1 TO LEN(ParseThis$)
  1002.       IF INSTR(IncludeThis$, MID$(ParseThis$, I, 1)) = 0 THEN
  1003.          ParseLen = I - StartAt
  1004.          IF ParseLen > 0 THEN
  1005.             NumFound = NumFound + 1
  1006.             Wrds$(NumFound) = MID$(ParseThis$, StartAt, ParseLen)
  1007.          END IF
  1008.          StartAt = I + 1
  1009.       END IF
  1010.    NEXT
  1011. END SUB
  1012.  
  1013. SUB AnyBut (CheckThis$, ForThis$, IsOK) STATIC
  1014.    IsOK = -1
  1015.    FOR I = 1 TO LEN(CheckThis$)
  1016.       IF INSTR(ForThis$,MID$(CheckThis$,I,1)) = 0 THEN IsOK = 0
  1017.    NEXT
  1018. END SUB
  1019.  
  1020. SUB GetDIZ (Filname$,IsOK) STATIC
  1021.    IsOK = 0
  1022.    I = INSTR(Filname$," ")
  1023.    J = INSTR(Filname$,".")
  1024.    IF J = 0 OR (J > 0 AND I > 0 AND I < J) THEN J = I
  1025.    IF J < 1 THEN EXIT SUB
  1026.    EXT$ = MID$(Filname$,J+1)
  1027.    CALL Trim (Ext$)
  1028.    Ext$ = UCASE$(Ext$)
  1029.    IF Ext$ <> "ZIP" THEN EXIT SUB
  1030.  
  1031.    PREF$ = LEFT$(Filname$,J-1)
  1032.    CALL Trim (PREF$)
  1033.    PREF$ = UCASE$(PREF$)
  1034.    Filname$ = PREF$+".ZIP"
  1035.    CALL CheckExist (Filname$, IsOK)
  1036.    IF NOT IsOK THEN EXIT SUB
  1037.    IsOK = -1
  1038.    SHELL "GETDIZ.BAT "+Filname$
  1039. END SUB   
  1040.  
  1041. SUB CheckExist (Filname$, IsOK) STATIC
  1042.    ON LOCAL ERROR RESUME NEXT
  1043.    OPEN Filname$ FOR INPUT AS #6
  1044.    IsOK = (ERR = 0)
  1045.    CLOSE 6
  1046. END SUB
  1047.