home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Monster Media 1994 #1
/
monster.zip
/
monster
/
BBS_UTIL
/
DDOV10.ZIP
/
DDOV.BAS
next >
Wrap
BASIC Source File
|
1994-01-08
|
12KB
|
471 lines
DECLARE SUB FindFirstFx (Buffer$, FileName$, BYVAL FAttr%, ErrCode%)
DECLARE FUNCTION GetSizeFx& (Buffer$)
DECLARE FUNCTION GetDateFx$ (Buffer$)
DECLARE SUB Trim (TrimParm$)
DECLARE SUB SQOutBlanks (Strng$)
DECLARE SUB Soundex (St$, Result$, CodeLen%)
DECLARE SUB QPrint (St$, BYVAL Row%, BYVAL Column%, BYVAL Page%, BYVAL Fast%)
DECLARE SUB Exist (File$, Found%)
DECLARE SUB DelFile (FileName$, ErrCode%)
DECLARE FUNCTION ParseNonNumeric$ (Arg$)
DECLARE FUNCTION GetExt$ (Arg$)
DECLARE FUNCTION ParmValue$ (Rec$, ParmKey$, Default$)
' to do:
' bug: b is larger and newer, delete A, says
' neither killed A
' and nothing logged
DEFINT A-Z
DIM FileLoc$ (999)
GOSUB ClearScreen
FALSE = 0
TRUE = NOT FALSE
NoDeleteDrive$ = ""
Buffer$ = SPACE$(64)
Lidx$ = "LIDX.DEF"
Fidx$ = "FIDX.DEF"
LogDelTo$ = "KILLED.FIL"
VersionExt$ = ",ZIP,ARC,PAK,ARJ,LZH,"
WorkCmnd$ = COMMAND$ + " "
IF LEN(WorkCmnd$) > 1 THEN
ConfigFile$ = LEFT$(WorkCmnd$, INSTR(WorkCmnd$, " ") - 1)
CALL Trim(ConfigFile$)
END IF
IF ConfigFile$ = "" OR LEFT$(ConfigFile$, 1) = "/" THEN
ConfigFile$ = "DDOV.CFG"
END IF
WorkIn$ = WorkCmnd$
GOSUB ParseCmnd
ON ERROR GOTO 40200
IF Sharing THEN
OPEN ConfigFile$ FOR INPUT SHARED AS #4
ELSE
OPEN ConfigFile$ FOR INPUT AS #4
END IF
ON ERROR GOTO 0
GOSUB ReadConfig
NoConfig:
CALL Exist (Lidx$, DoesExist)
IF NOT DoesExist THEN
PRINT "Missing Location Index File ";Lidx$
PRINT "Aborting..."
END
END IF
CALL Exist (Fidx$, DoesExist)
IF NOT DoesExist THEN
PRINT "Missing File Index File ";Fidx$
PRINT "Aborting..."
END
END IF
IF Sharing THEN
OPEN Fidx$ FOR INPUT SHARED AS #1
ELSE
OPEN Fidx$ FOR INPUT AS #1
END IF
GOSUB LoadLidx
OPEN LogDelTo$ FOR APPEND AS #2
PrevFile$ = ""
IF NOT EOF(1) THEN GOSUB GetRec: GOSUB SetPrior
DO WHILE NOT EOF(1)
GOSUB GetRec
IF PriorName$ = Filname$ AND FilSize& = PriorSize& THEN
GOSUB GotDuplicate
ELSE
IF PriorAlpha$ = FrontAlpha$ THEN
IF LEN(FrontAlpha$) > 1 THEN
GOSUB GotVersion
END IF
END IF
END IF
GOSUB SetPrior
LOOP
CLOSE 1,2
LOCATE 21,1
END
ReadConfig:
NumCnfg = 0
WorkCmnd$ = ""
WHILE NOT EOF(4)
NumCnfg = NumCnfg + 1
LINE INPUT #4,WorkCmnd$
IF LEFT$(WorkCmnd$, 1) <> "*" AND WorkCmnd$ <> "" THEN
WorkIn$ = WorkCmnd$
WorkCmnd$ = UCASE$(WorkCmnd$) + " "
GOSUB ParseCmnd
END IF
WEND
RETURN
ParseCmnd:
IF LEFT$(WorkCmnd$, 2) = "H " THEN
GOSUB HelpScreen
END IF
CALL SQOutBlanks(WorkCmnd$)
X = INSTR(WorkCmnd$,"/SHARING")
Sharing = (X > 0 OR Sharing)
NoDeleteDrive$ = ParmValue$(WorkCmnd$, "/NODELETEDRIVE=", NoDeleteDrive$)
Lidx$ = ParmValue$(WorkCmnd$, "/LIDX=", Lidx$)
Fidx$ = ParmValue$(WorkCmnd$, "/FIDX=", Fidx$)
LogDelTo$ = ParmValue$(WorkCmnd$, "/LOGDELTO=", LogDelTo$)
RETURN
HelpScreen:
RETURN
ClearScreen:
CLS
CALL QPrint ("DDOV v. 1.0 (c)1994",1,1,0,TRUE)
RETURN
GetRec:
DO
ReadAgain:
LINE INPUT #1, InRec$
NumRead& = NumRead& + 1
Filname$ = LEFT$(InRec$,12)
'LOCATE 1,15
'PRINT Filname$;
CALL QPrint (Filname$,1,25,0,TRUE)
'LOCATE 1,30
'PRINT NumRead&;
CALL QPrint (STR$(NumRead&),1,40,0,TRUE)
IF JumpTo$ <> "" THEN
IF INSTR(InRec$,JumpTo$) = 0 AND NOT EOF(1) THEN
GOTO ReadAgain
ELSE
JumpTo$ = ""
END IF
END IF
Filname$ = RTRIM$ (Filname$)
FilExt$ = GetExt$(Filname$)
FilLocRec = VAL(MID$(InRec$,13))
FrontAlpha$ = ParseNonNumeric$ (Filname$)
'PRINT "<";FILNAME$;"> front <";frontalpha$;">"
FullName$ = FileLoc$(FilLocRec) + Filname$
CALL FindFirstFx (Buffer$,FullName$,Fatt,FileErrCode)
LOOP UNTIL FileErrCode = 0 OR EOF(1)
GOSUB GettheSize
GOSUB GettheDate
' print inrec$
' print "filname$=";filname$
' print "fillocrec=";fillocrec
' print "frontalpha$=";frontalpha$
' print "fullname$=";fullname$
' input xx$
RETURN
GettheSize:
FilSize& = 1
IF FileErrCode = 0 THEN
FilSize& = GetSizeFx& (Buffer$)
ELSE
FilSize& = 0
END IF
RETURN
GettheDate:
FilDate$ = "01-01-1994"
IF FileErrCode = 0 THEN
FilDate$ = GetDateFx$ (Buffer$)
ELSE
FilDate$ = "00-00-0000"
END IF
RETURN
LoadLidx:
IF Sharing THEN
OPEN Lidx$ FOR INPUT SHARED AS #2
ELSE
OPEN Lidx$ FOR INPUT AS #2
END IF
I = 0
WHILE NOT EOF(2)
LINE INPUT #2, LidxRec$
I = I + 1
LidxRec$ = LEFT$(LidxRec$,63)
'print "b<";lidxrec$;">"
LidxRec$ = RTRIM$(LidxRec$)
'print "a<";lidxrec$;">"
IF MID$(LidxRec$,2,1) = ":" THEN
FileLoc$ (I) = LidxRec$
ELSE
FileLoc$ (I) = ""
END IF
WEND
CLOSE 2
RETURN
SetPrior:
IF OmittedCurr THEN
OmittedCurr = FALSE
IF OmittedPrior THEN ' use last for prior if both omitted
PriorName$ = LastFilname$
PriorSize& = LastFilSize&
PriorAlpha$ = LastFrontAlpha$
PriorDate$ = LastFilDate$
PriorFull$ = LastFullName$
PriorLoc = LastFilLocRec
PriorExt$ = LastFilExt$
END IF
RETURN
END IF
IF NOT OmittedPrior THEN ' save last unomitted prior
LastFilname$ = PriorName$
LastFilSize& = PriorSize&
LastFrontAlpha$ = PriorAlpha$
LastFilDate$ = PriorDate$
LastFullName$ = PriorFull$
LastFilLocRec = PriorLoc
LastFilExt$ = PriorExt$
END IF
' move current to prior
PriorName$ = Filname$
PriorSize& = FilSize&
PriorAlpha$ = FrontAlpha$
PriorDate$ = FilDate$
PriorFull$ = FullName$
PriorLoc = FilLocRec
PriorExt$ = FilExt$
RETURN
GotDuplicate:
CanOmitPrior = (INSTR(NoDeleteDrive$,LEFT$(PriorFull$,1)) = 0)
CanOmitCurr = (INSTR(NoDeleteDrive$,LEFT$(FullName$,1)) = 0)
IF CanOmitPrior OR CanOmitCurr THEN
GOSUB ClearScreen
CALL QPrint ("Probable Duplicate Files of "+Filname$,3,1,0,TRUE)
CALL QPrint ("same name & size",4,4,0,TRUE)
GOSUB PrintFileInfo
GOSUB ProcessAns
END IF
RETURN
GotVersion:
IF FilExt$ = "GIF" OR PriorExt$ = "GIF" THEN RETURN
IF FilExt$ <> PriorExt$ THEN
IF INSTR(VersionExt$,","+FilExt$+",") = 0 THEN
RETURN
ELSE
IF INSTR(VersionExt$,","+PriorExt$+",") = 0 THEN
RETURN
END IF
END IF
END IF
IF PriorDate$ = FilDate$ THEN RETURN
CanOmitPrior = (INSTR(NoDeleteDrive$,LEFT$(PriorFull$,1)) = 0)
CanOmitCurr = (INSTR(NoDeleteDrive$,LEFT$(FullName$,1)) = 0)
IF CanOmitPrior OR CanOmitCurr THEN
GOSUB ClearScreen
CALL QPrint ("Possible older version "+FrontAlpha$,3,1,0,TRUE)
GOSUB PrintFileInfo
GOSUB ProcessAns
END IF
RETURN
PrintFileInfo:
PriorCmp$ = RIGHT$(PriorDate$,4)+LEFT$(PriorDate$,5)
CurrCmp$ = RIGHT$(FilDate$,4) +LEFT$(FilDate$,5)
'PRINT
CALL QPrint ("A. ",6,1,0,TRUE)
CALL QPrint (PriorName$,6,10,0,TRUE)
IF NOT CanOmitPrior THEN
CALL QPrint ("no kill->",7,2,0,TRUE)
END IF
CALL QPrint (FileLoc$(PriorLoc),7,12,0,TRUE)
PriorBigger = (PriorSize& > FilSize&)
IF PriorBigger THEN
CALL QPrint ("larger -> ",8,2,0,TRUE)
END IF
CALL QPrint (STR$(PriorSize&),8,12,0,TRUE)
PriorNewer = (PriorCmp$ > CurrCmp$)
IF PriorNewer THEN
CALL QPrint ("newer -> ",9,3,0,TRUE)
END IF
CALL QPrint (PriorDate$,9,12,0,TRUE)
CALL QPrint ("B. ",11,1,0,TRUE)
CALL QPrint (FilName$,11,10,0,TRUE)
IF NOT CanOmitCurr THEN
CALL QPrint ("no kill->",12,2,0,TRUE)
END IF
CALL QPrint (FileLoc$(FilLocRec),12,12,0,TRUE)
CurrBigger = (PriorSize& < FilSize&)
IF CurrBigger THEN
CALL QPrint ("larger ->",13,2,0,TRUE)
END IF
CALL QPrint (STR$(FilSize&),13,12,0,TRUE)
CurrNewer = (PriorCmp$ < CurrCmp$)
IF CurrNewer THEN
CALL QPrint ("newer ->",14,3,0,TRUE)
END IF
CALL QPrint (FilDate$,14,12,0,TRUE)
IF NOT CanOmitPrior THEN
CALL QPrint ("A. is protected",16,4,0,TRUE)
ELSEIF NOT CanOmitCurr THEN
CALL QPrint ("B. is protected",16,4,0,TRUE)
END IF
IF (CurrNewer AND CurrBigger AND NOT CanOmitPrior) OR _
(PriorNewer AND PriorBigger AND NOT CanOmitCurr) THEN
Ans$ = ""
RETURN
END IF
AskAgain:
LOCATE 18,1
LINE INPUT "Erase A,B,AB, Q quits, J jumps, anything else continues ";ANS$
ANS$ = UCASE$ (ANS$)
IF (INSTR(ANS$,"A")>0 AND NOT CanOmitPrior) OR _
(INSTR(ANS$,"B")>0 AND NOT CanOmitCurr) THEN
CALL QPrint (SPACE$(79),18,1,0,TRUE)
GOTO AskAgain
END IF
RETURN
ProcessAns:
LenAns = LEN(ANS$)
AnsPos = 1
OmittedPrior = FALSE
OmittedCurr = FALSE
DO WHILE AnsPos <= LenAns
SELECT CASE MID$(ANS$,AnsPos,1)
CASE "A"
IF CanOmitPrior THEN
CALL DelFile (PriorFull$, OmitErrCode)
OmittedPrior = (OmitErrCode = 0)
IF OmittedPrior THEN
CALL QPrint ("A. killed",19,1,0,TRUE)
PRINT #2,PriorFull$
ELSE
CALL QPrint ("Unable to kill A.",19,1,0,TRUE)
END IF
END IF
CASE "B"
IF CanOmitCurr THEN
CALL DelFile (FullName$, OmitErrCode)
OmittedCurr = (OmitErrCode = 0)
IF OmittedCurr THEN
CALL QPrint ("B. killed",20,1,0,TRUE)
PRINT #2,FullName$
ELSE
CALL QPrint ("Unable to kill B.",20,1,0,TRUE)
END IF
END IF
CASE "J"
LOCATE 18,1
CALL QPrint (SPACE$(79),18,1,0,TRUE)
LOCATE 18,1
LINE INPUT "Jump to what substring ";JumpTo$
JumpTo$ = UCASE$ (JumpTo$)
LenAns = 0
CASE "Q"
LOCATE 21,1
END
CASE ELSE
END SELECT
AnsPos = AnsPos + 1
LOOP
ANS$ = ""
IF (NOT OmittedPrior) AND (NOT OmittedCurr) THEN
CALL QPrint ("neither killed",19,1,0,TRUE)
END IF
RETURN
FUNCTION ParseNonNumeric$ (Filname$) STATIC
I = INSTR(Filname$,".")
IF I = 0 THEN I = INSTR(Filname$," ")
I = I - 1
LastChar = I
IF I < 3 THEN
I = 0
ELSE
LastIsAlpha = 0
IF INSTR("0123456789",MID$(Filname$,I,1)) = 0 THEN
IF INSTR("0123456789",MID$(Filname$,I-1,1)) > 0 THEN
LastIsAlpha = -1
I = I - 1
END IF
END IF
DO UNTIL INSTR("0123456789",MID$(Filname$,I,1)) = 0 OR I < 2
I = I - 1
LOOP
IF I < 2 THEN
IF LastIsAlpha THEN
I = LastChar - 1
ELSE
I = LastChar
END IF
END IF
END IF
ParseNonNumeric$ = LEFT$(Filname$,I)
END FUNCTION
FUNCTION GetExt$ (Filname$) STATIC
I = INSTR(Filname$, ".")
IF I > 0 THEN
GetExt$ = RIGHT$(Filname$,LEN(Filname$)-I)
ELSE
GetExt$ = ""
END IF
END FUNCTION
SUB SQOutBlanks (Strng$) STATIC
EndPos = LEN(Strng$)
BlankPos = INSTR(Strng$, " ")
IF BlankPos < 1 THEN EXIT SUB
WHILE BlankPos < EndPos
MID$(Strng$, BlankPos) = MID$(Strng$, BlankPos + 1)
EndPos = EndPos - 1
BlankPos = INSTR(Strng$, " ")
WEND
MID$(Strng$, EndPos) = "/"
Strng$ = LEFT$(Strng$, EndPos)
END SUB
SUB Trim (Strng$) STATIC
Strng$ = LTrim$(Strng$)
Strng$ = RTrim$(Strng$)
END SUB
FUNCTION ParmValue$ (Rec$, ParmKey$, Default$) STATIC
X = INSTR(Rec$, ParmKey$)
IF X = 0 THEN
ParmValue$ = Default$
ELSE
X$ = MID$(Rec$, X + LEN(ParmKey$), INSTR(X + 1, Rec$, "/") - X - LEN(ParmKey$))
CALL Trim(X$)
ParmValue$ = X$
END IF
END FUNCTION
40200 RESUME NoConfig
50100 PRINT "Aborting..."
END