home *** CD-ROM | disk | FTP | other *** search
/ RBBS in a Box Volume 1 #3.1 / RBBSIABOX31.cdr / xref / xmitcalc.bas < prev    next >
Encoding:
BASIC Source File  |  1984-08-30  |  5.5 KB  |  114 lines
  1. 10 ' *DISKPGM2.BAS   NEW 05/28/83 Rich Schinnell Rockville,Md 20853
  2. 20 CLS:KEY OFF:TOT#=0 ' for DOS 2.0 only
  3. 30 PRINT "(C) Copyright 1983,, Richard Schinnell,Rockville, MD. 20853 (301) 949-8848
  4. 40 PRINT "This program will check each FILE on your disk for DATES,BYTES and
  5. 50 PRINT"the time it will take to transfer it at 300 baud  (DOS 2.0+ only)"
  6. 60 PRINT"Place your printer on-line and put it to the top of a page please.
  7. 70 PRINT:LOCATE 10,1,1:COLOR 23,0:
  8. 80 LOCATE 10,1,1:COLOR 28,0:PRINT" What NAME do you wish to print on the printer as the"
  9. 90 PRINT" name of the disk ? (50 Character Title only allowed ":COLOR 7,0
  10. 100 LOCATE 18,1,1:PRINT "> ";:CUM1$=""
  11. 110 CUMRICH$=INKEY$:IF LEN(CUMRICH$)>0 THEN IF ASC(CUMRICH$)=13 THEN 200
  12. 120 IF LEN(CUMRICH$)<1 THEN 110
  13. 130 IF LEN(CUMRICH$)>1 THEN BEEP:GOTO 110
  14. 140 IF ASC(CUMRICH$)=8 AND POS(0)<4 THEN BEEP:CUM1$="":GOTO 180
  15. 150 IF ASC(CUMRICH$)=8 THEN CUM1$=LEFT$(CUM1$,(LEN(CUM1$)-1)):CUMRICH$="":LOCATE 18,POS(0)-1:PRINT " ";
  16. 160 CUM1$=CUM1$+CUMRICH$
  17. 170 IF LEN(CUM1$)>49 THEN BEEP:CUM1$=LEFT$(CUM1$,50):CUMRICH$=""
  18. 180 LOCATE 24,1,0:PRINT "you Have ";RIGHT$(STR$(50-LEN(CUM1$)),2);" characters left ";RIGHT$(STR$(LEN(CUM1$)),2);" used up so far ";
  19. 190 LOCATE 18,3,0:PRINT CUM1$;:LOCATE 18,POS(0),1:GOTO 110
  20. 200 TITLE$=CUM1$
  21. 210 COLOR 23,0,1:PRINT:PRINT" Which disk drive to you wish to check>  : ";:COLOR 7,0
  22. 220 RICH$=INKEY$:IF LEN(RICH$)<>1 THEN 220
  23. 230 IF ASC(RICH$)>96 AND ASC(RICH$)<103 THEN RICH$=CHR$(ASC(RICH$)-32)
  24. 240 IF INSTR("ABCDEF",RICH$)<1 THEN BEEP:GOTO 210
  25. 250 DRIV$=LEFT$(RICH$,1)+":"
  26. 260 ON ERROR GOTO 640
  27. 270 FALSE=0:TRUE=NOT FALSE:DEFINT A-Z:L=0:CLS:CODE=43:DIM F$(175)
  28. 280 FILES DRIV$+"*.*"
  29. 290 CLINE1 = CSRLIN-3
  30. 300 D=0
  31. 310 LOCATE 1,1,1
  32. 320 FOR I = 2 TO CLINE1
  33. 330 FOR B = 1 TO 63 STEP 18
  34. 340 D=D+1
  35. 350 FOR N = 0 TO 11
  36. 360 T = SCREEN(I,(B+N)):F$(D)=F$(D)+CHR$(T)
  37. 370 NEXT N
  38. 375 T=SCREEN(I,B+N):IF CHR$(T)="<" THEN F$(D)="":D=D-1:GOTO 400
  39. 380 IF LEFT$(F$(D),1)=" " THEN D=D-1 :GOTO 411
  40. 390 F$(D)= DRIV$+F$(D)
  41. 400 NEXT B
  42. 410 NEXT I
  43. 411 ' STOP
  44. 412 FOR G = 1 TO 40
  45. 413 T = SCREEN(CLINE1+1,(G)):FRR$=FRR$+CHR$(T)
  46. 414 NEXT G
  47. 420 LOCATE 15,1:COLOR 26,0:PRINT "ALPHABETIZING THE FILE NAMES ":COLOR 7,0
  48. 430 ' THIS ALPHABETIZES THE ARRAY
  49. 440 FOR X=1 TO D-1:FOR Y=X+1 TO D:IF F$(Y)<F$(X) THEN SWAP F$(X),F$(Y)
  50. 450 NEXT Y:NEXT X
  51. 460 LOCATE 12,25:COLOR 28,0:PRINT " WORKING FILES ":COLOR 7,0
  52. 470 LPRINT:LPRINT"        (C) COPYRIGHT,1983, RICHARD SCHINNELL,ROCKVILLE,MD"
  53. 480 LPRINT
  54. 490 LPRINT TITLE$;" Time ";TIME$;" Date ";DATE$
  55. 500 LPRINT
  56. 510 LPRINT "D:Filespec       Date        Bytes     300 BAUD    1200 BAUD    1200X BAUD"
  57. 520 LPRINT "-------------    ----------  ------      MM:SS       MM:SS        MM:SS"
  58. 530 FOR P = 1 TO D
  59. 540 GOSUB 670
  60. 545 IF L#/1024 <>  INT(L#/1024) THEN L#=(INT(L#/1024)+1)*1024
  61. 550 TOT#=TOT#+L#
  62. 560 NEXT P
  63. 570 LPRINT:LPRINT
  64. 580 LPRINT P-1;" FILES on  ";TITLE$:LPRINT USING "###,###  Bytes used on this diskette ";TOT#;
  65. 590 '
  66. 600 LPRINT:'
  67. 610 LPRINT :LPRINT FRR$:LPRINT:LPRINT
  68. 620 CLS:PRINT "YOU ARE BACK IN BASIC NOW "
  69. 630 END
  70. 640 PRINT "ERROR ";ERR;" HAS OCCURED IN LINE # ";ERL
  71. 650 IF ERR>23 AND ERR<27 THEN PRINT " PLACE YOUR PRINTER ON LINE PLEASE:
  72. 660 END
  73. 670 ' Subroutine to get filesize/date and compute transfer times
  74. 680 ' Written by Rich Schinnell Rockville,Md 20853
  75. 690 ' Copyright 1982, Free to anyone on a not-for-profit basis.
  76. 700 ' Not to be sold for profit, Can be given away only.......
  77. 710 ' All rights reserved.........E N J O Y ! ! ! ! ! ! ! ! !
  78. 720 OPEN F$(P) FOR INPUT AS #1
  79. 730 FCB1% = VARPTR(#1)                 'SET PTR TO FCB FOR INPUT FILE
  80. 740 BYTESIZ1# = PEEK(FCB1%+17)+256*PEEK(FCB1%+18)+256*256*PEEK(FCB1%+19)                +256*256*256*PEEK(FCB1%+20)     'Calculate file size in bytes
  81. 750 TDATE% = PEEK(FCB1%+21) OR 256*PEEK(FCB1%+22)
  82. 760 CLOSE #1
  83. 770 T = INT(BYTESIZ1#/30):M=INT(T/60):S=T-M*60:IF S<1 THEN S =1
  84. 771 IF S < 10 THEN S$="0"+RIGHT$(STR$(S),1) ELSE S$=RIGHT$(STR$(S),2)
  85. 772 T12 = INT(BYTESIZ1#/120):M12=INT(T12/60):S12=T12-M12*60:IF S12<1 THEN S12 = 1
  86. 774 IF S12 < 10 THEN S12$="0"+RIGHT$(STR$(S12),1) ELSE S12$=RIGHT$(STR$(S12),2)
  87. 775 BLK = INT(BYTESIZ1#/128)
  88. 776 T12X = INT(BLK * 1.8)
  89. 778 M12X=INT(T12X/60):S12X=T12X-M12X*60:IF S12X<1 THEN S12X =1
  90. 779 IF S12X < 10 THEN S12X$="0"+RIGHT$(STR$(S12X),1) ELSE S12X$=RIGHT$(STR$(S12X),2)
  91. 780 L# = BYTESIZ1#
  92. 790 DTYR% = (TDATE% \ (256*2) ) + 1980
  93. 800 DTI# = (TDATE% - (DTYR% - 1980) * (256*2))
  94. 810 DTMO% = DTI# \ 32
  95. 820 DTDA% = DTI# - DTMO% * 32
  96. 830 SDATE$ = "0M-0D-YYYY"
  97. 840 MID$( SDATE$,1,2 ) = RIGHT$( STR$(DTMO%+100) ,2)
  98. 850 IF VAL(LEFT$(SDATE$,2))<10 THEN MID$(SDATE$,1,1)="0"
  99. 860 MID$( SDATE$,4,2 ) = RIGHT$( STR$(DTDA%+100), 2 )
  100. 870 MID$( SDATE$,7,4 ) = RIGHT$( STR$(DTYR%), 4 )
  101. 880 T = INT(BYTESIZ1#/30):M=INT(T/60):S=T-M*60:L#=BYTESIZ1#
  102. 890 IF S <10 THEN S$="0"+RIGHT$(STR$(S),1) ELSE S$=RIGHT$(STR$(S),2)
  103. 900 'SDATE$= DATE file was last updated
  104. 910 ' l# = filesize in bytes ###### format
  105. 920 ' M = minutes to transfer at 300 baud
  106. 930 ' s$ = seconds to transfer at 300 baud leading zero s = seconds no zero
  107. 940 ' this method only works in intrepeted basic. If you are going to
  108. 950 ' compile a pgm then you can't use the varptr you have to peek at a
  109. 960 ' high memory value, I have found it if you wish to know it just give
  110. 970 ' Rich Schinnell a call and I will be glad to help you... Rich
  111. 980 PRINT USING "\            \   \        \  ######       ##:\\       ##:\\       ##:\\ ";F$(P);SDATE$;L#;M;S$;M12;S12$;M12X;S12X$
  112. 990 LPRINT USING "\            \   \        \  ######      ##:\\       ##:\\       ##:\\ ";F$(P);SDATE$;L#;M;S$;M12;S12$;M12X;S12X$
  113. 1000 RETURN
  114.