Programmer 7500/MAX_PROGRAMMERS.iso/PROGRAMS/UTILS/DOS_HELP/DOS_FUNC.ZIP/DOS_FUNC.PF0

Text File | 1990-04-18 | 12.3 KB | 528 lines

public _filestat(),_attrib(),_getfree(),_prtscn(),_prtstat()
public _setdate(),_settime(),_setfdate()

function _filestat(f_name,type)
'============================================================================
'Written by Dave Skalick
'----------------------------------------------------------------------------
' This function will return information on a file based on the file name
' and a request code.  This is accomplished by service calls to int x21h.
'
' f_name -- file name to return information on
'   type -- request code
' type codes:
'        1 -- time
'        2 -- date
'        3 -- size
'        4 -- attributes
'        5 -- name
'============================================================================
local ax_reg,dx_reg,es_reg
local old_es,old_bx
local f_mem,dta_mem
local seg,offset
local _a,_t,_d,_s,_at,_f

'--- setup and pack file name in memory location ---
memalloc f_mem sizeof "35s"
mempack f_mem "35s" f_name

'--- setup new memory location for dta ---
memalloc dta_mem size 128

'--- call for current dta location ---
setreg(ax,0x2F00)
interrupt 0x21

'--- store current dta location ---
old_es=getreg(es)
old_bx=getreg(bx)

'--- determine current segment and offset of dta memory location ---
seg=dta_mem/65536
offset=mod(dta_mem,65536)

'--- set segement and offset in registers for new dta ---
setreg(ds,seg)
setreg(dx,offset)

'--- set service number for new dta location and call interupt 21 ---
setreg(ax,0x1A00)
interrupt 0x21

'--- determine current segment and offset of filename memory location ---
seg=f_mem/65536
offset=mod(f_mem,65536)

'--- set segement and offset in registers for filename ---
setreg(ds,seg)
setreg(dx,offset)

'--- set cx for matching all attributes ---
setreg(cx,0x00FF)

'--- set service number to find file and store information in dta location ---
setreg(ax,0x4E00)
interrupt 0x21

'--- get the result code from 4E call ---
ax_reg=getreg(ax)

'--- set segement and offset in registers of orriginal dta ---
setreg(ds,old_es)
setreg(dx,old_bx)

'--- set service number for orriginal dta location and call interupt 21 ---
setreg(ax,0x1A00)
interrupt 0x21

'--- free filename memory ---
memfree f_mem

'--- if error then exit with error message ---
if bitand(ax_reg,255)<>0
   errormessage 7 "File not found"
   return(0)
end if

'--- unpack dta for attribute, time, date, & size then clear memory---
memunpack dta_mem "21xbwwl13s" _a _t _d _s _f
memfree dta_mem

'--- return information based on user request ---
case type

   '--- time ---
when 1
   return(right("00"|str(int(_t/2048)),2)|":"|right("00"|str(bitand(_t,2016)/32),2)|":00")

   '--- date ---
when 2
   return(right("00"|str(bitand(_d,480)/32),2)|"/"|right("00"|str(bitand(_d,31)),2)|"/"|right("0000"|str(int(_d/512)+1980),4))

   '--- file size ---
when 3
   return(_s)

   '--- attribute ---
when 4

   '--- archive ---
   if bitand(_a,32)=32
      _at=_at|"A"
   end if

   '--- directory ---
   if bitand(_a,16)=16
      _at=_at|"D"
   end if

   '--- volume ---
   if bitand(_a,8)=8
      _at=_at|"V"
   end if

   '--- system ---
   if bitand(_a,4)=4
      _at=_at|"S"
   end if

   '--- hidden ---
   if bitand(_a,2)=2
      _at=_at|"H"
   end if

   '--- read-only ---
   if bitand(_a,1)=1
      _at=_at|"R"
   end if

   return(_at)

   '--- file name and extention ---
when 5
   return(_f)

end case
end function

function _attrib(f_name,r_w,new_att)
'============================================================================
'Written by Dave Skalick
'----------------------------------------------------------------------------
'This function will read or set the attributes for any file.
'
'    f_name -- is the file to read/set the attributes on
'       r_w -- 0 to read the attribute and 1 to set the attribute
'   new_att -- New attributes to set the file to (only works if r_w is 1)
'============================================================================
local ax_reg,cx_reg,f_mem,ret_val,seg,offset,flags_reg

cx_reg=0
if lower(new_att)!"a"
   cx_reg=cx_reg+32
end if
if lower(new_att)!"d"
   cx_reg=cx_reg+16
end if
if lower(new_att)!"v"
   cx_reg=cx_reg+8
