home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a085 / 1.ddi / CONVERT.PRG < prev    next >
Encoding:
Text File  |  1994-01-12  |  4.7 KB  |  161 lines
  1. *⌐░⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐┤
  2. *⌐ª      Program: CONVERT.PRG                                          ⌐ª
  3. *⌐ª     Function: ╩╣╙├ Low-Level File ║»╩²░╤╥╗╕÷ ASCII ├ⁿ┴ε╬─╝■        ⌐ª
  4. *⌐ª               ╫¬╗╗╡╜┴φ╥╗╕÷ ASCII ╬─╝■╡─╖╢└².                       ⌐ª
  5. *⌐╕⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐ñ⌐╝
  6. PROCEDURE convert
  7.    PRIVATE in_name, out_name, in_file, out_file, ;
  8.            blocksize, recsperblk, recsize, cblock, ;
  9.            write_ok
  10.  
  11.    * ╢¿╥σ┐Θ│ñ 840, ├┐╕÷┐Θ╙╨ 9╠⌡╝╟┬╝, ╝╟┬╝│ñ 86
  12.    #DEFINE blocksize   840
  13.    #DEFINE recsperblk    9
  14.    #DEFINE recsize      86
  15.  
  16.    * ╜¿┴ó┐Θ║═╝╟┬╝╡─╝╟╩²╞≈
  17.    nblocks    =   0
  18.    nrecs      =   0
  19.  
  20.    * ┤╙╗ß╗░┐≥╓╨╤í╘±╥╗╕÷ ASCII ├ⁿ┴ε╬─╝■╫≈╩Σ╚δ╬─╝■
  21.    in_name = GETFILE("","╤í╘± ASCII ├ⁿ┴ε╬─╝■╥╘╓┤╨╨")
  22.    IF "" = in_name   &&  ╚τ├╗╙╨╤í╘±╬─╝■╘≥═╦│÷
  23.       RETURN
  24.    ENDIF
  25.  
  26.    * ╜¿┴ó╩Σ│÷╬─╝■, ▓ó╕°╩Σ╚δ, ╩Σ╚δ╬─╝■┐╪╓╞┬δ
  27.    out_name = SYS(3) + ".$$$"
  28.    in_file  = 0
  29.    out_file = 0
  30.  
  31.    * ╝∞▓Θ┤φ╬≤╠⌡╝■, ┤φ╬≤╨┼╧ó╘┌╕≈╝∞▓Θ╫╙│╠╨≥╓╨╧╘╩╛
  32.    WAIT WINDOW " ╩Σ╚δ╬─╝■╓╗╘╩╨φ╙╔╫╓─╕, ╩²╫╓║═┐╒╕±╫Θ│╔, ╒²╘┌╜°╨╨╝∞▓Θ " NOWAIT
  33.    IF  !openfile(in_name, @in_file) ;
  34.          OR filempty(in_name, in_file) ;
  35.          OR !okchars(in_name, in_file) ;
  36.          OR !makefile(out_name, @out_file)
  37.          * ╚τ╣√│÷┤φ╘≥▓╗╝╠╨°╜°╨╨
  38.          = FCLOSE(in_file)
  39.          WAIT CLEAR
  40.          RETURN
  41.    ENDIF
  42.  
  43.    WAIT WINDOW " ╒²╘┌╢╘╩Σ╚δ╬─╝■ " + in_name + " ╫≈╫¬╗╗ " ;
  44.         NOWAIT
  45.    cblock     = ""
  46.    write_ok = .T.
  47.    * ░╤╥╗╕÷┐Θ block ╢┴╡╜ cblock ╓╨, ╚╗║≤░╤╞Σ╓╨╡─ 9╠⌡╩²╛▌╝╟┬╝╨┤╡╜
  48.    * ╩Σ│÷╬─╝■, ╝╟┬╝│ñ 90╕÷╫╓╖√, ╡½│²╚Ñ╝╟┬╝║┼╡─═╖ 4╕÷╫╓╖√.
  49.    DO WHILE !gotblock(@cblock, in_file, blocksize, @nblocks) AND write_ok
  50.       recpos = 17
  51.       FOR j=1 TO recsperblk
  52.          currec = " " + SUBSTR(cblock,recpos,recsize)
  53.          IF !empty(currec)
  54.             bytesout = FPUTS(out_file, currec)
  55.             IF bytesout != recsize + 3         && " "+CR+LF
  56.                ?? CHR(7)
  57.                WAIT WINDOW " ╘┌░╤╝╟┬╝╨┤╡╜╩Σ│÷╬─╝■ "+;
  58.                              out_name+" ╝╟┬╝│ñ╢╚▓╗╣╗ 86 bytes !" TIMEOUT 5
  59.                write_ok = .F.
  60.                nrecs = nrecs+1
  61.                EXIT
  62.             ENDIF
  63.             nrecs = nrecs+1
  64.          ENDIF
  65.  
  66.          recpos = recpos + recsize + 4
  67.       ENDFOR
  68.    ENDDO
  69.  
  70.    * ╣╪▒╒╩Σ╚δ║═╩Σ│÷╬─╝■
  71.    = FCLOSE(in_file)
  72.    = FCLOSE(out_file)
  73.  
  74.    * ╧╘╩╛╝╟┬╝║═┐Θ╩²
  75.    WAIT WINDOW " ╜¿┴ó┴╦ " + ltrim(str(nrecs)) + ;
  76.                " ╠⌡╝╟┬╝, └┤╫╘ " + ltrim(str(nblocks)) + ;
  77.                " ┐Θ." TIMEOUT 5
  78.    IF !addords(out_name)
  79.        WAIT WINDOW " ├╗╙╨╨▐╕─╩²╛▌┐Γ  " TIMEOUT 5
  80.    ENDIF
  81.    ERASE (out_name)
  82.    WAIT CLEAR
  83. RETURN
  84.  
  85. FUNCTION openfile
  86.    * ╝∞▓Θ╬─╝■┤≥┐¬
  87.    PARAMETERS f_name, f_handle
  88.    f_handle = FOPEN(f_name)
  89.    IF f_handle < 0
  90.       ?? CHR(7)
  91.       WAIT WINDOW " ▓╗─▄┤≥┐¬╬─╝■ " + UPPER(f_name)+"!" TIMEOUT 5
  92.    ENDIF
  93. RETURN f_handle > 0
  94.  
  95. FUNCTION filempty
  96.    * ╝∞▓Θ╬─╝■╩╟╖±╬¬┐╒
  97.    PARAMETERS f_name, f_handle
  98.    IF FEOF(f_handle)
  99.       ?? CHR(7)
  100.       WAIT WINDOW " ╬─╝■ " + UPPER(f_name) + " ╩╟┐╒╡─ !" ;
  101.          TIMEOUT 5
  102.    ENDIF
  103. RETURN FEOF(f_handle)
  104.  
  105. FUNCTION okchars
  106.    * ╝∞▓Θ╩Σ╚δ╬─╝■╩╟╖±╓╗╙╔╫╓─╕,╩²╫╓,║═┐╒╕±╫Θ│╔
  107.    PARAMETERS f_name, f_handle
  108.    PRIVATE b_str, all_ok, c
  109.    all_ok = .T.
  110.    DO WHILE !FEOF(f_handle) AND all_ok
  111.       b_str = FGETS(f_handle, 1000)
  112.       FOR j=1 TO len(b_str)
  113.          c = substr(b_str,j,1)
  114.          IF !isalpha(c) AND !isdigit(c) AND c != " "
  115.             ?? CHR(7)
  116.             WAIT WINDOW UPPER(f_name) + " ║¼╙╨╥╗╕÷╬▐╨º╡─╫╓╖√ " + ;
  117.                " ("+c+")!" TIMEOUT 5
  118.             all_ok = .F.
  119.             EXIT
  120.          ENDIF
  121.       ENDFOR
  122.    ENDDO
  123.    * ░╤╬─╝■╓╕╒δ╥╞╡╜╬─╝■╡─┐¬═╖┤ª
  124.    = FSEEK(f_handle, 0)
  125. RETURN all_ok
  126.  
  127. FUNCTION makefile
  128.    * ╝∞▓Θ╩Σ│÷╬─╝■╜¿┴ó╩╟╖±│╔╣ª
  129.    PARAMETERS f_name, f_handle
  130.    f_handle = FCREATE(f_name)
  131.    IF f_handle < 0
  132.       ?? CHR(7)
  133.       WAIT WINDOW " ╩Σ│÷╬─╝■ " + f_name + ;
  134.          " ▓╗─▄╜¿┴ó! " TIMEOUT 5
  135.    ENDIF
  136. RETURN f_handle > 0
  137.  
  138. FUNCTION gotblock
  139.    parameters b_str, f_handle, nbytes, nblocks
  140.    b_str = FGETS(f_handle, nbytes+10)
  141.    nblocks = IIF(len(b_str) = 0, nblocks, nblocks+1)
  142.    IF BETWEEN(len(b_str), 1, nbytes-1)
  143.       * FGETS() did not return enough data.
  144.          ?? CHR(7)
  145.       WAIT WINDOW " ┐Θ║┼ " + ltrim(str(nblocks)) + ;
  146.          " ╙╨ " + ltrim(str(len(b_str))) + " bytes.   ╥¬╟≤╙╨ " + ;
  147.          ltrim(str(nbytes)) + " bytes !" ;
  148.          TIMEOUT 5
  149.    ENDIF
  150. RETURN len(b_str) = nbytes
  151.  
  152. FUNCTION addords
  153.    * ╧≥╩²╛▌┐Γ TEMP.DBF ╓╨╫╖╝╙╝╟┬╝.
  154.    PARAMETERS new_ascii
  155.    WAIT WINDOW " ╧≥╩²╛▌┐Γ TEMP.DBF ╓╨╫╖╝╙╝╟┬╝. " NOWAIT
  156.    USE TEMP
  157.    APPEND FROM (new_ascii) TYPE SDF
  158.    GO TOP
  159.    BROW
  160. RETURN
  161.