Category : Printer + Display Graphics
Archive   : PMDUPS.ZIP
Filename : PMDUPS.BAS

 
Output of file : PMDUPS.BAS contained in archive : PMDUPS.ZIP

'PMDUPS.BAS (c) Copyright 1989 Merlin R. Null version 1.2 10-3-89
DEFINT A-Z
MaxFiles = 200
DIM FileName$(MaxFiles), NumRecs(MaxFiles), FileTag(MaxFiles), Arg$(2)
DIM Graphic1Part$(9)
DIM GrfInt&(143)
GrfInt&(0) = &H00340058 '52 by 88 pixels
C$ = " "
D$ = " "

Cl$=COMMAND$
FOR I = 1 TO LEN(Cl$)
CC$ = MID$(Cl$, I, 1)
IF (CC$ <> " " AND CC$ <> CHR$(9)) THEN
IF NOT In THEN
IF NumArgs = 2 THEN EXIT FOR
NumArgs = NumArgs + 1
In = -1
END IF
Arg$(NumArgs) = Arg$(NumArgs) + CC$
ELSE
In = 0
END IF
NEXT I
IF Arg$(1) = "/M" OR Arg$(1) = "M" OR Arg$(1) = "-M" THEN
MonoFlag = -1
Arg$(1) = Arg$(2)
END IF
IF Arg$(1) <> "" THEN
IF RIGHT$(Arg$(1), 1) <> ":" THEN
IF RIGHT$(Arg$(1), 1) <> "\" THEN
Arg$(1) = Arg$(1) + "\"
END IF
END IF
NwPath$ = Arg$(1)
END IF

IF MonoFlag THEN
VideoMode = 7
ELSE
DEF SEG = &H40
VideoMode = PEEK(&H49)
DEF SEG
END IF

SELECT CASE VideoMode
CASE 7
TextFG = 7
TextBG = 0
HighlightFG = 0
HighlightBG = 7
CASE ELSE
TextFG = 15
TextBG = 1
HighlightFG = 14
HighlightBG = 4
END SELECT

TextAtr = TextBG * 16 + TextFG
HighlightAtr = HighlightBG * 16 + HighlightFG
CALL SetAsmColors(TextAtr, HighlightAtr)

DTA$ = STRING$(43, " ") 'DTA for directory calls
FileMask$ = "*.SDR" + CHR$(0)
PathAndMask$ = NwPath$ + FileMask$

DirScreen: 'select file screen
COLOR TextFG, TextBG
CLS
NumFiles = 0
CALL DoTitle

CALL FindFirst(Flag, PathAndMask$, DTA$)

IF Flag = 0 THEN
NumRecs(1) = CVL(MID$(DTA$, 27, 4)) \ 16
FileName$(1) = MID$(DTA$, 31, INSTR(31, DTA$, CHR$(0)) - 31)
NumFiles = NumFiles + 1

'Find the rest of the filenames

DO
CALL FindNext(Flag, PathAndMask$)

IF Flag = 0 THEN
NumFiles = NumFiles + 1
FileName$(NumFiles) = MID$(DTA$, 31, INSTR(31, DTA$, CHR$(0)) - 31)
NumRecs(NumFiles) = CVL(MID$(DTA$, 27, 4)) \ 16
ELSE
EXIT DO
END IF
IF NumFiles = MaxFiles THEN
EXIT DO
END IF
LOOP
END IF
CALL RestoreDTA

'bubble sort

FOR I = 1 TO NumFiles - 1
FOR J = 1 TO NumFiles - 1
IF FileName$(J) > FileName$(J + 1) THEN
SWAP FileName$(J), FileName$(J + 1)
SWAP NumRecs(J), NumRecs(J + 1)
END IF
NEXT
NEXT

LOCATE 23, 55, 0
COLOR 0, 7
PRINT MID$(STR$(NumFiles), 2); " Files";
TotalGraphics& = 0
FOR I = 1 TO NumFiles
TotalGraphics& = TotalGraphics& + NumRecs(I)
NEXT
LOCATE 23, 65
PRINT TotalGraphics&;"Graphics";
COLOR TextFG, TextBG
CALL FunctKeys
DO
IF NumFiles > 0 THEN
Col = 4
IF NumFiles - PageNum * 63 > 67 THEN
FilesThisPage = 63
ELSE
FilesThisPage = NumFiles MOD 63
END IF