end if
if lower(new_att)!"s"
   cx_reg=cx_reg+4
end if
if lower(new_att)!"h"
   cx_reg=cx_reg+2
end if
if lower(new_att)!"r"
   cx_reg=cx_reg+1
end if

'--- setup and pack file name in memory location ---
memalloc f_mem sizeof "35s"
mempack f_mem "35s" f_name

'--- determine current segment and offset of filename memory location ---
seg=f_mem/65536
offset=mod(f_mem,65536)

'--- set segement and offset in registers for filename ---
setreg(ds,seg)
setreg(dx,offset)

'--- free filename memory ---
memfree f_mem

'--- set ah with service number (hex:0x43 -- dec:17152) ---
ax_reg=17152

'--- r_w=0 then read attributes -- r_w=1 then set cx reg with new attr ---
if r_w=1
   ax_reg=ax_reg+1
   setreg(cx,cx_reg)
end if

'--- set ax register for attribute and call interrupt 21 ---
setreg(ax,ax_reg)
interrupt 0x21

'--- check for error ---
flags_reg=getreg(flags)
if bitand(flags_reg,1)=1
   return(0)
end if

if r_w=1
   '--- if no error on write then return true ---
   return(1)
else
   '--- if request for attribute then get current attribute setting ---
   cx_reg=getreg(cx)

   ret_val=""

   '--- archive ---
   if bitand(cx_reg,32)=32
      ret_val=ret_val|"A"
   end if

   '--- directory ---
   if bitand(cx_reg,16)=16
      ret_val=ret_val|"D"
   end if

   '--- volume ---
   if bitand(cx_reg,8)=8
      ret_val=ret_val|"V"
   end if

   '--- system ---
   if bitand(cx_reg,4)=4
      ret_val=ret_val|"S"
   end if

   '--- hidden ---
   if bitand(cx_reg,2)=2
      ret_val=ret_val|"H"
   end if

   '--- read-only ---
   if bitand(cx_reg,1)=1
      ret_val=ret_val|"R"
   end if

   return(ret_val)

end if
end function

function _getfree(dr)
'=======================================================================
' Will determine the disk space left on the driver letter specified
'
' dr -- drive letter
'-----------------------------------------------------------------------
local _ax,_bx,_cx,drive
if len(dr)=1 and (asc(upper(dr))>=65 and asc(upper(dr))<=90)
   drive=asc(upper(dr))-64
else
   return(-1)
end if
setreg(dx,drive)
setreg(ax,0x3600)
interrupt 0x21
_ax=getreg(ax)
_bx=getreg(bx)
_cx=getreg(cx)
if _ax=735
   return(-1)
else
   return(_ax*_bx*_cx)
end if
end function

function _prtscn()
'=======================================================================
'performs a print screen via the bios interrupt 5
'-----------------------------------------------------------------------
interrupt 5
end function

function _prtstat(port)
'=======================================================================
'Will return a 1 if printer is ready or 0 if not
'
'port -- parallel port number to check
'-----------------------------------------------------------------------
local ax_reg
if port<1 or port>2
   return(0)
end if

setreg(ax,0x0200)
setreg(dx,port-1)
interrupt 0x17

ax_reg=getreg(ax)
if bitand(ax_reg,32768)=32768 and bitand(ax_reg,4096)=4096
   return(1)
end if
if bitand(ax_reg,2048)=2048 or bitand(ax_reg,512)=512
   return(0)
end if
end function

function _setdate(set_date)
'=======================================================================
'Will return 1 if current system date is set and 0 if it is not.
'
'set_date -- new system date
'-----------------------------------------------------------------------
local ax_reg,cx_reg,dx_reg,flags_reg
local m,d,y

if not(isdate(set_date))
   errormessage 7 "invalid date type"
   return(0)
end if
m=month(set_date)
d=day(set_date)
y=year(set_date)

if y<1980 or y>2099
   errormessage 7 "Invalid year.  Must be between 1980 and 2099."
   return(0)
end if

'--- set cx reg with new year ---
cx_reg=y
setreg(cx,cx_reg)

'--- setup dx reg with month and day ---
dx_reg=256*m
dx_reg=dx_reg+d
setreg(dx,dx_reg)

'--- setup service call in ax reg ---
ax_reg=0x2B00
setreg(ax,ax_reg)
interrupt 0x21

'--- get return from ax reg ---
ax_reg=getreg(ax)

'--- check if error occured ---
if bitand(ax_reg,255)<>0
   return(0)
else
   return(1)
end if
end function


