home *** CD-ROM | disk | FTP | other *** search
/ The Datafile PD-CD 3 / PDCD_3.iso / pocketbk / developmen / oplexamp / CPRESS.OPL < prev    next >
Text File  |  1992-07-31  |  6KB  |  243 lines
  1. Rem     Compress module
  2. Rem     (c)Pelican software Inc.
  3. Rem     P.o Box 741072
  4. Rem     Houston, Tx. 77274-1072
  5. Rem     (713) 773-2803
  6.  
  7. Rem     This is the newest part of the Pelican Software Inc. Library
  8. REm     If you find you can use it, send $15 to Pelican Software Inc.
  9.  
  10. Rem     To run inside another app.  certain changes need to be made to this
  11. Rem     procedure. Comments are in the code. The first dinit-dialog can be
  12. rem     removed, since you will already have a filename. You must pass the
  13. rem     global with the filename into this proc. and then (filz$=yourglobal$)
  14. Rem     If you have the file open that you want to compress, you will need to
  15. Rem     close it. Just remove Rem's. It's already in the code.
  16. Rem     Run on data files only - not opl text or word or any other non data.
  17.  
  18. app Cpress
  19. icon "M:\OPD\cpress.pic"
  20. enda
  21.  
  22. proc cpress:
  23. global Media$(16),vol$(12),tot$(12),free$(12),device$(7)
  24. local d$(3,2),v&,n&,high%,l%,ext$(4)
  25. local p%,t,d%,space&,old&
  26. local filz$(130)
  27. local ver%,at%,size&,md&,sp&   Rem --- dont change this order
  28. setpath "M:\dat\"              Rem --- Set to your own
  29. Rem     filz$+fil$  (if calling from within another proc.)
  30. beep 5,50
  31. giprint chr$(184)+"1992 Pelican Software Inc."
  32. top::
  33. Rem   --------  Remove this code to call from within another procedure
  34. dinit"Open a File to Compress"
  35. dtext"","Data files only!",$102
  36. dfile filz$,"Open",0
  37. if dialog
  38.  ext$=parse$:(filz$,5)
  39.  if loc(".odb.dbf.dat",ext$)=0
  40.   giprint"Data files only..."
  41.   goto top::
  42.  endif
  43. busy"Checking Ram Drives..."
  44. filz$=filz$+chr$(0)
  45. call($887,addr(filz$)+1,addr(ver%),0,0,0)
  46. Rem -------  Call for file attrib
  47. device$=parse$:(filz$,2)
  48. media:
  49. if media$="FLASH"
  50.  busy off
  51.  dinit
  52.  dtext"","Compressing cant be done on Flash",$302
  53.  dtext"","There would be no benefit. To reclaim"
  54.  dtext"","space on a Flash, copy all files to"
  55.  dtext"","a Ram drive and Format the Flash SSD,"
  56.  dtext"","then compress the files on the Ram drive"
  57.  dtext"","and copy the files back to the Flash SSD."
  58.  dialog
  59.  return
  60. elseif left$(media$,5)="WRITE"
  61.  busy off
  62.  dinit
  63.  dtext"","Compress Failed!",$302
  64.  dtext"",media$+" Media"
  65.  dbuttons "Continue",27
  66.  dialog
  67.  return
  68. endif
  69. d$(1)="M:" :d$(2)="A:" :d$(3)="B:"
  70. l%=1
  71. high%=1
  72. n&=0
  73. do   Rem --- Get Ram Drive w/most mem
  74.  device$=d$(l%)
  75.  media:
  76.  giprint media$+" on "+d$(l%)   Rem ---- take this out if you don't want to display it.
  77.  pause 10
  78.  v&=val(free$)
  79.  if v&>n& and media$="RAM"
  80.   high%=l%
  81.   n&=v&
  82.  endif
  83.  l%=l%+1
  84. until l%>3
  85. Rem ---- d$(high%) has most memory
  86. device$=d$(high%)
  87. media:
  88. space&=val(free$)       Rem  ---- free space on drive
  89. busy off
  90. dinit"Compress File?"
  91. dbuttons "Yes",%Y,"No",%N
  92. d%=dialog
  93. if d%=%y or d%=%Y
  94.  if size&>space&-100    Rem    ---- size of file>space free
  95.   dinit"Compress Cancelled"
  96.   dtext"","Not enough space!",2
  97.   dtext""," "
  98.   dbuttons "Continue",27
  99.   dialog
  100.   return
  101.  endif
  102.  busy "Compressing..."
  103. rem use b     Rem  ----  Log of open file
  104. rem trap close
  105. n&=0
  106.  do    Rem ---- get unique filename
  107.   if exist(d$(high%)+"\cprss"+fix$(n&,0,3)+".odb")
  108.    n&=n&+1
  109.   else break
  110.   endif
  111.  until 0
  112.  trap compress filz$,d$(high%)+"\cprss"+fix$(n&,0,3)+".odb"
  113.  if err
  114.   giprint err$(err)
  115.   pause 30
  116.   busy off
  117.   return
  118.  endif
  119.  trap delete filz$ Rem ---- dump original
  120.  if parse$:(filz$,2)<>d$(high%)
  121.   trap copy d$(high%)+"\cprss"+fix$(n&,0,3)+".odb",filz$   Rem ---- copy to yourglobal$, not filz$ if
  122.  Rem   ---- if not same drive,copy                         Rem ---- you are calling from other proc.
  123.   if err
  124.    giprint err$(err)
  125.    goto done::
  126.   Rem    --------    Delete file if copy was successful
  127.   else trap delete d$(high%)+"\cprss"+fix$(n&,0,3)+".odb"
  128.   endif
  129. else
  130. rename d$(high%)+"\cprss"+fix$(n&,0,3)+".odb",filz$
  131. Rem ----else just rename the new file
  132. if err
  133.  giprint ERR$(err)
  134.  pause 30
  135. endif
  136. endif
  137. done::
  138. giprint"Done"
  139. beep 5,50
  140. old&=size&
  141. call($887,addr(filz$)+1,addr(ver%),0,0,0)
  142. busy off
  143. dinit"File "+parse$:(filz$,6)+" Compressed!"
  144. dtext"Before:",fix$(old&,0,8)+" bytes"
  145. dtext"After:",fix$(size&,0,8)+" bytes"
  146. if dialog
  147.  busy off
  148.  goto top::
  149.  endif
  150. endif
  151. endif
  152. Endp
  153.  
  154. proc Media:
  155. LOCAL t$(7,16),f%
  156. local add%(9),addr$(32)
  157. t$(1)="UNKNOWN" :T$(2)="FLOPPY"
  158. T$(3)="HARD DISK" :T$(4)="FLASH"
  159. T$(5)="RAM" :T$(6)="ROM" :T$(7)="WRITE-PROTECTED"
  160. f%=devinfo%:(device$,addr(add%(1)),addr(addr$))
  161. if f%<0
  162.  Media$="None" :Vol$="None" :tot$="0" :free$="0"
  163.  return
  164. endif
  165. Media$=T$(fldtype%:(device$)+1)
  166. Vol$= addr$
  167. if device$<>"M:"
  168.  Tot$= fix$(peekl(addr(add%(1))+6),0,8)
  169. else tot$="262144"     REm   ----- couldn't get M to report accurate totol mem
  170. endif                  Rem   ----- will need to be changed if Psion comes out with an S3 with more mem.
  171. Free$=fix$(peekl(addr(add%(1))+10),0,8)
  172. return
  173. endp
  174.  
  175.  
  176. PROC devinfo%:(device$,pinfo%,pvol%)
  177.         local exec%(10)
  178.         local code%
  179.     local rtn%
  180.     local buffer$(64)
  181.     local pbuffer% 
  182.     local dev$(129)
  183.     local pdev%
  184.         local i%
  185.     code%=addr(exec%(1))
  186.     pokew code%,$0Ab4
  187.     pokew code%+2,$87cd
  188.     pokew code%+4,$0272
  189.     pokew code%+6,$c033
  190.     pokeb code%+8,$cb
  191.     pbuffer% = addr(buffer$)
  192.     dev$ = device$+chr$(0)
  193.     pdev% = addr(dev$)+1
  194.     rtn% = usr(code%,0,pdev%,pbuffer%,0)
  195.     if rtn% >= 0
  196.         pokew pinfo%,peekw(pbuffer%)
  197.         pokew pinfo%+2,peekw(pbuffer%+2)
  198.         pokew pinfo%+4,peekw(pbuffer%+4)
  199.         pokel pinfo%+6,peekl(pbuffer%+6)
  200.         pokel pinfo%+10,peekl(pbuffer%+10)
  201.         pokew pinfo%+14,peekw(pbuffer%+46)
  202.         i%=0
  203.         while peekb(pbuffer%+14+i%)<>0 and i%<=32
  204.             pokeb pvol%+1+i%,peekb(pbuffer%+14+i%)
  205.             i%=i%+1
  206.         endwh
  207.         pokeb pvol%,i%
  208.     endif
  209.     return rtn%
  210. ENDP
  211.  
  212. PROC fldtype%:(device$)
  213.     local rtn%
  214.     local info%(8)
  215.     local vdummy$(32)
  216.     rtn%=DEVINFO%:(device$,addr(info%(1)),addr(vdummy$))
  217.     if rtn% >= 0
  218.         rtn%=info%(2) and $ff
  219.     endif
  220.     return rtn%
  221. ENDP
  222.  
  223.  
  224. Rem  ------   Pelican Software Inc. Library
  225.  
  226. PROC parse$:(filz$,req%)
  227. local b%(6),p$(128),rel$(8),fsys$(8),dev$(2),path$(128),fn$(12),ext$(4)
  228. p$=parse$(filz$,rel$,b%())
  229. fsys$=mid$(p$,1,b%(2)-1)
  230. dev$=mid$(p$,b%(2),b%(3)-b%(2))
  231. path$=mid$(p$,b%(3),b%(4)-b%(3))
  232. fn$=mid$(p$,b%(4),b%(5)-b%(4))
  233. ext$=mid$(p$,b%(5),4)
  234. if req%=1 :Return fsys$
  235. elseif req%=2 :return dev$
  236. elseif req%=3 :return path$
  237. elseif req%=4 :return fn$
  238. elseif req%=5 :return ext$
  239. elseif req%=6 :return fn$+ext$
  240. rem Add your own combinations here
  241. endif
  242. ENDP
  243.