FOR I = PageNum * 63 + 1 TO PageNum * 63 + FilesThisPage
LOCATE (I - 1) MOD 21 + 2, Col
IF FileTag(I) THEN
PRINT "+";
ELSE
PRINT " ";
END IF
PRINT FileName$(I); STRING$(13 - LEN(FileName$(I)), " ");
PRINT USING "##### "; NumRecs(I);
Col = ((I - (PageNum * 63)) \ 21) * 27 + 4
NEXT I
ELSE
LOCATE 2, 2
COLOR HighlightFG, HighlightBG
PRINT CHR$(7);" No PrintMaster graphic files found on: "; NwPath$;
END IF

DO
LOCATE FileNum MOD 21 + 2, ((FileNum MOD 63) \ 21) * 27 + 4, 0
COLOR HighlightFG, HighlightBG
IF NumFiles > 0 THEN
IF FileTag(FileNum + 1) THEN
PRINT "+";
ELSE
PRINT " ";
END IF
PRINT FileName$(FileNum + 1); STRING$(13 - LEN(FileName$(FileNum + 1)), " ");
PRINT USING "##### "; NumRecs(FileNum + 1);
END IF

COLOR TextFG, TextBG
LOCATE 24, 60, 0
CALL GetKey(X, ScanCode)
SELECT CASE ScanCode

CASE 1
IF NameFile1$ = "" THEN
GOTO Finish
ELSE
NameFile1$ = ""
FOR I = 1 TO NumFiles
FileTag(I) = 0
NEXT
CALL ClearFileArea
CALL Prompt1
EXIT DO
END IF

CASE 20, 78 't, T, or grey +
IF NameFile1$ <> "" THEN
IF NOT FileTag(FileNum + 1) THEN
LOCATE FileNum MOD 21 + 2, ((FileNum MOD 63) \ 21) * 27 + 4, 0
COLOR HighlightFG, HighlightBG
PRINT "+";
FileTag(FileNum + 1) = -1
TaggedFiles = TaggedFiles + 1
END IF
END IF

CASE 22, 74 'u, U or grey -
IF NameFile1$ <> "" THEN
IF FileTag(FileNum + 1) THEN
LOCATE FileNum MOD 21 + 2, ((FileNum MOD 63) \ 21) * 27 + 4, 0
COLOR HighlightFG, HighlightBG
PRINT " ";
FileTag(FileNum + 1) = 0
TaggedFiles = TaggedFiles - 1
END IF
END IF

CASE 28 'return
IF NumFiles > 0 THEN
IF NameFile1$ = "" THEN
NameFile1$ = NwPath$ + FileName$(FileNum + 1)
NumRecs1 = NumRecs(FileNum + 1)
CALL ClearMesArea
LOCATE 24, 2
PRINT NameFile1$;
CALL Prompt2
ELSE
IF TaggedFiles = 0 THEN
NameFile2$ = NwPath$ + FileName$(FileNum + 1)
NumRecs2 = NumRecs(FileNum + 1)
SingleFile = -1
END IF
Done = -1
EXIT DO
END IF
END IF

CASE 30 'a or A tag all files
IF NameFile1$ <> "" THEN
FOR I = 1 TO NumFiles
FileTag(I) = -1
NEXT
CALL ClearFileArea
EXIT DO
END IF

CASE 47 'v or V view graphics
ViewedFiles = -1
FileRoot$ = LEFT$(FileName$(FileNum + 1),_
INSTR(FileName$(FileNum + 1), ".") - 1)
InFile$ = NwPath$ + FileRoot$ + ".SHP"

OPEN InFile$ FOR RANDOM AS 1 LEN = 577
InFile2$ = NwPath$ + FileName$(FileNum+ 1)
OPEN InFile2$ FOR RANDOM AS 2 LEN = 16
MaxGrfPage = (LOF(2) - 1) \ 240
FIELD #2, 16 AS GrfName$
FIELD #1, 577 AS Grf$
GrfPage = 0
SCREEN 2
DisplayGraphics:
CLS
FOR K = 0 TO 2
FOR J = 0 TO 4
GET #1, J + 1 + K * 5 + GrfPage * 15
GET #2, J + 1 + K * 5 + GrfPage * 15
FOR I = 1 TO 143
GrfInt&(I) = CVL(MID$(Grf$, I * 4 + 1, 4))
NEXT
PUT (J * 128 + 20, K * 64 + 2), GrfInt&, PSET
GraphName$ = GrfName$
IF INSTR(GraphName$, CHR$(0)) <> 0 THEN
GraphName$ = LEFT$(GraphName$, INSTR(GraphName$, CHR$(0)) - 1)
END IF
GraphName$ = RTRIM$(GraphName$)
LOCATE K * 8 + 8, J * 16 + 1 + (16 - LEN(GraphName$)) \ 2
PRINT GraphName$;
NEXT
NEXT
LOCATE 25, 35
PRINT FileRoot$;
DO
CALL GetKey(XX, ScanCode2)
SELECT CASE Scancode2
CASE 1 'esc
EXIT DO
CASE 73 'page up
IF GrfPage > 0 THEN
GrfPage = GrfPage - 1
GOTO DisplayGraphics
END IF
CASE 57, 81 'space, page down
IF GrfPage < MaxGrfPage THEN
GrfPage = GrfPage + 1
GOTO DisplayGraphics
END IF
CASE ELSE
END SELECT
LOOP
CLOSE
SCREEN 0
GOTO DirScreen

