home *** CD-ROM | disk | FTP | other *** search
/ PDA Software Library / pdasoftwarelib.iso / PSION / UTILS / FNDFIL / FINDFILE.OPL < prev   
Encoding:
Text File  |  1992-07-09  |  3.5 KB  |  187 lines
  1. proc findfile:
  2. local fmask$(55),s$(20,55),s%,fpath$(40),i%,eswit%,ec%,lc%
  3. local dswit%,pswit%,pg%,off%(6),pdev$(40),mess$(80)
  4. rem Variables from finfo:
  5. global fname$(128),a$(128)
  6. global fzts$(130) :rem ZTS version of fname$
  7. global e% :rem error from FilStatusGet
  8. global ver%,attrib%,size&,mdate&,spare& :rem keep together
  9. global yr%,mo%,dy%,hr%,mn%,sc%,yrday%
  10.  
  11. pswit%=1 :lc%=0 :dswit%=1
  12. while 1
  13.     if pswit%=3
  14.         lprint
  15.         lprint "END OF REPORT"
  16.         lprint chr$(12);
  17.         lclose
  18.         pswit%=2
  19.         busy off
  20.         giprint "Finished"
  21.     elseif lc%<>0
  22.         print "Finished. Press a key";
  23.         get
  24.         lc%=0
  25.     endif
  26.     pdev$="PAR:A"
  27.     fmask$=""
  28.     cls
  29.     dinit "Find File"
  30.     dedit fmask$,"File mask"
  31.     dchoice dswit%,"Show Properties","No,Yes"
  32.     dchoice pswit%,"Ouput to","Display,Printer"
  33.     dedit pdev$,"Print device"
  34.     if dialog=0 :return :endif
  35.     fmask$=parse$(fmask$,"*.*",off%())
  36.     if loc(fmask$,"\")=0
  37.         fmask$="\"+fmask$
  38.     endif
  39.     if pswit%>1
  40.         trap lopen pdev$
  41.         if err
  42.             mess$="Invalid print device ("+pdev$+")"
  43.             alert(mess$)
  44.             pswit%=1
  45.             continue
  46.         endif
  47.         busy "Printing results..."
  48.         lprint
  49.         lprint "Files like",fmask$," Printed:",datim$,"   Page: 1"
  50.         lprint
  51.         pswit%=3
  52.     else
  53.         cls
  54.     endif
  55.     lc%=0
  56.     pg%=1
  57.     s%=1
  58.     s$(s%)=fmask$
  59.     i%=len(fmask$)
  60.     while mid$(fmask$,i%,1)<>"\" :i%=i%-1 :endwh
  61.     fname$=mid$(fmask$,i%+1,99)
  62.     while s%>0
  63.         rem find all subdirectories
  64.         fmask$=s$(s%)
  65.         s%=s%-1
  66.         rem find \ at end of path name
  67.         i%=len(fmask$)
  68.         while mid$(fmask$,i%,1)<>"\" :i%=i%-1 :endwh
  69.         fpath$=left$(fmask$,i%)
  70.         eswit%=1 :onerr errlab::
  71.         a$=dir$(fpath$+"*.")
  72.         onerr off
  73.         while a$<>""
  74.             s%=s%+1
  75.             if s%>20
  76.                 beep 10,50
  77.                 alert("Program Stack Overflow")
  78.                 return
  79.             endif
  80.             s$(s%)=a$+"\"
  81.             a$=dir$("")
  82.         endwh
  83. filelab::
  84.         rem now get all file names that match
  85.         eswit%=2 :onerr errlab::
  86.         a$=dir$(fpath$+fname$)
  87.         onerr off
  88.         while a$<>""
  89.             if dswit%>1
  90.                 finfo:
  91.             endif
  92.             if pswit%>1
  93.                 if lc%>56
  94.                     lprint chr$(12)
  95.                     pg%=pg%+1
  96.                     lprint "Files like",fname$,"Page: ",pg%
  97.                     lprint
  98.                     lc%=0
  99.                 endif
  100.                 lprint left$(a$+" "+rept$(".",55),56);
  101.                 lprint props$:
  102.             else
  103.                 if lc%>7
  104.                     print "Paused..."
  105.                     lc%=get
  106.                     if lc%=27 :lc%=0 :s%=0 :break :endif
  107.                     lc%=0
  108.                 endif
  109.                 print a$
  110.                 if dswit%>1
  111.                     print props$:
  112.                     if pswit%<2
  113.                         lc%=lc%+1
  114.                     endif
  115.                 endif
  116.             endif
  117.             lc%=lc%+1
  118.             a$=dir$("")
  119.         endwh
  120. flab2::
  121.     endwh
  122.     beep 10,50
  123. endwh
  124. return
  125. errlab::
  126.     ec%=err
  127.     onerr off
  128.     if abs(ec%)=38
  129.         alert("Bad file name")
  130.         goto flab2::
  131.     elseif abs(ec%)=42 
  132.         if eswit%=1 :goto filelab::
  133.         elseif eswit%=2 :goto flab2::
  134.         endif
  135.     endif
  136.     beep 10,50
  137.     cls :print "Error: ",ec%,err$(ec%)
  138.     get
  139.     return        
  140. endp
  141.  
  142. proc finfo:
  143. rem Obtain file size and status info
  144. fzts$=a$+chr$(0)
  145. e%=call($887,addr(fzts$)+1,addr(ver%),0,0,0)
  146. ENDP
  147.  
  148. proc props$:
  149. rem generate string containing file properties
  150. local rep$(128),ampm$(2)
  151. if e%
  152.     rep$="Error obtaining properties"
  153. else
  154.     rep$=""
  155.     rep$=rep$+gen$(size&,-6)+" "
  156.     secstodate mdate&,yr%,mo%,dy%,hr%,mn%,sc%,yrday%
  157.     if hr%>12
  158.         ampm$="pm"
  159.         hr%=hr%-12
  160.     else
  161.         ampm$="am"
  162.     endif
  163.     rep$=rep$+gen$(hr%,-2)+":"+mid$(gen$(100+mn%,-3),2,2)+ampm$+" "
  164.     rep$=rep$+gen$(dy%,-2)+"/"+mid$(gen$(100+mo%,-3),2,2)+"/"+gen$(yr%,4)+" "
  165.     if attrib% and $20 
  166.         rep$=rep$+"Mod "
  167.     else
  168.         rep$=rep$+"    "
  169.     endif
  170.     if attrib% and $4 
  171.         rep$=rep$+"Sys "
  172.     else
  173.         rep$=rep$+"    "
  174.     endif
  175.     if attrib% and $2 
  176.         rep$=rep$+"Hid "
  177.     else
  178.         rep$=rep$+"    "
  179.     endif
  180.     if (Attrib% and $1)=0 
  181.         rep$=rep$+"RdOnly"
  182.     endif
  183. endif
  184. return rep$
  185. endp
  186.  
  187.