function _settime(t)
'=======================================================================
'Will return 1 if current system time is set and 0 if it is not.
'
' t -- new system time
'-----------------------------------------------------------------------
local ax_reg,cx_reg,dx_reg,h,m,s
case
   when (t!!":") or (len(t)<8)
      errormessage 7 "Invalid time type"
      return(0)
   when (val(mid(t,1,2))>24) or (val(mid(t,4,2))>59) or (val(mid(t,7,2))>59)
      errormessage 7 "Invalid time type"
      return(0)
   when (mid(t,3,1)<>":") or (mid(t,6,1)<>":")
      errormessage 7 "Invalid time type"
      return(0)
   when (val(mid(t,1,2))=24) and ((val(mid(t,4,2))>0) or (val(mid(t,7,2))>0))
      errormessage 7 "Invalid time type"
      return(0)
end case
t=timevalue(t)
h=hour(t)
m=minute(t)
s=second(t)

'--- set hours and minutes in cx ---
cx_reg=256*h
cx_reg=cx_reg+m
setreg(cx,cx_reg)

'--- set seconds in dx --
dx_reg=256*s
setreg(dx,dx_reg)

'--- set ax with service call 0x2D and call interrupt ---
setreg(ax,0x2D00)
interrupt 0x21

'--- check for error ---
ax_reg=getreg(ax)
if bitand(ax_reg,255)<>0
   return(0)
else
   return(1)
end if
end function

function _setfdate(_fname,_newdate,_newtime)
'=======================================================================
'Will return 1 if file date and time is set and 0 if it is not.
'
'   _fname -- file name to change date & time on
' _newdate -- new file date ("" means no change made)
' _newtime -- new file time ("" means no change made)
'-----------------------------------------------------------------------
local _floc,_segment,_offset,_flags,_ax,_handle
local _olddate,_oldtime,_cx,_dx
local _hr,_mn,_sc,_m,_d,_y
if (len(_newdate)=0 and len(_newtime)=0) or not(isdate(_newdate))
   errormessage 7 "invalid date and time"
   return(0)
end if
if len(_newdate)<>0
   _m=month(_newdate)
   _d=day(_newdate)
   _y=year(_newdate)
end if
if len(_newtime)<>0
   case
      when (_newtime!!":") or (len(_newtime)<8)
         errormessage 7 "invalid time"
         return(0)
      when (val(mid(_newtime,1,2))>24) or (val(mid(_newtime,4,2))>59) or (val(mid(_newtime,7,2))>59)
         errormessage 7 "invalid time"
         return(0)
      when (mid(_newtime,3,1)<>":") or (mid(_newtime,6,1)<>":")
         errormessage 7 "invalid time"
         return(0)
      when (val(mid(_newtime,1,2))=24) and ((val(mid(_newtime,4,2))>0) or (val(mid(_newtime,7,2))>0))
         errormessage 7 "invalid time"
         return(0)
   end case
   _hr=hour(timevalue(_newtime))
   _mn=minute(timevalue(_newtime))
   _sc=second(timevalue(_newtime))
end if

'--- allocate memory for file name and store name ---
memalloc _floc size 32
mempack _floc "32s" _fname

'--- setup segment and offset of file name ---
_segment=_floc/65536
_offset=mod(_floc,65536)

'--- setup ds:dx with file name pointer ---
setreg(ds,_segment)
setreg(dx,_offset)

'--- send service number and request and call interrupt ---
setreg(ax,0x3D00)
interrupt 0x21

'--- check for error ---
_flags=getreg(flags)
if bitand(_flags,1)=1
   errormessage 7 "error opening file"
   return(_flags)
end if

'--- get file handle ---
_handle=getreg(ax)

'--- request file date and time ---
setreg(bx,_handle)
setreg(ax,0x5700)
interrupt 0x21

'--- get current file date and time ---
_olddate=getreg(dx)
_oldtime=getreg(cx)

'--- determine date and time stamp ---
if len(_newdate)=0
   _dx=_olddate
else
   _dx=(512*(_y-1980))+(32*_m)+(_d)
end if

if len(_newtime)=0
   _cx=_oldtime
else
   _cx=(2048*_hr)+(32*_mn)+int(_sc/2)
end if

'--- set registers and call interrupt ---
setreg(dx,_dx)
setreg(cx,_cx)
setreg(bx,_handle)
setreg(ax,0x5701)
interrupt 0x21

'--- check for error ---
_flags=getreg(flags)
if bitand(_flags,1)=1
   errormessage 7 "error setting date and time"
   return(_flags)
end if

'--- close file ---
setreg(bx,_handle)
setreg(ax,0x3E00)
interrupt 0x21

'--- check for error ---
_flags=getreg(flags)
if bitand(_flags,1)=1
   errormessage 7 "error closing file"
   return(_flags)
end if

return(1)
end function