CASE 49 'n or N untag all files
IF NameFile1$ <> "" THEN
FOR I = 1 TO NumFiles
FileTag(I) = 0
NEXT
CALL ClearFileArea
EXIT DO
END IF

CASE 62 'F4 log new path/directory
CALL NewPath
LOCATE 25, 7, 1
OldPath$ = NwPath$
NwPath$ = ""
DO
CALL GetKey(X2, ScanCode2)
X2$ = CHR$(X2)
SELECT CASE X2
CASE 8 'backspace
IF LEN(NwPath$) > 0 THEN
LOCATE , POS(0) - 1
PRINT " ";
LOCATE , POS(0) - 1
NwPath$ = LEFT$(NwPath$, LEN(NwPath$) - 1)
END IF
CASE 13 'return
EXIT DO

CASE 27
NwPath$ = OldPath$
EXIT DO

CASE 33, 35 TO 42, 45, 48 TO 58, 64 TO 90, 92, 95 TO 122, 123, 125, 126
IF LEN(NwPath$) < 30 THEN
NwPath$ = NwPath$ + X2$
PRINT X2$;
END IF
CASE ELSE
END SELECT
LOOP
CALL ClearLine25
IF NwPath$ <> "" THEN
IF RIGHT$(NwPath$, 1) <> ":" THEN
IF RIGHT$(NwPath$, 1) <> "\" THEN
NwPath$ = NwPath$ + "\"
END IF
END IF
END IF
PathAndMask$ = NwPath$ + FileMask$
GOTO DirScreen

CASE 66 'F8 compare all files
Done = -1
EXIT DO

CASE 71 'Home
GOSUB RemoveBar
FileNum = PageNum * 63

CASE 72 'up
IF FileNum > PageNum * 63 THEN
GOSUB RemoveBar
FileNum = FileNum - 1
END IF

CASE 73 'page up
IF PageNum > 0 THEN
PageNum = PageNum - 1
FileNum = FileNum - 63
CALL ClearFileArea
EXIT DO
END IF

CASE 75 'left
IF FileNum - 21 > PageNum * 63 - 1 THEN
GOSUB RemoveBar
FileNum = FileNum - 21
END IF

CASE 77 'right
IF FileNum + 21 < (PageNum + 1) * 63 THEN
IF FileNum + 21 < NumFiles THEN
GOSUB RemoveBar
FileNum = FileNum + 21
ELSEIF NumFiles > FileNum - FileNum MOD 21 + 21 THEN
GOSUB RemoveBar
FileNum = NumFiles - 1
END IF
END IF

CASE 79 'end
GOSUB RemoveBar
FileNum = PageNum * 63 + FilesThisPage - 1

CASE 80 'down
IF FileNum < PageNum * 63 + FilesThisPage - 1 THEN
GOSUB RemoveBar
FileNum = FileNum + 1
END IF

CASE 81 'page down
IF (PageNum + 1) * 63 < NumFiles THEN
PageNum = PageNum + 1
FileNum = FileNum - FileNum MOD 63
FileNum = FileNum + 63
CALL ClearFileArea
EXIT DO
END IF

CASE ELSE
END SELECT
LOOP
IF Done THEN
EXIT DO
END IF
LOOP

CALL ClearMesArea
LOCATE 24, 2
PRINT NameFile1$;
OPEN NameFile1$ FOR RANDOM AS #1 LEN = NumRecs1 * 16
FIELD #1, NumRecs1 * 16 AS A$
GET #1
DIM Name1$(NumRecs1)
FOR I = 1 TO NumRecs1
Name1$(I) = MID$(A$, 16 * (I - 1) + 1, 16)
IF INSTR(Name1$(I), CHR$(0)) > 0 THEN
Name1$(I) = LEFT$(Name1$(I), INSTR(Name1$(I), CHR$(0)) - 1)
END IF
NEXT
CLOSE #1
FileRoot1$ = LEFT$(NameFile1$, INSTR(NameFile1$, "."))
GraphicFile1$ = FileRoot1$ + "SHP"
DupNameFile$ = FileRoot1$ + "DUP"
FileCompare = -1
OPEN GraphicFile1$ FOR RANDOM AS #1 LEN = 5770
FIELD #1, 5770 AS AA$

