home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 17 / CD_ASCQ_17_101194.iso / vrac / clptod.zip / CLPTODBW.PRG next >
Text File  |  1994-08-28  |  18KB  |  723 lines
  1. parameters srcfile,destfile
  2.  
  3. && Author:  Brad Tharalson   72030,3045
  4.  
  5. #include "fileio.ch"
  6.  
  7. #define TABWIDTH 2
  8. #define MAXCHK 15
  9.  
  10. private ii,jj,kk,orgstr,retstr,thandle,pc1,pc2,thand2,ln,indent,curline
  11. private cpy,acomment,nextline,parscnt,pars[120],line,outfile,usemxr,tempfile
  12. declare simple[MAXCHK,2],xarr[120],xcnt,late[MAXCHK,2],cmplx[MAXCHK,2]
  13. declare badlines[200],bdcnt,errmess,inproc
  14.  
  15. outfile="byhand.txt"   // printer output file
  16. tempfile="mx.prg"
  17. usemxr=.t.   // switch @ commands to use generic printing subsystem
  18. if pcount()=0
  19.   srcfile="testfile.prg"
  20. endif
  21. if pcount()<2
  22.   destfile=tempfile
  23. endif
  24. if !("PRG" $ upper(srcfile))
  25.   srcfile=trim(srcfile)+".prg"
  26. endif
  27. if !("PRG" $ upper(destfile))
  28.   destfile=trim(destfile)+".prg"
  29. endif
  30. if !file(srcfile)
  31.   wait "Source File: "+srcfile+" - Not Found"
  32.   return
  33. endif
  34. cpy=.t.
  35. // @ 5,0 say "Copy Converted File Over Original" get cpy pict "Y"
  36. // read
  37.  
  38. bdcnt=0
  39. afill(badlines," ")
  40. clear screen
  41. @ 1,0 say "Converting Clipper Style Program "+upper(srcfile)+ ;
  42.   " to dBase for Windows Style"
  43. if destfile=tempfile
  44.   @ 3,0 say "Saving Conversion As Original File"
  45. else
  46.   @ 3,0 say "Saving Conversion As "+upper(destfile)
  47. endif
  48. cnvrt(srcfile,destfile)
  49. if bdcnt>0
  50.   @ 5,0 say "Be Sure To Check File "+upper(outfile)+ ;
  51.     " For A List Of Necessary Corrections"
  52.   devtopr()
  53.   line=0
  54.   @ line,0 say padc("The Following Lines Need To Be Adjusted By Hand",80)
  55.   line++
  56.   line++
  57.   @ line,0 say upper(srcfile)
  58.   line++
  59.   line++
  60.   for ii=1 to bdcnt
  61.     @line,3 say badlines[ii]
  62.     line++
  63.   next
  64.   fcrlf()
  65.   fcrlf()
  66.   eject
  67.   devtoscr()
  68.   // copyfile(outfile,"LPT1")
  69. endif
  70. if cpy .and. tempfile=destfile
  71.   pc1=noext(srcfile,".")
  72.   delfile(srcfile)
  73.   copyfile(destfile,srcfile)
  74.   delfile(destfile)
  75. endif
  76. ?
  77. ?
  78.  
  79.  
  80. function cnvrt(srcfile,destfile)
  81.  
  82. retstr=""
  83. for ii=1 to MAXCHK
  84.   afill(simple[ii]," ")
  85.   afill(late[ii]," ")
  86. next
  87. && simple substitions, done first
  88. simple[1,1]="//"
  89. simple[1,2]="&&"
  90. simple[2,1]="!="
  91. simple[2,2]="<>"
  92. simple[3,1]="=="
  93. simple[3,2]="="
  94. simple[4,1]="clear screen"
  95. simple[4,2]="clrscrn()"
  96. simple[5,1]="close all"
  97. simple[5,2]="clozall()"
  98. simple[6,1]="]["
  99. simple[6,2]=","
  100. simple[7,1]="!"
  101. simple[7,2]=".not. "
  102. && simple substitions, done last
  103. late[1,1]="unlockit"   // unlockit first because lockit is subpart
  104. late[1,2]="mxunlock"
  105. late[2,1]="lockit"
  106. late[2,2]="mxlock"
  107. late[3,1]="dbappend"
  108. late[3,2]="mxappend"
  109. late[4,1]="append blank"
  110. late[4,2]="mxappend()"
  111. late[5,1]="dbseek("
  112. late[5,2]='mxseek(" ",'
  113. late[6,1]="dbsetorder("
  114. late[6,2]='mxsetorder(" ",'
  115. late[7,1]="mxlock(."
  116. late[7,2]='mxlock(" ",.'
  117. && complex substitions of form emp->(lockit())
  118. cmplx[1,1]="unlockit"
  119. cmplx[1,2]="mxunlock"
  120. cmplx[2,1]="lockit"
  121. cmplx[2,2]="mxlock"
  122. cmplx[3,1]="dbappend"
  123. cmplx[3,2]="mxappend"
  124. cmplx[4,1]="dbseek"
  125. cmplx[4,2]="mxseek"
  126. cmplx[5,1]="clozdbf"
  127. cmplx[5,2]="mxclose"
  128. cmplx[6,1]="dbsetorder"
  129. cmplx[6,2]="mxsetorder"
  130. cmplx[7,1]="eof"
  131. cmplx[7,2]="mxeof"
  132. cmplx[8,1]="dbskip"
  133. cmplx[8,2]="mxskip"
  134. cmplx[9,1]="recno"
  135. cmplx[9,2]="mxrecno"
  136. cmplx[10,1]="dbgobottom"
  137. cmplx[10,2]="mxbottom"
  138. cmplx[11,1]="dbgotop"
  139. cmplx[11,2]="mxtop"
  140. cmplx[12,1]="dbgoto"
  141. cmplx[12,2]="mxgoto"
  142. thandle=fopen(srcfile)
  143. thand2=fcreate(destfile)
  144. tst=freadln(thandle)
  145. curline=1
  146. inproc=.t.
  147. nextline=.f.
  148. do while .not. feof(thandle)
  149.   fixline()
  150.   tst=freadln(thandle)
  151.   curline++
  152. enddo
  153. fixline()
  154. fclose(thandle)
  155. fclose(thand2)
  156.  
  157.  
  158. function fixline
  159.  
  160. local tt2,tt3,jj,ii,kk,mm
  161.  
  162.   indent=0
  163.   if len(tst)>0
  164.     orgstr=tst
  165.     retstr=""
  166.     for ii=1 to len(orgstr)
  167.       tt2=substr(orgstr,ii,1)
  168.       if asc(tt2)=9  // tab key
  169.         tt2=space(TABWIDTH)
  170.       endif
  171.       retstr=retstr+tt2
  172.     next
  173.     orgstr=retstr
  174.     setindent(orgstr)
  175.     retstr=ltrim(retstr)
  176.     // ++ option
  177.     if "++" $ retstr .and. .not. ("+++" $ retstr)
  178.       ii=at("++",retstr)
  179.       pc1=substr(retstr,1,ii-1)
  180.       retstr=substr(retstr,1,ii-1)+"="+ltrim(pc1)+"+1"
  181.     endif
  182.     // -- option
  183.     if "--" $ retstr .and. .not. ("---" $ retstr)
  184.       ii=at("--",retstr)
  185.       pc1=substr(retstr,1,ii-1)
  186.       retstr=substr(retstr,1,ii-1)+"="+ltrim(pc1)+"+1"
  187.       retstr=pc1+"="+ltrim(pc1)+"-1"
  188.     endif
  189.     // += option
  190.     if "+=" $ retstr
  191.       split(retstr,"+")
  192.       pc1=pars[1]
  193.       split(retstr,"=")
  194.       pc2=pars[2]
  195.       retstr=pc1+"="+ltrim(pc1)+"+("+pc2+")"
  196.     endif
  197.     // -= option
  198.     if "-=" $ retstr
  199.       split(retstr,"-")
  200.       pc1=pars[1]
  201.       split(retstr,"=")
  202.       pc2=pars[2]
  203.       retstr=pc1+"="+ltrim(pc1)+"-("+pc2+")"
  204.     endif
  205.     // *= option
  206.     if "*=" $ retstr
  207.       split(retstr,"*")
  208.       pc1=pars[1]
  209.       split(retstr,"=")
  210.       pc2=pars[2]
  211.       retstr=pc1+"="+ltrim(pc1)+"*("+pc2+")"
  212.     endif
  213.     // /= option
  214.     if "/=" $ retstr
  215.       split(retstr,"/")
  216.       pc1=pars[1]
  217.       split(retstr,"=")
  218.       pc2=pars[2]
  219.       retstr=pc1+"="+ltrim(pc1)+"/("+pc2+")"
  220.     endif
  221.     for ii=1 to MAXCHK
  222.       if !empty(simple[ii,1])
  223.         if ii=7 .and. "pict" $ retstr
  224.           loop
  225.         endif
  226.         jj=at(simple[ii,1],retstr)
  227.         do while jj>0
  228.           pc1=""
  229.           pc2=""
  230.           if jj>1
  231.             pc1=substr(retstr,1,jj-1)
  232.             if len(retstr)>(jj-1+len(simple[ii,1]))
  233.               pc2=substr(retstr,jj+len(simple[ii,1]),120)
  234.             endif
  235.           else
  236.             pc2=substr(retstr,len(simple[ii,1])+1,120)
  237.           endif
  238.           retstr=pc1+simple[ii,2]+pc2
  239.           jj=at(simple[ii,1],retstr)
  240.         enddo
  241.       endif
  242.     next
  243.     // save the comment and clear it
  244.     acomment=" "
  245.     ii=at("&&",retstr)
  246.     do case
  247.       case ii=1
  248.         acomment=retstr
  249.         retstr=""
  250.       case ii>1
  251.         acomment=" "+substr(retstr,ii,120)
  252.         retstr=trim(substr(retstr,1,ii-1))
  253.     endcase
  254.     if "set ord" $ retstr
  255.       split(retstr,"s")
  256.       retstr=pars[1]+'mxsetorder(" ",'+ltrim(str(procint(retstr),2,0))+')'
  257.     endif
  258.     if "seek " $ retstr
  259.       split(retstr,"k")
  260.       retstr='mxseek(" ",'+ltrim(trim(pars[2]))+')'
  261.     endif
  262.     // now for more complicated stuff
  263.     if ":=" $ retstr .and. "->" $ retstr
  264.       split(retstr,":")
  265.       pc1=pars[1]
  266.       orgstr=ltrim(pc1)
  267.       ii=at(":=",retstr)
  268.       pc2=substr(retstr,ii+2,120)
  269.       retstr="replace "+orgstr+" with "+pc2
  270.     endif
  271.     if "->(" $ retstr
  272.       for jj=1 to MAXCHK
  273.         if !empty(cmplx[jj,1])
  274.           split(retstr," ")
  275.           retstr=""
  276.           for ii=1 to parscnt
  277.             xarr[ii]=pars[ii]
  278.           next
  279.           xcnt=parscnt
  280.           for ii=1 to xcnt
  281.             if cmplx[jj,1] $ xarr[ii]
  282.               split(xarr[ii],"-")
  283.               pc1=pars[1]
  284.               if "()" $ xarr[ii]  // no param
  285.                 xarr[ii]=cmplx[jj,2]+'("'+pc1+'")'
  286.               else   // has a param
  287.                 split(xarr[ii],"(")
  288.                 xarr[ii]=pars[3]
  289.                 split(xarr[ii],")")
  290.                 pc2=pars[1]
  291.                 xarr[ii]=cmplx[jj,2]+'("'+pc1+'",'+pc2+')'
  292.               endif
  293.             endif
  294.             if ii<xcnt
  295.               retstr=retstr+xarr[ii]+" "
  296.             else
  297.               retstr=retstr+xarr[ii]
  298.             endif
  299.           next
  300.         endif
  301.       next
  302.     endif
  303.     for ii=1 to MAXCHK
  304.       if !empty(late[ii,1])
  305.         if ii=7 .and. "pict" $ retstr
  306.           loop
  307.         endif
  308.         jj=at(late[ii,1],retstr)
  309.         do while jj>0
  310.           pc1=""
  311.           pc2=""
  312.           if jj>1
  313.             pc1=substr(retstr,1,jj-1)
  314.             if len(retstr)>(jj-1+len(late[ii,1]))
  315.               pc2=substr(retstr,jj+len(late[ii,1]),120)
  316.             endif
  317.           else
  318.             pc2=substr(retstr,len(late[ii,1])+1,120)
  319.           endif
  320.           retstr=pc1+late[ii,2]+pc2
  321.           jj=at(late[ii,1],retstr)
  322.         enddo
  323.       endif
  324.     next
  325.     pc1=ltrim(upper(retstr))
  326.     if "PROCEDU" $ pc1
  327.       inproc=.t.
  328.     endif
  329.     if "FUNCTIO" $ pc1
  330.       inproc=.f.
  331.     endif
  332.     if bdcnt<200
  333.       errmess=" "
  334.       // convert @ ?,? say ? to mxr(?,?,?)
  335.       if usemxr
  336.         pc2=trim(pc1)
  337.         if substr(pc1,1,1)=="@" .and. !(" GET " $ pc1) .and. "SAY" $ pc1
  338.           if substr(pc2,len(pc2),1)==";"
  339.             errmess="Convert to mxr()"
  340.           else
  341.             // check for @3,5 style, convert to @ 3,5
  342.             if substr(pc1,2,1)<>" "
  343.               retstr="@ "+substr(retstr,2,120)
  344.             endif
  345.             jj=at(" say ",retstr)
  346.             kk=at(", ",retstr)
  347.             if kk>0 .and. kk<jj
  348.               retstr=stuff(retstr,kk,2,",")
  349.             endif
  350.             jj=at(" say ",retstr)
  351.             kk=at("  ",retstr)
  352.             if kk>0 .and. kk<jj
  353.               retstr=stuff(retstr,kk,2," ")
  354.             endif
  355.             split(retstr," ")
  356.             pc1=""
  357.             jj=at(" say ",retstr)
  358.             kk=at(" picture",retstr)
  359.             mm=len(" picture")
  360.             if kk=0
  361.               kk=at(" pict",retstr)
  362.               mm=len(" pict")
  363.             endif
  364.             tt3=" "
  365.             if kk=0
  366.               kk=len(retstr)
  367.               tt2=substr(retstr,jj+5,kk-(jj+5)+1)
  368.             else
  369.               tt2=substr(retstr,jj+5,kk-(jj+5)+1)
  370.               tt3=trim(substr(retstr,kk+mm,len(retstr)))
  371.             endif
  372.             for ii=1 to parscnt
  373.               pc2=pars[ii]
  374.               if !empty(pars[ii])
  375.                 do case
  376.                   case pc2="@"
  377.                     pc2="mxr("
  378.                   case pc2="say"
  379.                     pc2=","
  380.                     if !empty(tt3)
  381.                       for jj=ii+1 to parscnt
  382.                         pars[jj]=" "
  383.                       next
  384.                       pars[ii+1]="transform("+trim(tt2)+","+ltrim(trim(tt3))+")"
  385.                     else
  386.                       for jj=ii+1 to parscnt
  387.                         pars[jj]=" "
  388.                       next
  389.                       pars[ii+1]=trim(tt2)
  390.                     endif
  391.                 endcase
  392.                 if ii<parscnt
  393.                    pc1=pc1+pc2
  394.                 endif
  395.               endif
  396.             next
  397.             pc1=pc1+trim(pc2)+")"
  398.             retstr=pc1
  399.           endif
  400.         endif
  401.       endif
  402.       pc1=upper(retstr)
  403.       if "LOCAL" $ pc1 .and. ("[" $ pc1 .or. "{" $ pc1)
  404.         errmess="Use Declare"
  405.       endif
  406.       if "PRIVATE" $ pc1 .and. ("[" $ pc1 .or. "{" $ pc1)
  407.         errmess="Use Declare"
  408.       endif
  409.       if "STATIC" $ pc1 .and. ("[" $ pc1 .or. "{" $ pc1)
  410.         errmess="Use Declare"
  411.       endif
  412.       if "PUBLIC" $ pc1 .and. ("[" $ pc1 .or. "{" $ pc1)
  413.         errmess="Use Public Array"
  414.       endif
  415.       if "AFILL" $ pc1 .and. "[" $ pc1
  416.         errmess="Delete brackets"
  417.       endif
  418.       if "AADD" $ pc1 .and. "[" $ pc1
  419.         errmess="Change AADD to AGROW"
  420.       endif
  421.       if "FOUND()" $ pc1 .and. "->" $ pc1
  422.         errmess="Can't Use found() in ->()"
  423.       endif
  424.       if "DESCEND()" $ pc1
  425.         errmess="Can't Use descend() in dBase"
  426.       endif
  427.       if ")->" $ pc1
  428.         errmess="Use Macro (&) With Priv. Var"
  429.       endif
  430.       if "@" $ pc1 .and. !("mxr(" $ pc1)
  431.         jj=at("@",pc1)   // check for var passing by referece using "@"
  432.         if jj>1 .and. numsequal(procint(substr(pc1,jj+1,2)))
  433.           errmess="Change to: do ? with ?"
  434.         endif
  435.       endif
  436.       if "NIL" $ pc1
  437.         errmess="Use pcount()"
  438.       endif
  439.       if " % " $ pc1
  440.         errmess="Use mod()"
  441.       endif
  442.       if ":=" $ pc1 .and. !("->" $ pc1)
  443.         for ii=1 to 20
  444.           jj=at(":=",retstr)
  445.           if jj>0
  446.             retstr=stuff(retstr,jj,2,"=")
  447.           else
  448.             exit
  449.           endif
  450.         next
  451.       endif
  452.       pc1=trim(pc1)
  453.       if !inproc .and. "RETURN" $ pc1
  454.         if trim(pc1)=="RETURN"   // no return value, an error in functions
  455.           retstr="return 0"
  456.         endif
  457.       endif
  458.       if !empty(errmess)
  459.         bdcnt++
  460.         pc1=ltrim(retstr)
  461.         badlines[bdcnt]=str(curline,5)+":  "+ ;
  462.           padr(substr(pc1,1,35),35)+" > "+errmess
  463.       endif
  464.     endif
  465.     retstr=trim(retstr)
  466.     if substr(retstr,len(retstr)-1,2)==";)"
  467.       retstr=substr(retstr,1,len(retstr)-1)
  468.       nextline=.t.
  469.     else
  470.       if nextline
  471.         retstr=retstr+")"
  472.         nextline=.f.
  473.       endif
  474.     endif
  475.     fwrite(thand2,space(indent)+retstr+acomment+chr(13)+chr(10))
  476.   else
  477.     fwrite(thand2,chr(13)+chr(10))
  478.   endif
  479.  
  480.  
  481. function setindent(ostr)
  482.  
  483.   local tt
  484.  
  485.   indent=0
  486.   tt=ltrim(ostr)
  487.   indent=len(ostr)-len(tt)
  488.   return indent
  489.  
  490.  
  491. // the following functions are used extensively in other code
  492.  
  493. function noext(fname)  // NOEXT  return file name minus extension
  494.  
  495. local ii
  496.  
  497.   if fname=NIL
  498.     return nil
  499.   endif
  500.   ii=at(".",fname)
  501.   if ii>1
  502.     return substr(fname,1,ii-1)
  503.   else
  504.     return fname
  505.   endif
  506.  
  507.  
  508. function copyfile( cpyn1,cpyn2 )   && COPYFILE
  509.  
  510.   copy file (cpyn1) to (cpyn2)
  511.  
  512.  
  513. function delfile(fname)   && DELFILE
  514.  
  515.   if file(fname)
  516.     delete file (fname)
  517.   endif
  518.  
  519.  
  520. function fcrlf(cnt)   && FCRLF   handy for flushing last line of forms/checks
  521.  
  522.   @ prow(),pcol() say chr(13)+chr(10)
  523.  
  524.  
  525. function devtopr  && used for reports involving @"s   DEVTOPR
  526.  
  527.   set printer to &outfile
  528.   set device to printer
  529.   setprc(0,0)
  530.   return .t.
  531.  
  532.  
  533. function devtoscr  && DEVTOSCR
  534.  
  535.   setprc(0,0)
  536.   set device to screen
  537.   set printer to
  538.   return .t.
  539.  
  540.  
  541. function split( orgline,pchar,altarray,altcnt )   && SPLIT
  542.  
  543.   local aline,tline,ii,jj,kk,ats[80],acnt
  544.  
  545.   if pchar=NIL
  546.     pchar=":"
  547.   endif
  548.   aline=trim(orgline)
  549.   jj=len(aline)
  550.   afill(ats,0)
  551.   if altarray==NIL
  552.     afill(pars,"")
  553.     parscnt=0
  554.     if jj>0
  555.       parscnt=1
  556.       ats[parscnt]=0
  557.       for ii=1 to jj
  558.         if substr(aline,ii,1)==pchar
  559.           parscnt++
  560.           ats[parscnt]=ii
  561.         endif
  562.       next
  563.       ats[parscnt+1]=jj+1
  564.       for ii=1 to parscnt
  565.         kk=ats[ii+1]-ats[ii]-1
  566.         if kk>0
  567.           pars[ii]=substr(aline,ats[ii]+1,kk)
  568.         endif
  569.       next
  570.     endif
  571.   else
  572.     afill(altarray,"")
  573.     altcnt=0
  574.     if jj>0
  575.       altcnt=1
  576.       ats[altcnt]=0
  577.       for ii=1 to jj
  578.         if substr(aline,ii,1)==pchar
  579.           altcnt++
  580.           ats[altcnt]=ii
  581.         endif
  582.       next
  583.       ats[altcnt+1]=jj+1
  584.       for ii=1 to altcnt
  585.         kk=ats[ii+1]-ats[ii]-1
  586.         if kk>0
  587.           altarray[ii]=substr(aline,ats[ii]+1,kk)
  588.         endif
  589.       next
  590.     endif
  591.   endif
  592.   return .t.
  593.  
  594.  
  595. function freadln( nHandle, nLineLength)  && FREADLN
  596.  
  597.    local nCurPos, nFileSize, nChrsToRead, nChrsRead
  598.    local cBuffer, cLines, nLines, cDelim, nCount, nEOLPos
  599.  
  600.    nLines := 1
  601.    cDelim := chr(13) + chr(10)
  602.    if nLineLength==NIL
  603.       nLineLength := 200  && was 80 in sample/fileio.prg
  604.    endif
  605.    nCurPos   := FilePos( nHandle )
  606.    nFileSize := FileSize( nHandle )
  607.    // Make sure no attempt is made to read past EOF
  608.    nChrsToRead := MIN( nLineLength, nFileSize - nCurPos )
  609.    cLines  := ""
  610.    nCount  := 1
  611.    do while (nCount <= nLines) .AND. ( nChrsToRead != 0 )
  612.       cBuffer   := SPACE( nChrsToRead )
  613.       nChrsRead := FREAD( nHandle, @cBuffer, nChrsToRead )
  614.       // Check for error condition
  615.       if ! (nChrsRead == nChrsToRead)
  616.          // Error!
  617.          // In order to stay conceptually compatible:=the other
  618.          // low-level file functions, force the user to check FERROR()
  619.          // (which was set by the FREAD() above) to discover this fact
  620.          //
  621.          nChrsToRead := 0
  622.       endif
  623.       nEOLPos := AT( cDelim, cBuffer )
  624.       // Update buffer and current file position
  625.       if nEOLPos == 0
  626.          cLines  += left( cBuffer, nChrsRead )
  627.          nCurPos += nChrsRead
  628.       else
  629.         if nEOLPos>1
  630.          cLines  += left( cBuffer, ( nEOLPos - 1 ))
  631.         endif
  632.         nCurPos +=(nEOLPos+len(cDelim)-1)
  633.         fseek( nHandle, nCurPos, FS_SET )
  634.       endif
  635.       // Make sure we don't try to read past EOF
  636.       if (nFileSize - nCurPos) < nLineLength
  637.          nChrsToRead := (nFileSize - nCurPos)
  638.       endif
  639.       nCount++
  640.    endDO
  641.    return cLines
  642.  
  643.  
  644. function numsequal( n1,n2,decs )  && NUMSEQUAL
  645.  
  646. && compare numbers for exact equality to specified places
  647.  
  648.   local nst1,nst2,width
  649.  
  650.   width=14
  651.   if n2==NIL
  652.     n2=0
  653.   endif
  654.   if decs==NIL
  655.     decs=4
  656.   endif
  657.   decs++
  658.   nst1=substr(str(n1,width,decs),1,width-1)
  659.   nst2=substr(str(n2,width,decs),1,width-1)
  660.   return nst1==nst2
  661.  
  662.  
  663. function procint( nval )   && PROCINT
  664.  
  665.   local decs,prnum,ii,jj,ist,pastdec,isminus
  666.  
  667.   prnum=0.00
  668.   pastdec=.f.
  669.   isminus=.f.
  670.   decs=1.0
  671.   for ii=1 to len(nval)
  672.     ist=substr(nval,ii,1)
  673.     if ist="-"
  674.       isminus=.t.
  675.     endif
  676.     if ist="."
  677.       pastdec=.t.
  678.     else
  679.       if ist >= "0" .and. ist <= "9"
  680.         jj=val(ist)
  681.         prnum = prnum * 10.0
  682.         prnum = prnum + jj
  683.         if pastdec
  684.           decs=decs / 10.0
  685.         endif
  686.       endif
  687.     endif
  688.   next
  689.   if isminus
  690.     prnum=(prnum * decs) * -1
  691.   else
  692.     prnum=prnum * decs
  693.   endif
  694.   if !pastdec
  695.     prnum=int(prnum)
  696.   endif
  697.   return prnum
  698.  
  699.  
  700. function feof( nhandle )  && FEOF
  701.  
  702.    return (if(filesize(nhandle) == filepos(nhandle), .T., .F. ))
  703.  
  704.  
  705. function filepos(nHandle)  && FILEPOS
  706.  
  707.   return fseek(nHandle, 0, 1)
  708.  
  709.  
  710. function filesize( nHandle )   && FILESIZE
  711.  
  712.    local nCurrent, nLength
  713.  
  714.    // save current position
  715.    nCurrent := FilePos(nHandle)
  716.    // Get file length
  717.    nLength := FSEEK(nHandle, 0, 2)
  718.    // Reset file position
  719.    fseek(nHandle, nCurrent)
  720.    return nLength
  721.  
  722.  
  723.