home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-386-Vol-2of3.iso / c / copyfx11.zip / COPYFIX.BAS < prev    next >
BASIC Source File  |  1990-12-21  |  12KB  |  124 lines
  1. 1 'Centrum voor Medische Informatica TNO       <Email>              |  |  |\/|
  2. 2 'TNO Center for Medical Informatics | GROENEVELD@CMI.TNO.NL  |  \_/  |  |  |
  3. 3 '( CMI-TNO )    | Y. Groeneveld     | GROENEVELD@CMIHP1.UUCP | Jim Groeneveld
  4. 4 'P.O.Box 124    | Wassenaarseweg 56 | GROENEVELD@TNO.NL      | Schoolweg 14
  5. 5 '2300 AC Leiden | 2333 AL Leiden    | ...@HDETNO51.BITNET    | 8071 BC Nunspeet
  6. 6 'Nederland.     | (+31|0)71-181810  | Fax (+31|0)71-176382   | 03412-60413
  7. 10 CLEAR:CLOSE:SCREEN 0:WIDTH 80:KEY OFF:COLOR 7,1,1:CLS:DEFINT A-Z:OPTION BASE 1
  8. 15 DEF FNREPORT$="=== Record"+STR$(RECORD.READ#+1#)+" read, record"+STR$(RECORD.WRITTEN#)+" written with length"+STR$(BYTES.WRITTEN#)+"          "
  9. 20 CHECK.RESULT$="BAD":PRINT "+++ Program COPYFIX.BAS, version 1.1 by Jim Groeneveld, 21 December 1990. +++"
  10. 70 MAX.LINE.INPUT.LENGTH=255:CRLF$=CHR$(13)+CHR$(10):WILDCARD$="NO"
  11. 100 WHILE CHECK.RESULT$<>"OK"
  12. 110   WHILE CHECK.RESULT$<>"OK"
  13. 120     GOSUB 12010:PRINT "--- Enter INPUT [drive:][path\]filename : ";:LINE INPUT FIXINPUT.FX$
  14. 130     D.PATH.FILENAME.EXT$=FIXINPUT.FX$:GOSUB 11000:GOSUB 12040 'check file name and split name and extension as FIXINPUT$ and FX$.
  15. 140     IF CHECK.RESULT$<>"OK" AND CHECK.RESULT$<>"WILDCARD" THEN BEEP:PRINT CHECK.RESULT$:GOTO 160
  16. 150     FIXINPUT.FX$=D.PATH.FILENAME.EXT$:FIXINPUT$=D.PATH.FILENAME$:FX$=EXT$:GOSUB 12020
  17. 160   WEND
  18. 170   ON ERROR GOTO 11400:OPEN "I",#1,FIXINPUT.FX$:ON ERROR GOTO 0
  19. 180   IF CHECK.RESULT$<>"OK" THEN BEEP:PRINT CHECK.RESULT$
  20. 190 WEND
  21. 400 CHECK.RESULT$="BAD"
  22. 410 WHILE CHECK.RESULT$<>"OK"
  23. 420   WHILE CHECK.RESULT$<>"OK"
  24. 430     GOSUB 12010:PRINT "--- Enter OUTPUT [drive:][path\]filename: ";:LINE INPUT FXOUTPUT.FXD$
  25. 440     D.PATH.FILENAME.EXT$=FXOUTPUT.FXD$:GOSUB 11000:GOSUB 12040 'check file name and split name and extension as FXOUTPUT$ and FXD$
  26. 450     IF CHECK.RESULT$<>"OK" AND CHECK.RESULT$<>"WILDCARD" THEN BEEP:PRINT CHECK.RESULT$:GOTO 470
  27. 460     FXOUTPUT.FXD$=D.PATH.FILENAME.EXT$:FXOUTPUT$=D.PATH.FILENAME$:FXD$=EXT$:GOSUB 12020
  28. 465     IF FIXINPUT.FX$=FXOUTPUT.FXD$ THEN CHECK.RESULT$="BAD":BEEP:PRINT "*** Output file name equal to input file name: not permitted! ***"
  29. 470   WEND
  30. 480   ON ERROR GOTO 11400:OPEN "I",#2,FXOUTPUT.FXD$:ON ERROR GOTO 0:CLOSE 2
  31. 490   IF CHECK.RESULT$="*** FILE NOT FOUND ***" THEN CHECK.RESULT$="OK":GOTO 500
  32. 491   IF CHECK.RESULT$<>"OK" THEN BEEP:PRINT CHECK.RESULT$:GOTO 500
  33. 492     BEEP:PRINT "*** File already exists! Do you want to overwrite it? Y/N: ";
  34. 494     OVERWRITE$="":WHILE OVERWRITE$="":WHILE OVERWRITE$="":OVERWRITE$=INKEY$:WEND:IF INSTR("YyNn",OVERWRITE$)=0 THEN BEEP:OVERWRITE$=""
  35. 496     WEND:IF INSTR("Yy",OVERWRITE$)>0 THEN OVERWRITE$="YES" ELSE OVERWRITE$="NO":CHECK.RESULT$="BAD"
  36. 498     PRINT OVERWRITE$
  37. 500 WEND
  38. 600 FIXED.RECORD.LENGTH#=-1:INCLUDE.CRLF$="":WHILE FIXED.RECORD.LENGTH#=-1
  39. 610   PRINT "--- Enter fixed (maximum) output record length or 0 for infinite: ";:INPUT"",FIXED.RECORD.LENGTH#
  40. 630   IF FIXED.RECORD.LENGTH#<0 THEN BEEP:PRINT "*** Illegal negative length ***":FIXED.RECORD.LENGTH#=-1
  41. 640   IF FIXED.RECORD.LENGTH#=0 THEN INCLUDE.CRLF$="NONE"
  42. 660 WEND:IF INCLUDE.CRLF$<>"" THEN 780
  43. 700 PRINT "--- Do you want to include existing CR/LF's in the input file? Y/N: ";
  44. 710 WHILE INCLUDE.CRLF$="":WHILE INCLUDE.CRLF$="":INCLUDE.CRLF$=INKEY$:WEND:IF INSTR("YyNn",INCLUDE.CRLF$)=0 THEN BEEP:INCLUDE.CRLF$=""
  45. 720 WEND:IF INSTR("Yy",INCLUDE.CRLF$)>0 THEN INCLUDE.CRLF$="YES" ELSE INCLUDE.CRLF$="NO"
  46. 730 PRINT INCLUDE.CRLF$:IF INCLUDE.CRLF$<>"YES" THEN 780 ELSE PRINT "--- Do you want to synchronize with existing CR/LF's? Y/N: ";:INCLUDE.CRLF$=""
  47. 740 WHILE INCLUDE.CRLF$="":WHILE INCLUDE.CRLF$="":INCLUDE.CRLF$=INKEY$:WEND:IF INSTR("YyNn",INCLUDE.CRLF$)=0 THEN BEEP:INCLUDE.CRLF$=""
  48. 750 WEND:IF INSTR("Yy",INCLUDE.CRLF$)>0 THEN INCLUDE.CRLF$="YESYNC" ELSE INCLUDE.CRLF$="NOSYNC"
  49. 760 PRINT INCLUDE.CRLF$
  50. 780 OPEN "O",#2,FXOUTPUT.FXD$
  51. 790 PRINT "=== Processing input file ";FIXINPUT.FX$;"......please wait and see......"
  52. 800 RECORD.READ#=0:RECORD.WRITTEN#=0:TOTAL.BYTES.READ#=0:PART.BYTES.WRITTEN#=0:BYTES.WRITTEN#=0:eol$=crlf$
  53. 810 WHILE NOT EOF(1) '====== process all cases in fxoutput file
  54. 820   LINE INPUT #1,TEXT.LINE$:BYTES.TO.PROCESS=LEN(TEXT.LINE$):TOTAL.BYTES.READ#=TOTAL.BYTES.READ#+BYTES.TO.PROCESS
  55. 825   prev.eol$=eol$:IF BYTES.TO.PROCESS=MAX.LINE.INPUT.LENGTH THEN EOL$="" ELSE EOL$=CRLF$
  56. 827   IF INCLUDE.CRLF$="NONE" THEN PRINT #2,TEXT.LINE$;:PRINT "=== Record";RECORD.READ#+1#;"read, total bytes written:";TOTAL.BYTES.READ#;:LOCATE ,1:GOTO 900
  57. 828   IF BYTES.TO.PROCESS=0 and (prev.eol$=crlf$ or part.bytes.written#>0) THEN 880 '------ process empty lines and lines with lengths of integer multiples of 255 correctly
  58. 830   WHILE FIXED.RECORD.LENGTH#-PART.BYTES.WRITTEN#<=BYTES.TO.PROCESS:RECORD.WRITTEN#=RECORD.WRITTEN#+1#
  59. 835     PRINT #2,LEFT$(TEXT.LINE$,FIXED.RECORD.LENGTH#-PART.BYTES.WRITTEN#);CRLF$;:IF FIXED.RECORD.LENGTH#-PART.BYTES.WRITTEN#<BYTES.TO.PROCESS THEN TEXT.LINE$=MID$(TEXT.LINE$,FIXED.RECORD.LENGTH#-PART.BYTES.WRITTEN#+1#) ELSE TEXT.LINE$=""
  60. 840     BYTES.WRITTEN#=BYTES.WRITTEN#+FIXED.RECORD.LENGTH#-PART.BYTES.WRITTEN#:BYTES.TO.PROCESS=BYTES.TO.PROCESS-(FIXED.RECORD.LENGTH#-PART.BYTES.WRITTEN#):GOSUB 12000
  61. 860   BYTES.WRITTEN#=0:PART.BYTES.WRITTEN#=0:WEND:IF BYTES.TO.PROCESS=0 THEN 900 '''else if bytes.to.process<0 then beep:print "*** bytes.to.process =";bytes.to.process;"pROGRAM ERROR, ABORT ***":stop '====== for debugging purposes
  62. 870   PRINT #2,LEFT$(TEXT.LINE$,BYTES.TO.PROCESS);:BYTES.WRITTEN#=BYTES.WRITTEN#+BYTES.TO.PROCESS
  63. 880   IF (INCLUDE.CRLF$="NOSYNC" OR INCLUDE.CRLF$="YESYNC") AND EOL$=CRLF$ THEN PRINT #2,CRLF$;:RECORD.WRITTEN#=RECORD.WRITTEN#+1#:GOSUB 12000:BYTES.WRITTEN#=0:if include.crlf$="YESYNC" then part.bytes.written#=0
  64. 890   IF  INCLUDE.CRLF$="NOSYNC" OR INCLUDE.CRLF$="NO" OR (INCLUDE.CRLF$="YESYNC" AND EOL$="") THEN PART.BYTES.WRITTEN#=PART.BYTES.WRITTEN#+BYTES.TO.PROCESS
  65. 900 RECORD.READ#=RECORD.READ#-(EOL$=CRLF$):WEND '====== increase record.read counter by one if EOL encountered
  66. 910 IF INCLUDE.CRLF$="NO" AND PART.BYTES.WRITTEN#>0 THEN PRINT #2,CRLF$;:RECORD.WRITTEN#=RECORD.WRITTEN#+1#:RECORD.READ#=RECORD.READ#-1:GOSUB 12000:BYTES.WRITTEN#=0
  67. 990 CLOSE:PRINT:PRINT "=== End of program ===":KEY ON:END
  68. 999 CHECK.FIELD.WIDTH$="BAD":RETURN
  69. 9999 '================== routines ==================
  70. 10000 REM ********** Remove leading and trailing spaces from file name *********
  71. 10010 WHILE LEFT$(D.PATH.FILENAME.EXT$,1)=" ":D.PATH.FILENAME.EXT$=MID$(D.PATH.FILENAME.EXT$,2):WEND
  72. 10020 WHILE RIGHT$(D.PATH.FILENAME.EXT$,1)=" ":D.PATH.FILENAME.EXT$=LEFT$(D.PATH.FILENAME.EXT$,LEN(D.PATH.FILENAME.EXT$)-1):WEND
  73. 10030 RETURN
  74. 11000 REM ********** check drv:path\file names ********** (result in CHECK.RESULT$)
  75. 11010 GOSUB 10000:CHECK.RESULT$="OK"
  76. 11020 U=INSTR(D.PATH.FILENAME.EXT$,":"):IF U=1 OR U>2 THEN CHECK.RESULT$="*** ILLEGALLY PLACED ':' ***":RETURN
  77. 11030 D$="":IF U=2 THEN W=ASC(LEFT$(D.PATH.FILENAME.EXT$,1)):IF W>96 AND W<123 THEN W=W-32:D$=CHR$(W)+":" ELSE IF W>64 AND W<91 THEN D$=CHR$(W)+":" ELSE CHECK.RESULT$="*** ILLEGAL DRIVE NAME ***":RETURN
  78. 11040 PATH$="":PATH.FILENAME.EXT$=MID$(D.PATH.FILENAME.EXT$,U+1):U=INSTR(PATH.FILENAME.EXT$,"\"):IF U=1 THEN PATH$="\":PATH.FILENAME.EXT$=MID$(PATH.FILENAME.EXT$,2)
  79. 11050 U=INSTR(PATH.FILENAME.EXT$,"\"):IF U=0 THEN FILENAME.EXT$=PATH.FILENAME.EXT$:WILDCARD$="YES":GOSUB 11110:WILDCARD$="NO":IF CHECK.RESULT$<>"OK" THEN RETURN ELSE D.PATH.FILENAME.EXT$=D$+PATH$+FILENAME.EXT$:D.PATH.FILENAME$=D$+PATH$+FILENAME$:RETURN
  80. 11060 PATHNAME.EXT$=LEFT$(PATH.FILENAME.EXT$,U-1):IF PATHNAME.EXT$<>"." AND PATHNAME.EXT$<>".." THEN FILENAME.EXT$=PATHNAME.EXT$:GOSUB 11110:IF CHECK.RESULT$<>"OK" THEN RETURN ELSE PATHNAME.EXT$=FILENAME.EXT$
  81. 11070 PATH$=PATH$+PATHNAME.EXT$+"\":PATH.FILENAME.EXT$=MID$(PATH.FILENAME.EXT$,U+1):GOTO 11050 '====== repeat check for every subdirectory name
  82. 11110 REM ********** check file names ********** (result in CHECK.RESULT$)
  83. 11120 CHECK.RESULT$="OK":IF LEN(FILENAME.EXT$)=0 THEN CHECK.RESULT$="*** ZERO LENGTH PATH/FILENAME ***":RETURN
  84. 11125 CHECK.RESULT$="OK":IF LEN(FILENAME.EXT$)>12 THEN CHECK.RESULT$="*** TOO LONG PATH/FILENAME ***":RETURN
  85. 11130 V=INSTR(FILENAME.EXT$,"."):IF V=0 AND LEN(FILENAME.EXT$)>8 THEN CHECK.RESULT$="*** PATH/FILENAME TOO LONG ***":RETURN
  86. 11133 IF V=0 THEN EXPL.PERIOD$="NO" ELSE EXPL.PERIOD$="YES"
  87. 11140 IF V>0 AND INSTR(V+1,FILENAME.EXT$,".")>0 THEN CHECK.RESULT$="*** TOO MANY PERIODS IN PATH/FILENAME ***":RETURN
  88. 11150 IF V>9 OR V=1 THEN CHECK.RESULT$="*** ILLEGALLY PLACED '.' IN PATH/FILENAME ***":RETURN
  89. 11160 IF V>0 AND (LEN(FILENAME.EXT$)-V)>3 THEN CHECK.RESULT$="*** TOO LONG EXTENSION IN PATH/FILENAME ***":RETURN
  90. 11170 IF INSTR(FILENAME.EXT$,"\")>0 THEN CHECK.RESULT$="*** ILLEGAL '\' IN PATH/FILENAME ***":RETURN
  91. 11180 IF INSTR(FILENAME.EXT$,"+")>0 THEN CHECK.RESULT$="*** ILLEGAL '+' IN PATH/FILENAME ***":RETURN
  92. 11190 IF INSTR(FILENAME.EXT$,"=")>0 THEN CHECK.RESULT$="*** ILLEGAL '=' IN PATH/FILENAME ***":RETURN
  93. 11200 IF INSTR(FILENAME.EXT$,"[")>0 THEN CHECK.RESULT$="*** ILLEGAL '[' IN PATH/FILENAME ***":RETURN
  94. 11210 IF INSTR(FILENAME.EXT$,"]")>0 THEN CHECK.RESULT$="*** ILLEGAL ']' IN PATH/FILENAME ***":RETURN
  95. 11220 IF INSTR(FILENAME.EXT$,":")>0 THEN CHECK.RESULT$="*** ILLEGAL ':' IN PATH/FILENAME ***":RETURN
  96. 11230 IF INSTR(FILENAME.EXT$,";")>0 THEN CHECK.RESULT$="*** ILLEGAL ';' IN PATH/FILENAME ***":RETURN
  97. 11240 IF INSTR(FILENAME.EXT$,CHR$(34))>0 THEN CHECK.RESULT$="*** ILLEGAL '"+CHR$(34)+"' IN PATH/FILENAME ***":RETURN
  98. 11250 IF INSTR(FILENAME.EXT$,"/")>0 THEN CHECK.RESULT$="*** ILLEGAL '/' IN PATH/FILENAME ***":RETURN
  99. 11260 IF INSTR(FILENAME.EXT$,",")>0 THEN CHECK.RESULT$="*** ILLEGAL ',' IN PATH/FILENAME ***":RETURN
  100. 11270 IF INSTR(FILENAME.EXT$,"|")>0 THEN CHECK.RESULT$="*** ILLEGAL '|' IN PATH/FILENAME ***":RETURN
  101. 11280 IF INSTR(FILENAME.EXT$,"<")>0 THEN CHECK.RESULT$="*** ILLEGAL '<' IN PATH/FILENAME ***":RETURN
  102. 11290 IF INSTR(FILENAME.EXT$,">")>0 THEN CHECK.RESULT$="*** ILLEGAL '>' IN PATH/FILENAME ***":RETURN
  103. 11292 IF INSTR(FILENAME.EXT$,"*")>0 AND WILDCARD$="NO" THEN CHECK.RESULT$="*** ILLEGAL '*' IN PATH/FILENAME ***":RETURN
  104. 11294 IF INSTR(FILENAME.EXT$,"?")>0 AND WILDCARD$="NO" THEN CHECK.RESULT$="*** ILLEGAL '?' IN PATH/FILENAME ***":RETURN
  105. 11300 FOR W = 1 TO LEN(FILENAME.EXT$):V = ASC(MID$(FILENAME.EXT$,W,1)):IF V > 96 AND V < 123 THEN V=V-32:MID$(FILENAME.EXT$,W,1)=CHR$(V) '====== change lower case to upper case
  106. 11310 IF V <= 32 THEN CHECK.RESULT$="*** ILLEGAL SPACE OR CONTROL CHARACTER IN PATH/FILENAME ***":W = LEN(FILENAME.EXT$)
  107. 11320 NEXT W:IF CHECK.RESULT$<>"OK" THEN RETURN
  108. 11325 V=INSTR(FILENAME.EXT$,"."):FILENAME$=FILENAME.EXT$:EXT$=""
  109. 11330 IF V>0 THEN FILENAME$=LEFT$(FILENAME.EXT$,V-1):EXT$=MID$(FILENAME.EXT$,V+1)
  110. 11340 RETURN '========================
  111. 11400 ERROR.NUMBER=ERR:CHECK.RESULT$="*** ERROR NUMBER"+STR$(ERROR.NUMBER)+" ***"
  112. 11500 IF ERROR.NUMBER=53 THEN CHECK.RESULT$="*** FILE NOT FOUND ***":GOTO 11800
  113. 11600 IF ERROR.NUMBER=64 THEN CHECK.RESULT$="*** BAD FILE NAME ***":GOTO 11800
  114. 11700 IF ERROR.NUMBER=76 THEN CHECK.RESULT$="*** PATH NOT FOUND ***":GOTO 11800
  115. 11800 RESUME NEXT
  116. 12000 PRINT FNREPORT$;:IF BYTES.WRITTEN#=FIXED.RECORD.LENGTH# THEN LOCATE ,1:RETURN ELSE PRINT:RETURN
  117. 12010 PRINT "=== Enter [drive:][path\][wildcard] for directory or":RETURN
  118. 12020 IF INSTR(FILENAME.EXT$,"*")>0 OR INSTR(FILENAME.EXT$,"?")>0 THEN CHECK.RESULT$="WILDCARD":ON ERROR GOTO 12030:FILES D.PATH.FILENAME.EXT$:ON ERROR GOTO 0:RETURN ELSE RETURN
  119. 12030 PRINT "No files ";D.PATH.FILENAME.EXT$:RESUME NEXT
  120. 12040 IF FILENAME.EXT$="" THEN FILENAME.EXT$="*.*":D.PATH.FILENAME.EXT$=D.PATH.FILENAME.EXT$+"*.*":CHECK.RESULT$="WILDCARD"
  121. 12050 IF FILENAME.EXT$="." THEN FILENAME.EXT$=".\*.*":D.PATH.FILENAME.EXT$=D.PATH.FILENAME.EXT$+"\*.*":CHECK.RESULT$="WILDCARD"
  122. 12060 IF FILENAME.EXT$=".." THEN FILENAME.EXT$="..\*.*":D.PATH.FILENAME.EXT$=D.PATH.FILENAME.EXT$+"\*.*":CHECK.RESULT$="WILDCARD"
  123. 12070 RETURN
  124.