home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols200 / vol250 / exit38.aqc / EXIT38.ASC
Text File  |  1986-02-11  |  2KB  |  80 lines
  1. 100    '  EXIT38.ASC, version 07/17/85
  2. 102    '  Exit RCP/M system with Comments
  3. 104    '   For use with RBBS38 
  4. 106    '       By Dennis Recla
  5. 108     '
  6. 120    ' First find out where the LASTCALR file is
  7. 122    '
  8. 130    DEFINT A-Z
  9. 135    DIM H(6),HT(6),HD(6),TOD(5),DOY(5)
  10. 140    ERS$=CHR$(8)+" "+CHR$(8)
  11. 150     DSK$="A:"
  12. 155    CRLF$=CHR$(13)+CHR$(10)
  13. 160    '
  14. 200    OPEN "I",1,DSK$+"BOOTPWD":IF EOF(1) THEN 300
  15. 210    INPUT #1,DSK2$,DSK3$
  16. 220    '
  17. 230    'DSK2$ is location of COMMENTS file.
  18. 240    'DSK3$ is location of LASTCALR file.
  19. 250    '
  20. 300    CLOSE #1
  21. 320    '
  22. 340    OPEN "I",1,DSK3$+"LASTCALR":INPUT #1,N$,O$,D$:CLOSE
  23. 350     IF N$="SYSOP" THEN 940
  24. 360    PRINT
  25. 380    PRINT N$+" "+O$+"  Want to leave any comments (Y/N)? ";:C=1:GOSUB 980:C=0
  26. 400    IF LEFT$(B$,1)="N" OR LEFT$(B$,1)="n" THEN 720
  27. 420    IF LEFT$(B$,1)<>"Y" AND LEFT$(B$,1)<>"y" THEN 380
  28. 440    PRINT
  29. 460    OPEN "R",1,DSK2$+"COMMENTS.",65:FIELD#1,65 AS RR$
  30. 480    GET#1,1:RE=VAL(RR$)+1:RL=65
  31. 500    IF RE=1 THEN RE=2
  32. 520    S$=CRLF$+"From: "+N$+" "+O$+"  "+D$+"  ( On Exit)":GOSUB 1200
  33. 540    PUT#1,RE
  34. 560    PRINT "Enter comments, <return> to end, (16 lines max)"
  35. 580    PRINT
  36. 600    PRINT "-->";
  37. 620    GOSUB 980
  38. 640    IF B$="" THEN 700    
  39. 660    RE=RE+1:S$=B$:RL=65:GOSUB 1200:PUT#1,RE 
  40. 680    GOTO 600
  41. 700    S$=STR$(RE):RL=65:GOSUB 1200:PUT#1,1:CLOSE
  42. 720 'COME HERE TO EXIT
  43. 920    PRINT
  44. 940    RUN "A:SUPER.COM"
  45. 960    END
  46. 980    '
  47. 1000    '  Accept string into B$ from console
  48. 1020    '
  49. 1040    GOSUB 1320
  50. 1060    B$=SAV$
  51. 1080    IF LEN(B$)=0 THEN RETURN
  52. 1100    IF C=0 THEN 1180
  53. 1120    FOR ZZ=1 TO LEN(B$)
  54. 1140    MID$(B$,ZZ,1)=CHR$(ASC(MID$(B$,ZZ,1))+32*(ASC(MID$(B$,ZZ,1))>96))
  55. 1160    NEXT ZZ
  56. 1180    RETURN
  57. 1200    '
  58. 1220    '  Fill and store disk record
  59. 1240    '
  60. 1260    LSET RR$=LEFT$(S$+SPACE$(RL-2),RL-2)+CHR$(13)+CHR$(10)
  61. 1280    RETURN
  62. 1300    '
  63. 1320    CHC=0:SAV$=""
  64. 1340    NCH=ASC(INPUT$(1))
  65. 1360    IF NCH=127 THEN    1500
  66. 1380    IF NCH<32 THEN 1560
  67. 1400    IF CHC>=62 THEN PRINT CHR$(7);:GOTO 1340
  68. 1420    SAV$=SAV$+CHR$(NCH):CHC=CHC+1:PRINT CHR$(NCH);
  69. 1440    IF CHC=55 THEN PRINT CHR$(7);
  70. 1460    GOTO 1340
  71. 1480    '
  72. 1500    IF CHC=0 THEN 1340 ELSE PRINT RIGHT$(SAV$,1);:GOTO 1540
  73. 1520    IF CHC=0 THEN 1340 ELSE PRINT ERS$;
  74. 1540    CHC=CHC-1:SAV$=LEFT$(SAV$,CHC):GOTO 1340
  75. 1560    IF NCH=8 THEN 1520
  76. 1580    IF NCH=13 THEN PRINT:RETURN
  77. 1600    IF NCH=21 THEN PRINT " #":GOTO 1320
  78. 1620    IF NCH<>24 OR CHC=0 THEN 1340
  79. 1640    FOR BCC=1 TO CHC:PRINT ERS$;:NEXT BCC:GOTO 1320
  80.