home *** CD-ROM | disk | FTP | other *** search
/ Beijing Paradise BBS Backup / PARADISE.ISO / software / BBSDOORW / DDOV10.ZIP / DDOV.BAS next >
Encoding:
BASIC Source File  |  1994-01-08  |  12.1 KB  |  471 lines
  1. DECLARE SUB FindFirstFx (Buffer$, FileName$, BYVAL FAttr%, ErrCode%)
  2. DECLARE FUNCTION GetSizeFx& (Buffer$)
  3. DECLARE FUNCTION GetDateFx$ (Buffer$)
  4. DECLARE SUB Trim (TrimParm$)
  5. DECLARE SUB SQOutBlanks (Strng$)
  6. DECLARE SUB Soundex (St$, Result$, CodeLen%)
  7. DECLARE SUB QPrint (St$, BYVAL Row%, BYVAL Column%, BYVAL Page%, BYVAL Fast%)
  8. DECLARE SUB Exist (File$, Found%)
  9. DECLARE SUB DelFile (FileName$, ErrCode%)
  10. DECLARE FUNCTION ParseNonNumeric$ (Arg$)
  11. DECLARE FUNCTION GetExt$ (Arg$)
  12. DECLARE FUNCTION ParmValue$ (Rec$, ParmKey$, Default$)
  13. ' to do:
  14. ' bug: b is larger and newer, delete A, says 
  15. '   neither killed A
  16. '   and nothing logged
  17. DEFINT A-Z
  18. DIM FileLoc$ (999)
  19. GOSUB ClearScreen
  20. FALSE = 0
  21. TRUE = NOT FALSE
  22. NoDeleteDrive$ = ""
  23. Buffer$ = SPACE$(64)
  24. Lidx$ = "LIDX.DEF"
  25. Fidx$ = "FIDX.DEF"
  26. LogDelTo$ = "KILLED.FIL"
  27. VersionExt$ = ",ZIP,ARC,PAK,ARJ,LZH,"
  28. WorkCmnd$ = COMMAND$ + " "
  29. IF LEN(WorkCmnd$) > 1 THEN
  30.    ConfigFile$ = LEFT$(WorkCmnd$, INSTR(WorkCmnd$, " ") - 1)
  31.    CALL Trim(ConfigFile$)
  32. END IF
  33. IF ConfigFile$ = "" OR LEFT$(ConfigFile$, 1) = "/" THEN
  34.    ConfigFile$ = "DDOV.CFG"
  35. END IF
  36. WorkIn$ = WorkCmnd$
  37. GOSUB ParseCmnd
  38.    ON ERROR GOTO 40200
  39.    IF Sharing THEN
  40.       OPEN ConfigFile$ FOR INPUT SHARED AS #4
  41.    ELSE
  42.       OPEN ConfigFile$ FOR INPUT AS #4
  43.    END IF
  44.    ON ERROR GOTO 0
  45.  
  46. GOSUB ReadConfig
  47. NoConfig:
  48.  
  49. CALL Exist (Lidx$, DoesExist)
  50. IF NOT DoesExist THEN
  51.    PRINT "Missing Location Index File ";Lidx$
  52.    PRINT "Aborting..."
  53.    END
  54. END IF
  55. CALL Exist (Fidx$, DoesExist)
  56. IF NOT DoesExist THEN
  57.    PRINT "Missing File Index File ";Fidx$
  58.    PRINT "Aborting..."
  59.    END
  60. END IF
  61.  
  62. IF Sharing THEN
  63.    OPEN Fidx$ FOR INPUT SHARED AS #1
  64. ELSE
  65.    OPEN Fidx$ FOR INPUT AS #1                
  66. END IF
  67. GOSUB LoadLidx
  68. OPEN LogDelTo$ FOR APPEND AS #2
  69. PrevFile$ = ""
  70. IF NOT EOF(1) THEN GOSUB GetRec: GOSUB SetPrior
  71. DO WHILE NOT EOF(1)
  72.    GOSUB GetRec
  73.    IF PriorName$ = Filname$ AND FilSize& = PriorSize& THEN
  74.       GOSUB GotDuplicate
  75.    ELSE
  76.       IF PriorAlpha$ = FrontAlpha$ THEN
  77.          IF LEN(FrontAlpha$) > 1 THEN
  78.             GOSUB GotVersion
  79.          END IF
  80.       END IF
  81.    END IF
  82.    GOSUB SetPrior
  83. LOOP
  84. CLOSE 1,2
  85. LOCATE 21,1
  86. END
  87.  
  88. ReadConfig:
  89.  
  90.    NumCnfg = 0
  91.    WorkCmnd$ = ""
  92.    WHILE NOT EOF(4)
  93.       NumCnfg = NumCnfg + 1
  94.       LINE INPUT #4,WorkCmnd$
  95.       IF LEFT$(WorkCmnd$, 1) <> "*" AND WorkCmnd$ <> "" THEN
  96.          WorkIn$ = WorkCmnd$
  97.          WorkCmnd$ = UCASE$(WorkCmnd$) + " "
  98.          GOSUB ParseCmnd
  99.       END IF
  100.    WEND
  101.  
  102. RETURN
  103.  
  104. ParseCmnd:
  105.  
  106.    IF LEFT$(WorkCmnd$, 2) = "H " THEN
  107.       GOSUB HelpScreen
  108.    END IF
  109.    CALL SQOutBlanks(WorkCmnd$)
  110.    X = INSTR(WorkCmnd$,"/SHARING")
  111.    Sharing = (X > 0 OR Sharing)
  112.    NoDeleteDrive$ = ParmValue$(WorkCmnd$, "/NODELETEDRIVE=", NoDeleteDrive$)
  113.    Lidx$ = ParmValue$(WorkCmnd$, "/LIDX=", Lidx$)
  114.    Fidx$ = ParmValue$(WorkCmnd$, "/FIDX=", Fidx$)
  115.    LogDelTo$ = ParmValue$(WorkCmnd$, "/LOGDELTO=", LogDelTo$)
  116.  
  117. RETURN
  118.  
  119. HelpScreen:
  120.  
  121. RETURN
  122.  
  123. ClearScreen:
  124.  
  125.    CLS
  126.    CALL QPrint ("DDOV v. 1.0 (c)1994",1,1,0,TRUE)
  127.  
  128. RETURN
  129.  
  130. GetRec:
  131.  
  132.    DO
  133.      ReadAgain:
  134.       LINE INPUT #1, InRec$
  135.       NumRead& = NumRead& + 1
  136.       Filname$ = LEFT$(InRec$,12)
  137.       'LOCATE 1,15
  138.       'PRINT Filname$;
  139.       CALL QPrint (Filname$,1,25,0,TRUE)
  140.       'LOCATE 1,30
  141.       'PRINT NumRead&;
  142.       CALL QPrint (STR$(NumRead&),1,40,0,TRUE)
  143.       IF JumpTo$ <> "" THEN
  144.          IF INSTR(InRec$,JumpTo$) = 0 AND NOT EOF(1) THEN
  145.             GOTO ReadAgain
  146.          ELSE
  147.             JumpTo$ = ""
  148.          END IF
  149.       END IF
  150.       Filname$ = RTRIM$ (Filname$)
  151.       FilExt$ = GetExt$(Filname$)
  152.       FilLocRec = VAL(MID$(InRec$,13))
  153.       FrontAlpha$ = ParseNonNumeric$ (Filname$)
  154. 'PRINT "<";FILNAME$;"> front <";frontalpha$;">"
  155.       FullName$ = FileLoc$(FilLocRec) + Filname$
  156.       CALL FindFirstFx (Buffer$,FullName$,Fatt,FileErrCode)
  157.    LOOP UNTIL FileErrCode = 0 OR EOF(1)
  158.  
  159.    GOSUB GettheSize
  160.    GOSUB GettheDate
  161. '  print inrec$
  162. '  print "filname$=";filname$
  163. '  print "fillocrec=";fillocrec
  164. '  print "frontalpha$=";frontalpha$
  165. '  print "fullname$=";fullname$
  166. '  input xx$
  167. RETURN
  168.  
  169. GettheSize:
  170.  
  171. FilSize& = 1
  172. IF FileErrCode = 0 THEN
  173.    FilSize& = GetSizeFx& (Buffer$)
  174. ELSE
  175.    FilSize& = 0
  176. END IF
  177.  
  178. RETURN
  179.  
  180. GettheDate:
  181.  
  182. FilDate$ = "01-01-1994"
  183. IF FileErrCode = 0 THEN
  184.    FilDate$ = GetDateFx$ (Buffer$)
  185. ELSE
  186.    FilDate$ = "00-00-0000"
  187. END IF
  188.  
  189. RETURN
  190.    
  191. LoadLidx:
  192.  
  193.    IF Sharing THEN
  194.       OPEN Lidx$ FOR INPUT SHARED AS #2
  195.    ELSE
  196.       OPEN Lidx$ FOR INPUT AS #2
  197.    END IF
  198.    I = 0
  199.    WHILE NOT EOF(2)
  200.       LINE INPUT #2, LidxRec$
  201.       I = I + 1
  202.       LidxRec$ = LEFT$(LidxRec$,63)
  203. 'print "b<";lidxrec$;">"
  204.       LidxRec$ = RTRIM$(LidxRec$)
  205. 'print "a<";lidxrec$;">"
  206.       IF MID$(LidxRec$,2,1) = ":" THEN
  207.          FileLoc$ (I) = LidxRec$
  208.       ELSE
  209.          FileLoc$ (I) = ""
  210.       END IF
  211.    WEND
  212.    CLOSE 2
  213.  
  214. RETURN
  215.  
  216. SetPrior:
  217.  
  218.    IF OmittedCurr THEN
  219.       OmittedCurr = FALSE
  220.       IF OmittedPrior THEN  ' use last for prior if both omitted
  221.          PriorName$ = LastFilname$
  222.          PriorSize& = LastFilSize&
  223.          PriorAlpha$ = LastFrontAlpha$
  224.          PriorDate$ = LastFilDate$
  225.          PriorFull$ = LastFullName$
  226.          PriorLoc = LastFilLocRec
  227.          PriorExt$ = LastFilExt$
  228.       END IF
  229.       RETURN
  230.    END IF
  231.    IF NOT OmittedPrior THEN ' save last unomitted prior
  232.       LastFilname$ = PriorName$
  233.       LastFilSize& = PriorSize&
  234.       LastFrontAlpha$ = PriorAlpha$
  235.       LastFilDate$ = PriorDate$
  236.       LastFullName$ = PriorFull$
  237.       LastFilLocRec = PriorLoc
  238.       LastFilExt$ = PriorExt$
  239.    END IF
  240.       '  move current to prior
  241.    PriorName$ = Filname$
  242.    PriorSize& = FilSize&
  243.    PriorAlpha$ = FrontAlpha$
  244.    PriorDate$ = FilDate$
  245.    PriorFull$ = FullName$
  246.    PriorLoc = FilLocRec
  247.    PriorExt$ = FilExt$
  248.  
  249. RETURN
  250.  
  251. GotDuplicate:
  252.  
  253.    CanOmitPrior = (INSTR(NoDeleteDrive$,LEFT$(PriorFull$,1)) = 0)
  254.    CanOmitCurr  = (INSTR(NoDeleteDrive$,LEFT$(FullName$,1)) = 0)
  255.    IF CanOmitPrior OR CanOmitCurr THEN
  256.       GOSUB ClearScreen
  257.       CALL QPrint ("Probable Duplicate Files of "+Filname$,3,1,0,TRUE)
  258.       CALL QPrint ("same name & size",4,4,0,TRUE)
  259.       GOSUB PrintFileInfo
  260.       GOSUB ProcessAns
  261.    END IF
  262.  
  263. RETURN
  264.  
  265. GotVersion:
  266.    IF FilExt$ = "GIF" OR PriorExt$ = "GIF" THEN RETURN
  267.    IF FilExt$ <> PriorExt$ THEN
  268.       IF INSTR(VersionExt$,","+FilExt$+",") = 0 THEN
  269.          RETURN
  270.       ELSE
  271.          IF INSTR(VersionExt$,","+PriorExt$+",") = 0 THEN
  272.             RETURN
  273.          END IF
  274.       END IF
  275.    END IF
  276.    IF PriorDate$ = FilDate$ THEN RETURN
  277.    
  278.    CanOmitPrior = (INSTR(NoDeleteDrive$,LEFT$(PriorFull$,1)) = 0)
  279.    CanOmitCurr  = (INSTR(NoDeleteDrive$,LEFT$(FullName$,1)) = 0)
  280.    IF CanOmitPrior OR CanOmitCurr THEN
  281.       GOSUB ClearScreen
  282.       CALL QPrint ("Possible older version "+FrontAlpha$,3,1,0,TRUE)
  283.       GOSUB PrintFileInfo
  284.       GOSUB ProcessAns
  285.    END IF
  286.  
  287. RETURN
  288.  
  289. PrintFileInfo:
  290.  
  291.       PriorCmp$ = RIGHT$(PriorDate$,4)+LEFT$(PriorDate$,5)
  292.       CurrCmp$  = RIGHT$(FilDate$,4)  +LEFT$(FilDate$,5)
  293.       'PRINT
  294.       CALL QPrint ("A.  ",6,1,0,TRUE)
  295.       CALL QPrint (PriorName$,6,10,0,TRUE)
  296.       IF NOT CanOmitPrior THEN
  297.          CALL QPrint ("no kill->",7,2,0,TRUE)
  298.       END IF
  299.       CALL QPrint (FileLoc$(PriorLoc),7,12,0,TRUE)
  300.       PriorBigger = (PriorSize& > FilSize&)
  301.       IF PriorBigger THEN
  302.          CALL QPrint ("larger -> ",8,2,0,TRUE)
  303.       END IF
  304.       CALL QPrint (STR$(PriorSize&),8,12,0,TRUE)
  305.       PriorNewer = (PriorCmp$ > CurrCmp$)
  306.       IF PriorNewer THEN
  307.          CALL QPrint ("newer -> ",9,3,0,TRUE)
  308.       END IF
  309.       CALL QPrint (PriorDate$,9,12,0,TRUE)
  310.       CALL QPrint ("B.  ",11,1,0,TRUE)
  311.       CALL QPrint (FilName$,11,10,0,TRUE)
  312.       IF NOT CanOmitCurr THEN
  313.          CALL QPrint ("no kill->",12,2,0,TRUE)
  314.       END IF
  315.       CALL QPrint (FileLoc$(FilLocRec),12,12,0,TRUE)
  316.       CurrBigger = (PriorSize& < FilSize&)
  317.       IF CurrBigger THEN
  318.          CALL QPrint ("larger ->",13,2,0,TRUE)
  319.       END IF
  320.       CALL QPrint (STR$(FilSize&),13,12,0,TRUE)
  321.       CurrNewer = (PriorCmp$ < CurrCmp$)
  322.       IF CurrNewer THEN
  323.          CALL QPrint ("newer ->",14,3,0,TRUE)
  324.       END IF
  325.       CALL QPrint (FilDate$,14,12,0,TRUE)
  326.       IF NOT CanOmitPrior THEN
  327.          CALL QPrint ("A. is protected",16,4,0,TRUE)
  328.       ELSEIF NOT CanOmitCurr THEN
  329.          CALL QPrint ("B. is protected",16,4,0,TRUE)
  330.       END IF
  331.       IF (CurrNewer AND CurrBigger AND NOT CanOmitPrior) OR _
  332.          (PriorNewer AND PriorBigger AND NOT CanOmitCurr) THEN
  333.               Ans$ = ""
  334.               RETURN
  335.       END IF
  336.    AskAgain:
  337.       LOCATE 18,1
  338.       LINE INPUT "Erase A,B,AB, Q quits, J jumps, anything else continues ";ANS$
  339.       ANS$ = UCASE$ (ANS$)
  340.       IF (INSTR(ANS$,"A")>0 AND NOT CanOmitPrior) OR _
  341.          (INSTR(ANS$,"B")>0 AND NOT CanOmitCurr) THEN
  342.             CALL QPrint (SPACE$(79),18,1,0,TRUE)
  343.             GOTO AskAgain
  344.       END IF
  345.  
  346. RETURN
  347.  
  348. ProcessAns:
  349.  
  350.       LenAns = LEN(ANS$)
  351.       AnsPos = 1
  352.       OmittedPrior = FALSE
  353.       OmittedCurr = FALSE
  354.     DO WHILE AnsPos <= LenAns
  355.       SELECT CASE MID$(ANS$,AnsPos,1)
  356.          CASE "A"
  357.             IF CanOmitPrior THEN
  358.                CALL DelFile (PriorFull$, OmitErrCode)
  359.                OmittedPrior = (OmitErrCode = 0)
  360.                IF OmittedPrior THEN
  361.                   CALL QPrint ("A. killed",19,1,0,TRUE)
  362.                   PRINT #2,PriorFull$
  363.                ELSE
  364.                   CALL QPrint ("Unable to kill A.",19,1,0,TRUE)
  365.                END IF
  366.             END IF
  367.          CASE "B"
  368.             IF CanOmitCurr THEN
  369.                CALL DelFile (FullName$, OmitErrCode)
  370.                OmittedCurr = (OmitErrCode = 0)
  371.                IF OmittedCurr THEN
  372.                   CALL QPrint ("B. killed",20,1,0,TRUE)
  373.                   PRINT #2,FullName$
  374.                ELSE
  375.                   CALL QPrint ("Unable to kill B.",20,1,0,TRUE)
  376.                END IF
  377.             END IF
  378.          CASE "J"
  379.             LOCATE 18,1
  380.             CALL QPrint (SPACE$(79),18,1,0,TRUE)
  381.             LOCATE 18,1
  382.             LINE INPUT "Jump to what substring ";JumpTo$
  383.             JumpTo$ = UCASE$ (JumpTo$)
  384.             LenAns = 0
  385.          CASE "Q"
  386.             LOCATE 21,1
  387.             END
  388.          CASE ELSE
  389.       END SELECT
  390.       AnsPos = AnsPos + 1
  391.     LOOP
  392.     ANS$ = ""
  393.     IF (NOT OmittedPrior) AND (NOT OmittedCurr) THEN
  394.        CALL QPrint ("neither killed",19,1,0,TRUE)
  395.     END IF
  396. RETURN
  397.  
  398. FUNCTION ParseNonNumeric$ (Filname$) STATIC
  399.    I = INSTR(Filname$,".")
  400.    IF I = 0 THEN I = INSTR(Filname$," ")
  401.    I = I - 1
  402.    LastChar = I
  403.    IF I < 3 THEN
  404.       I = 0
  405.    ELSE
  406.       LastIsAlpha = 0
  407.       IF INSTR("0123456789",MID$(Filname$,I,1)) = 0 THEN
  408.          IF INSTR("0123456789",MID$(Filname$,I-1,1)) > 0 THEN
  409.             LastIsAlpha = -1
  410.             I = I - 1
  411.          END IF
  412.       END IF
  413.       DO UNTIL INSTR("0123456789",MID$(Filname$,I,1)) = 0 OR I < 2
  414.          I = I - 1
  415.       LOOP
  416.       IF I < 2 THEN 
  417.          IF LastIsAlpha THEN
  418.             I = LastChar - 1
  419.          ELSE
  420.             I = LastChar
  421.          END IF
  422.       END IF
  423.    END IF
  424.    ParseNonNumeric$ = LEFT$(Filname$,I)
  425. END FUNCTION
  426.  
  427. FUNCTION GetExt$ (Filname$) STATIC
  428.  
  429.    I = INSTR(Filname$, ".")
  430.    IF I > 0 THEN
  431.       GetExt$ = RIGHT$(Filname$,LEN(Filname$)-I)
  432.    ELSE
  433.       GetExt$ = ""
  434.    END IF
  435.  
  436. END FUNCTION
  437.  
  438.       SUB SQOutBlanks (Strng$) STATIC
  439.       EndPos = LEN(Strng$)
  440.       BlankPos = INSTR(Strng$, " ")
  441.       IF BlankPos < 1 THEN EXIT SUB
  442.       WHILE BlankPos < EndPos
  443.          MID$(Strng$, BlankPos) = MID$(Strng$, BlankPos + 1)
  444.          EndPos = EndPos - 1
  445.          BlankPos = INSTR(Strng$, " ")
  446.       WEND
  447.       MID$(Strng$, EndPos) = "/"
  448.       Strng$ = LEFT$(Strng$, EndPos)
  449.       END SUB
  450.  
  451.       SUB Trim (Strng$) STATIC
  452.       Strng$ = LTrim$(Strng$)
  453.       Strng$ = RTrim$(Strng$)
  454.       END SUB
  455.  
  456. FUNCTION ParmValue$ (Rec$, ParmKey$, Default$) STATIC
  457.    X = INSTR(Rec$, ParmKey$)
  458.    IF X = 0 THEN
  459.       ParmValue$ = Default$
  460.    ELSE
  461.       X$ = MID$(Rec$, X + LEN(ParmKey$), INSTR(X + 1, Rec$, "/") - X - LEN(ParmKey$))
  462.       CALL Trim(X$)
  463.       ParmValue$ = X$
  464.    END IF
  465. END FUNCTION
  466.  
  467. 40200 RESUME NoConfig
  468. 50100 PRINT "Aborting..."
  469.       END
  470.  
  471.