home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1996 September / Simtel-MSDOS-Sep1996-CD1.iso / 00_info / simcvt3.for < prev    next >
Text File  |  1996-02-24  |  4KB  |  124 lines
  1. C  SIMCVT3.FOR
  2. C
  3. C  This is a updated version of SIMCVT2.FOR, the new version does not
  4. C  require to edit SIMIBM.IDX file first.  Make sure the SIMIBM.IDX and
  5. C  SIMCVT3.EXE are in the same diretory.
  6. C  To compile and run on a VAX/VMS machine, do the following:
  7. C                   FORTRAN SIMCVT3
  8. C                   LINK    SIMCVT3
  9. C                   RUN     SIMCVT3
  10. C
  11. C  Please direct any questions or comments to me. I hope you find
  12. C  this program helpful.  **PLEASE READ THE EXPLANATION BY ROGER KINGSLEY
  13. C  BELOW FOR DETAIL**
  14. C
  15. C  Dustin Fu
  16. C  Computer Operator
  17. C  Academic Computing Services
  18. C  University of Texas at Arlington
  19. C  Bitnet: c015fdh@utarlg
  20. C  THEnet: UTARLG::C015FDH
  21. C  Internet: c015fdh@utarlg.uta.edu
  22. C
  23. C  P.S. I like to express my appreciation to Roger Kingsley for his work
  24. C       to perfect this program.  
  25. C
  26. C++ ! RAK
  27. C  This program has been modified so as to eliminate the need for the ! RAK
  28. C  above pre-edit.  The modification involves commenting out one line ! RAK
  29. C  at the beginning of the main loop, and inserting a block of code in ! RAK
  30. C  its place.  All modified lines end with " ! RAK" for easy ! RAK
  31. C  identification. ! RAK
  32. C-- ! RAK
  33. C
  34. C++ ! RAK
  35. C  Modified by ! RAK
  36. C  Roger A. Kingsley ! RAK
  37. C  University Secretary ! RAK
  38. C  The University of Winnipeg ! RAK
  39. C  Winnipeg, Manitoba, Canada ! RAK
  40. C  BitNet:  KINGSLEY@UWPG02 ! RAK
  41. C-- ! RAK
  42. C
  43.       PROGRAM IDX2LST
  44.       CHARACTER BUF1*255, BUF2*255, CBUF1*1 ! RAK
  45.       INTEGER LBUF1,LBUF2 ! RAK
  46.       INTEGER   LGTH2, BITS2, DT2, REV2
  47.       CHARACTER FS1*4, DIR1*20
  48.       CHARACTER FS2*4, DIR2*20, FLNM2*12, DESCR2*46
  49.       CHARACTER DT*9, STYLE*1
  50. C
  51.       FS1 = ' '
  52.       DIR1 = ' '
  53. C
  54.       OPEN(UNIT=1,FILE='SIMIBM.IDX',STATUS='OLD')
  55.       OPEN(UNIT=2,FILE='SIMIBM.LST',STATUS='NEW')
  56. C
  57.       CALL DATE(DT)
  58.       WRITE(2,*) 'Simtel.Net Public Domain, Freeware and Shareware list as of '
  59.      +           ,DT
  60.       WRITE(2,*) ' '
  61.       WRITE(2,*) 'NOTE: Type B is Binary, Type A is ASCII'
  62. C
  63. C111   READ(1,*,END=999) FS2,DIR2,FLNM2,REV2,LGTH2,BITS2,DT2,DESCR2 ! RAK
  64. C++ ! RAK
  65. C     The above line "111   READ(1,*,END=999) FS2,..." has been ! RAK
  66. C     commented out, and the following block of code inserted, ending ! RAK
  67. C     with the line "      READ (BUF2(1:LBUF2),*) FS2,..." ! RAK
  68. C ! RAK
  69. C     The program has been modified to read a line from SIMIBM.IDX in ! RAK
  70. C     its original format, to make the alterations mentioned above, ! RAK
  71. C     and to re-read the edited line. ! RAK
  72. C-- ! RAK
  73. 111   CONTINUE ! RAK
  74.       READ (1,444,END=999) LBUF1,BUF1 ! RAK
  75. 444   FORMAT (Q,A) ! RAK
  76.       LBUF2 = 0 ! RAK
  77.       DO I=1,LBUF1 ! RAK
  78.          CBUF1 = BUF1(I:I) ! RAK
  79.          IF (CBUF1.EQ.'"') THEN ! RAK
  80.             LBUF2 = LBUF2+1 ! RAK
  81.             BUF2(LBUF2:LBUF2)='''' ! RAK
  82.          ELSE IF (CBUF1.EQ.'''') THEN ! RAK
  83.             LBUF2=LBUF2+2 ! RAK
  84.             BUF2(LBUF2-1:LBUF2) = '''''' ! RAK
  85.          ELSE ! RAK
  86.             LBUF2=LBUF2+1 ! RAK
  87.             BUF2(LBUF2:LBUF2) = CBUF1 ! RAK
  88.          END IF ! RAK
  89.       END DO ! RAK
  90.       READ(BUF2(1:LBUF2),*) FS2,DIR2,FLNM2,REV2,LGTH2,BITS2,DT2,DESCR2 ! RAK
  91. C++ ! RAK
  92. C     The modifications end here ! RAK
  93. C-- ! RAK
  94. C
  95.       IF ((FS1 .NE. FS2) .OR. (DIR1 .NE. DIR2)) THEN
  96.          WRITE(2,*) ' '
  97.          WRITE(2,*) 'Directory ', FS2, DIR2
  98.          WRITE(2,*) ' Filename   Type Length   Date    Description'
  99.          WRITE(2,*) '=============================================='
  100.          IF (BITS2 .EQ. 8) THEN
  101.              STYLE = 'B'
  102.          ELSE
  103.              STYLE = 'A'
  104.          ENDIF
  105.          WRITE(2,1001) FLNM2, STYLE, LGTH2, DT2, DESCR2
  106.          FS1 = FS2
  107.          DIR1 = DIR2
  108.       ELSE
  109.          IF (BITS2 .EQ. 8) THEN
  110.              STYLE = 'B'
  111.          ELSE
  112.              STYLE = 'A'
  113.          ENDIF
  114.          WRITE(2,1001) FLNM2, STYLE, LGTH2, DT2, DESCR2
  115.          FS1 = FS2
  116.          DIR1 = DIR2
  117.       ENDIF
  118.       GOTO 111
  119. 1001  FORMAT(1X, A, 2X, A, I8, I8, 2X, A)
  120. 999   CLOSE(UNIT=1)
  121.       CLOSE(UNIT=2)
  122.       STOP
  123.       END
  124.