home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / SIMTEL / CPMUG / CPMUG041.ARK / RESIZE3.BAS < prev    next >
BASIC Source File  |  1984-04-29  |  4KB  |  141 lines
  1. REM    RESIZE3.BAS
  2.     VERSION = 1.01
  3. REM    01/02/80
  4.  
  5. REM    RESIZE PROGRAM FOR THE MAILLIST FILES.
  6. REM    MODIFIED FOR USE WITH AMATEUR RADIO MAILIST.
  7.  
  8. REM    THIS PROGRAM WAS WRITTEN BY:    JAMES K. MILLS
  9. REM                    P.O. BOX 94864
  10. REM                    SCHAUMBURG, IL  60194
  11.  
  12.  
  13. REM    THE PROGRAM READS THE FLAGGED (1) RECORDS FROM    \
  14.     THE FILE INTO AN ARRAY IN MEMORY,        \
  15.     RE-CALCULATES THE KEY AND WRITES THE RECORD IN    \
  16.     THE CORRECT PLACEMENT IN THE FILE.
  17.  
  18. REM    THERE ARE DISADVANTAGES TO THIS TECHNIQUE.    \
  19.     FIRST OF ALL, MAKE A BACKUP DISC BEFORE THE    \
  20.     RECONFIGURATION. IF YOU HAVE A POWER FAILURE OR \
  21.     A SYSTEM FAILURE OF ANY KIND, YOUR FILES WILL    \
  22.     NOT BE LOST IF YOU HAVE A BACKUP.  ALSO, IF YOU \
  23.     HAVE LITTLE MEMORY, YOU WILL NOT BE ABLE TO RUN THIS    \
  24.     PROGRAM SUCCESSFULLY: USE THE RE-SIZE PROGRAM    \
  25.     BY WARD CHRISTENSEN WHICH             \
  26.     TRANSFERS A RECORD AT A TIME FROM THE        \
  27.     OLD FILE TO THE NEW FILE.
  28.  
  29.     BUF.LEN = 100    :REM BUFFER 100 RECORDS IN 12K OF MEMORY
  30.     REC.LEN = 128
  31.  
  32.     DIM SORT$(BUF.LEN), NAME$(BUF.LEN), CALL$(BUF.LEN),    \
  33.         STREET$(BUF.LEN), CITY$(BUF.LEN), ZIP$(BUF.LEN),\
  34.         PHONE$(BUF.LEN), CLASS$(BUF.LEN), PAID$(BUF.LEN),\
  35.         TYPE$(BUF.LEN)
  36.     PRINT CHR$ (26); CHR$ (0) : REM CLEAR ADM-3A SCREEN
  37.     PRINT "RESIZE3 PROGRAM VERSION "; VERSION:PRINT
  38.     PRINT "*** AMATEUR RADIO VERSION ***":PRINT
  39.     PRINT "FILE NAME MAY BE ENTERED WITH A: OR B:"
  40.     PRINT
  41.     PRINT "YOU CANNOT USE THE SAME NAME FOR OLD AND NEW FILES"
  42.     PRINT
  43. 5    INPUT "CAPITAL LETTERS ONLY! OLD FILE NAME";OLD.NAME$
  44.     INPUT "CAPITAL LETTERS ONLY! NEW FILE NAME";NEW.NAME$
  45.     PRINT
  46.     IF OLD.NAME$=NEW.NAME$ THEN PRINT "USE 2 DIFFERENT FILES":\
  47.     GOTO 5
  48.     INPUT "NEW FILE NUMBER OF RECORDS";NEW.LEN
  49.     DIM R1(NEW.LEN), R2(NEW.LEN), R3(NEW.LEN), R4(NEW.LEN), \
  50.     R5(NEW.LEN), R6(NEW.LEN), R7(NEW.LEN), R8(NEW.LEN)
  51.  
  52.     FILE OLD.NAME$(REC.LEN) :REM    #1 = OLD FILE
  53.     FILE NEW.NAME$(REC.LEN)    :REM    #2 = NEW FILE
  54.  
  55. REM    READ OLD RECORDS
  56.     LIVE.RECS.READ = 0 : LIVE.RECS.WRITTEN = 0
  57.     I=1 : N=0 : DONE = 0
  58. 10    PRINT "READING RECORDS FROM ";OLD.NAME$
  59. 11    IF END #1 THEN 15
  60.     READ #1,I;FLAG
  61.     IF FLAG = 0 THEN I=I+1:GOTO 11
  62.     READ #1,I;FLAG,SORT$(N),CALL$(N),NAME$(N),STREET$(N),    \
  63.         CITY$(N),ZIP$(N),PHONE$(N),CLASS$(N),PAID$(N),    \
  64.         TYPE$(N)
  65.     LIVE.RECS.READ=LIVE.RECS.READ+1
  66.     IF LIVE.RECS.READ/10=INT(LIVE.RECS.READ/10) THEN    \
  67.     PRINT LIVE.RECS.READ;" RECORDS READ"
  68.     IF N=BUF.LEN THEN 20
  69.     I=I+1:N=N+1:GOTO 11
  70. 15    DONE = 1
  71. 20    REM    WRITE RECORDS TO NEW FILE
  72.     PRINT "WRITING RECORDS TO ";NEW.NAME$
  73.     FOR A=0 TO N
  74.         GOSUB 1000
  75.         PRINT #2,KEY;1,SORT$(A),CALL$(A),NAME$(A),    \
  76.         STREET$(A),CITY$(A),ZIP$(A),PHONE$(A),        \
  77.         CLASS$(A),PAID$(A),TYPE$(A)
  78.         LIVE.RECS.WRITTEN=LIVE.RECS.WRITTEN+1
  79.         IF LIVE.RECS.WRITTEN/10=INT(LIVE.RECS.WRITTEN/10)\
  80.         THEN PRINT LIVE.RECS.WRITTEN; "RECORDS WRITTEN"
  81.     NEXT A
  82.     IF DONE = 0 THEN N=0:GOTO 10
  83.     PRINT
  84.     PRINT LIVE.RECS.READ; "TOTAL RECORDS READ"
  85.     PRINT LIVE.RECS.WRITTEN-1; "TOTAL RECORDS WRITTEN"
  86.     GOTO 9999
  87.  
  88. 1000    KEY = 0 : K = LEN (CALL$(A))
  89.     FOR B = K TO 1 STEP -1
  90.         KEY=16*KEY+(63 AND ASC(MID$(CALL$(A),B,1)))
  91.     NEXT B
  92.     KEY = KEY - NEW.LEN * INT(KEY/NEW.LEN)
  93.     KEY=INT(KEY+.1)
  94.     IF KEY <= 0 THEN KEY = 1
  95.  
  96. REM FIND OPEN SLOT IN FILE
  97.  
  98. 1100    K1=INT(KEY/256)+1
  99.  
  100.     IF K1=1 THEN 1110
  101.     IF K1=2 THEN 1111
  102.     IF K1=3 THEN 1112
  103.     IF K1=4 THEN 1113
  104.     IF K1=5 THEN 1114
  105.     IF K1=6 THEN 1115
  106.     IF K1=7 THEN 1116
  107.     IF K1=8 THEN 1117
  108.     PRINT:PRINT "ABANDON HOPE" :PRINT:STOP
  109. 1110    IF R1(KEY)<>0 THEN KEY=KEY+1:GOTO 1100
  110.     GOTO 1120
  111. 1111    IF R2(KEY-256)<>0 THEN KEY=KEY+1:GOTO 1100
  112.     GOTO 1120
  113. 1112    IF R3(KEY-512)<>0 THEN KEY=KEY+1:GOTO 1100
  114.     GOTO 1120
  115. 1113    IF R4(KEY-768)<>0 THEN KEY=KEY+1:GOTO 1100
  116.     GOTO 1120
  117. 1114    IF R5(KEY-1024)<>0 THEN KEY=KEY+1:GOTO 1100
  118.     GOTO 1120
  119. 1115    IF R6(KEY-1280)<>0 THEN KEY=KEY+1:GOTO 1100
  120.     GOTO 1120
  121. 1116    IF R7(KEY-1536)<>0 THEN KEY=KEY+1:GOTO 1100
  122.     GOTO 1120
  123. 1117    IF R8(KEY-1792)<>0 THEN KEY=KEY+1:GOTO 1100
  124. 1120    READ #2,KEY;FLAG
  125.     IF FLAG = 0 THEN RETURN
  126.     IF KEY > 1792 THEN R8(KEY-1792)=-1:GOTO 1150
  127.     IF KEY > 1536 THEN R7(KEY-1536)=-1:GOTO 1150
  128.     IF KEY > 1280 THEN R6(KEY-1280)=-1:GOTO 1150
  129.     IF KEY > 1024 THEN R5(KEY-1024)=-1:GOTO 1150
  130.     IF KEY > 768  THEN R4(KEY- 768)=-1:GOTO 1150
  131.     IF KEY > 512  THEN R3(KEY- 512)=-1:GOTO 1150
  132.     IF KEY > 256  THEN R2(KEY- 256)=-1:GOTO 1150
  133.     R1(KEY)=-1
  134. 1150    KEY = KEY + 1
  135.     IF KEY > NEW.LEN THEN KEY = 1
  136.     GOTO 1100
  137. 9999    CLOSE 2
  138.     CLOSE 1
  139. END
  140.  
  141.