FOR L = 1 TO NumFiles
IF FileTag(L) = -1 OR TaggedFiles = 0 THEN
NewCompare = -1
IF NOT SingleFile THEN
NameFile2$ = NwPath$ + FileName$(L)
NumRecs2 = NumRecs(L)
END IF
CALL ClearName2
LOCATE 25, 2, 0
PRINT NameFile2$;

FileRoot2$ = LEFT$(NameFile2$, INSTR(NameFile2$, "."))
GraphicFile2$ = FileRoot2$ + "SHP"
OPEN NameFile2$ FOR RANDOM AS #2 LEN = NumRecs2 * 16
FIELD #2, NumRecs2 * 16 AS A$
GET #2
DIM Name2$(NumRecs2)
FOR I = 1 TO NumRecs2
Name2$(I) = MID$(A$, 16 * (I - 1) + 1, 16)
IF INSTR(Name2$(I), CHR$(0)) > 0 THEN
Name2$(I) = LEFT$(Name2$(I), INSTR(Name2$(I), CHR$(0)) - 1)
END IF
Name2$(I) = RTRIM$(Name2$(I))
NEXT
CLOSE #2

IF FileRoot1$ = FileRoot2$ THEN
SelfCheck = -1
ELSE
SelfCheck = 0
END IF
OPEN GraphicFile2$ FOR RANDOM AS #2 LEN = 31735
FIELD #2, 31735 AS B$
File2Part = 1
LOCATE 24, 35
PRINT "Graphic";
FOR I = 1 TO NumRecs1 STEP 10
GET #1, (I \ 10) + 1
IF NumRecs1 - I > 9 THEN
KMax = 9
ELSE
KMax = ((NumRecs1 -1) MOD 10)
END IF
FOR K = 0 TO KMax
Graphic1Part$(K) = MID$(AA$, K * 577 + 1, 576)
NEXT
FOR K = 0 TO KMax
LOCATE 24, 42
PRINT I + K; "of"; NumRecs1;" ";
DO
IF I + K < 2 OR NumRecs2 > 55 THEN
GET #2, File2Part
END IF
IF NumRecs2 - (File2Part - 1) * 55 => 55 THEN
JMax = 54
ELSE
JMax = (NumRecs2 MOD 55) - 1
END IF
FOR J = 0 TO JMax
IF NOT SelfCheck OR (I + K) <> J + 1 + ((File2Part - 1) * 55) THEN
IF Graphic1Part$(K) = MID$(B$, J * 577 + 1, 576) THEN
IF NOT DupOpen THEN
OPEN DupNameFile$ FOR OUTPUT AS 3
DupOpen = -1
PRINT #3, "Duplicate graphics found comparing PrintMaster files:"
END IF
IF NewCompare AND DupOpen THEN
PRINT #3, CHR$(10);" "; NameFile1$; TAB(23); "with "; NameFile2$; CHR$(10)
NewCompare = 0
END IF
RSET C$ = STR$(I + K)
RSET D$ = STR$(J + 1 + ((File2Part - 1) * 55))
PRINT #3, C$; " "; Name1$(I + K); TAB(24); "="; TAB(25); D$; " "; Name2$(J + 1 + ((File2Part - 1) * 55))
NumDups = NumDups + 1
LOCATE 25, 34
PRINT NumDups; "Dups found";
END IF
END IF
NEXT J
IF EOF(2) THEN
EXIT DO
END IF
File2Part = File2Part + 1
LOOP
File2Part = 1
NEXT K
NEXT I
' LOCATE 25, 65:PRINT FRE(0); 'for tests only
CLOSE #2
ERASE Name2$
NumRecs2 = 0
IF SingleFile THEN
EXIT FOR
END IF
X$ = INKEY$
IF X$ = CHR$(27) THEN
GOTO Finish
END IF
END IF
NEXT 'end of multi file compare loop

LOCATE 25, 35
IF NOT DupOpen THEN
PRINT "No Duplicates Found";
END IF

Finish:
CLOSE
CALL ScrollAll
IF ViewedFiles AND FileCompare THEN
LOCATE , 1
PRINT "Press any key";
CALL GetKey (X, XX)
END IF
END

RemoveBar:
LOCATE ((FileNum) MOD 21) + 2, ((FileNum MOD 63) \ 21) * 27 + 4, 0
IF FileTag(FileNum + 1) THEN
PRINT "+";
ELSE
PRINT " ";
END IF
PRINT FileName$(FileNum + 1); STRING$(13 - LEN(FileName$(FileNum + 1)), " ");
PRINT USING "##### "; NumRecs(FileNum + 1);
RETURN