home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-387-Vol-3of3.iso / e / epmmac2.zip / DOSUTIL.E < prev    next >
Text File  |  1992-12-14  |  17KB  |  444 lines
  1. ;
  2. ; DOSUTIL.E        Low-level functions using int86x(), peek(), poke, dynalink()
  3. ;
  4.  
  5. -- Date and time --------------------------------------------------------------
  6. compile if not small
  7.  
  8. defc qd,qdate=
  9.    parse value getdate() with today';' .  /* Discard MonthNum. */
  10.    sayerror TODAY_IS__MSG today'.'
  11.  
  12.  
  13. defc qt,qtime=
  14.    parse value gettime() with now';' .    /* Discard Hour24. */
  15.    sayerror THE_TIME_IS__MSG now'.'
  16.  
  17.  
  18. COMPILE IF EVERSION >= 4         -- for OS/2
  19. defproc getdatetime
  20.    datetime=substr('',1,20)
  21.  compile if EPM32
  22.    call dynalinkc('DOSCALLS',          -- dynamic link library name
  23.                  '#230',               -- ordinal value for Dos32GetDateTime
  24.                  offset(datetime) ||   -- string offset
  25.                  selector(datetime),2) -- string selector
  26.  compile else
  27.    call dynalink('DOSCALLS',      /* dynamic link library name       */
  28.                  '#33',           /* ordinal value for DOSGETDATETIME*/
  29.                  selector(datetime)|| /* string selector             */
  30.                  offset(datetime))  /* string offset                 */
  31.  compile endif
  32.    return dec_to_string(datetime)
  33.    --> Hour24 Minutes Seconds Hund Day MonthNum Year0 Year1 TZ0 TZ1 WeekdayNum
  34. COMPILE ENDIF
  35.  
  36.  
  37. defproc getdate
  38. compile if E3
  39.       /* Returns:  "Weekday Month DayNum, Year ; MonthNum" */
  40.       /* Sample:   "Friday July 10, 1987;7" */
  41.    parse value int86x(DOS_INT,GET_DATE,'') with WeekdayNum . Year Day .
  42.       /* Note:  The % operator means integer division.  In the DOS version */
  43.       /* of E we could have used /, but this is not true for EOS2.         */
  44.       MonthNum = Day%256
  45.       Day=Day//256
  46. compile else  -- OS/2
  47.       parse value getdatetime() with . . . . Day MonthNum Year0 Year1 . . WeekdayNum .
  48.       Year = Year0 + 256*Year1
  49. compile endif
  50.    Month=strip(substr(MONTH_LIST, MonthNum*MONTH_SIZE-MONTH_SIZE+1, MONTH_SIZE))
  51.    Weekday = strip(substr(WEEKDAY_LIST, (WeekdayNum//256)*WEEKDAY_SIZE+1, WEEKDAY_SIZE))
  52.    return WeekDay Month Day',' Year';'MonthNum
  53.  
  54.  
  55.  
  56. defproc gettime
  57. compile if E3
  58.       /* Returns:  "hh:mm:ss xm;hour24:hund" */
  59.       /* Sample:    "6:34:14 pm;18:023"      */
  60.       PARSE VALUE int86x(DOS_INT,GET_TIME,'') WITH . . RawTime Seconds .
  61.       Hour24 = RawTime%256
  62.       Minutes =RawTime//256
  63.       Hund = Seconds//256
  64.       Seconds = Seconds % 256
  65. compile else
  66.       parse value getdatetime() with Hour24 Minutes Seconds Hund .
  67. compile endif
  68.    AmPm=AM__MSG; Hour=Hour24
  69.    if Hour>=12 then
  70.       Hour=Hour-12; AmPm=PM__MSG
  71.    endif
  72.    if not Hour then Hour=12 endif
  73. compile if EPM
  74.    Hund=rightstr(Hund,2,'0')
  75.    Minutes=rightstr(Minutes,2,'0')
  76.    Seconds=rightstr(Seconds,2,'0')
  77. compile else
  78.    if length(Hund)=1 then Hund='0'Hund endif             /* pad with zero */
  79.    if length(Minutes)=1 then Minutes='0'Minutes endif    /* pad with zero */
  80.    if length(Seconds)=1 then Seconds='0'Seconds endif    /* pad with zero */
  81. compile endif
  82.    return Hour':'Minutes':'Seconds AmPm';'Hour24':'Hund
  83.  
  84. compile endif
  85. -------------------------------------------------------------------------------
  86.  
  87. ;  Ver. 3.10:  Tells if a file exists.  DOS part from Ken Kahn.
  88. ;  Ver. 3.11a:  Use a temporary DTA for the FindFirst call.
  89. DefProc Exist(FileName)
  90. compile if E3
  91.    FileName = FileName\0
  92. ;  get address of old DTA
  93.    Parse Value Int86x(Dos_Int,'12032','') with . OldDTAOfs . ',' . OldDTASeg .
  94.  
  95. ;  set pointer to new DTA
  96.    NewDta = SubStr('',1,80,\0)          -- 80 bytes of x'00'
  97.    call Int86X(Dos_Int,'6656 0 0' Ofs(NewDTA),Seg(NewDTA))
  98. ;
  99.    Parse Value Int86X(Dos_Int,'19968 0 0' Ofs(FileName),Seg(FileName)) with AX . . . . . Cflag ',' .
  100.  
  101. ;  restore old DTA address
  102.    call Int86X(Dos_Int,'6656 0 0' OldDTAOfs,OldDTASeg)
  103. compile else
  104.    cflag=qfilemode(filename, attrib)
  105. compile endif
  106.    Return Cflag=0  -- if Carry flag=0, file exists; return 1.
  107.  
  108. compile if not E3
  109. defproc qfilemode(filename, var attrib)
  110.  compile if EVERSION >= '5.50'
  111.    if leftstr(filename,1)='"' & rightstr(filename,1)='"' then
  112.       filename=substr(filename,2,length(filename)-2)
  113.    endif
  114.  compile endif
  115.    FileName = FileName\0
  116.  compile if EPM32
  117.    attrib=copies(\0, 24)  -- allocate 24 bytes for a FileStatus3 structure
  118.    res = dynalinkc('DOSCALLS',            -- dynamic link library name
  119.                   '#223',                -- ordinal value for Dos32QueryPathInfo
  120.                   offset(filename)   ||  -- Pointer to path name
  121.                   selector(filename) ||  --   "
  122.                   atol(1)            ||  -- PathInfoLevel 1
  123.                   offset(attrib)     ||  -- Pointer to info buffer
  124.                   selector(attrib)   ||  --   "
  125.                   atol(24), 2)           -- Buffer Size
  126.    attrib = ltoa(rightstr(attrib,4),10)
  127.  compile else
  128.    attrib='  '
  129.    res = dynalink('DOSCALLS',            -- dynamic link library name
  130.                   '#75',                 -- ordinal value for DOSQFILEMODE
  131.                   selector(filename) ||  -- string selector
  132.                   offset(filename)   ||  -- string offset
  133.                   selector(attrib)   ||  -- string selector
  134.                   offset(attrib)     ||  -- string offset
  135.                   atol(0))               -- reserved
  136.    attrib = itoa(attrib,10)
  137.  compile endif
  138.    return res
  139. compile endif
  140.  
  141. ; Ver. 3.10:  New routine by Ken Kahn.
  142. ; Ver. 3.11:  Support added for /E option of append.  This will also now work
  143. ;    for any user of DOS 3.0 or above that uses the DOS command SET APPEND,
  144. ;    whether or not they actually have the APPEND command installed.
  145. compile if USE_APPEND
  146. defproc Append_Path(FileName)
  147. /**********************************************************************
  148.  *                                                                    *
  149.  *     Name : Append_Path                                             *
  150.  *                                                                    *
  151.  * Function : For files accessed via the DOS 3.3 APPEND facility      *
  152.  *            this routine will search the APPEND search string and   *
  153.  *            return the path name the file is found on.              *
  154.  *                                                                    *
  155.  *    Input : FileName = File name to search for                      *
  156.  *                                                                    *
  157.  *   Output : - If the APPEND facility is not installed and the       *
  158.  *              filename cannot be found on any of the paths in the   *
  159.  *              APPEND string a null value will be returned.          *
  160.  *                                                                    *
  161.  *            - Otherwise the path name (path\) will be returned.     *
  162.  *                                                                    *
  163.  **********************************************************************/
  164.  compile if E3
  165.       AppendPath = Get_Env('APPEND',1)       -- If OS/2 real or DOS, then use APPEND
  166.       If not(AppendPath) and (Dos_Version() >= 330) then  -- & check for resident APPEND
  167.          parse value Int86X(47,'46848','') with AX . -- Only interested in AL:
  168.          If AX<0 then
  169.             AX = AX + MAXINT + 1                     -- Drop high order bit
  170.          EndIf
  171.          AX = AX - 256 * (AX % 256)                  -- Drop rest of high order byte
  172.          If AX = 255 then                            -- Append is installed.
  173.             parse value Int86X(47,'46852','') with . . . . . DI . ',' . ES .
  174. ;;          AppendPath = peek(ES,DI,pos(\0,peek(ES,DI,128))-1)
  175.             AppendPath = ES DI
  176.          Endif
  177.       EndIf
  178.    return search_path_ptr(AppendPath, FileName)
  179.  compile else
  180.    return search_path_ptr(Get_Env('DPATH',1), FileName)  -- If OS/2 protect mode, then use DPATH
  181.  compile endif
  182. compile endif  -- USE_APPEND
  183.  
  184. compile if USE_APPEND | WANT_SEARCH_PATH
  185. ; Ver. 3.12 - split off from Append_Path so can be called by other routines.
  186. defproc search_path(AppendPath, FileName)
  187.    do while AppendPath<>''
  188.       parse value AppendPath with TryDir ';' AppendPath
  189.       if check_path_piece(trydir, filename) then
  190.          return trydir
  191.       endif
  192.    enddo
  193. ;  return ''
  194.  
  195. defproc search_path_ptr(AppendPathPtr, FileName)
  196.    parse value AppendPathPtr with env_seg env_ofs .
  197.    if env_ofs = '' then return; endif
  198.    trydir = ''
  199.    do forever
  200.       ch = peek(env_seg,env_ofs,1)
  201.       env_ofs = env_ofs + 1
  202.       if ch=';' | ch = \0 then
  203.          if check_path_piece(trydir, filename) then
  204.             return trydir
  205.          endif
  206.          if ch = \0 then return; endif
  207.          trydir = ''
  208.       else
  209.          trydir = trydir || ch
  210.       endif
  211.    enddo
  212.  
  213. defproc check_path_piece(var trydir, filename)
  214.    if trydir='' then return; endif
  215. compile if EVERSION >= '5.17'
  216.    lastch=rightstr(TryDir,1)
  217. compile else
  218.    lastch=substr(TryDir,length(TryDir),1)
  219. compile endif
  220.    if lastch<>'\' & lastch<>':' then
  221.       TryDir = TryDir||'\'
  222.    endif
  223.    if exist(TryDir||FileName) then
  224.       return TryDir
  225.    endif
  226. compile endif  -- USE_APPEND
  227.  
  228. compile if USE_APPEND | WANT_GET_ENV
  229. defproc get_env(varname)=  -- Optional arg(2) is flag to return pointer to value instead of the value itself.
  230.  compile if E3
  231.    varname = upcase(varname)
  232.    env_ofs = 0
  233.       if dos_version() < 300 then
  234.          sayerror 'DOS version 3.0 or above required for Get_Env Address.'
  235.          return ''
  236.       endif
  237.       parse value int86x(33,25088,'') with . PSP_seg .  -- Int 21H, AH=62H
  238.       env_seg = asc(peek(PSP_seg,45,1)) * 256 + asc(peek(PSP_seg,44,1))
  239.    do while peek(env_seg,env_ofs,1) /== \0  -- (backslash) 0 == ASCII null
  240.       start = env_ofs
  241.       do while peek(env_seg,env_ofs,1) /== \0
  242.          env_ofs = env_ofs + 1
  243.       end
  244.       setting = peek(env_seg,start,env_ofs-start)
  245.       parse value setting with name '=' parameter
  246.       if name==varname then
  247.          if arg(2) then
  248.             return env_seg (start+length(name)+1)  -- (Segment) (offset)
  249.          else
  250.             return parameter
  251.          endif
  252.       endif
  253.       env_ofs=env_ofs+1
  254.    end
  255.  compile else
  256.    varname = upcase(varname)\0
  257.    result_ptr = 1234                -- 4-byte place to put a far pointer
  258.   compile if EPM32
  259.    rc = dynalinkc('DOSCALLS',        -- rc 0 (false) if found
  260.                  '#227',             -- Ordinal for DOS32ScanEnv
  261.                  offset(varname)      ||
  262.                  selector(varname)    ||
  263.                  offset(result_ptr)   || -- string offset
  264.                  selector(result_ptr),2) -- string selector
  265.   compile else
  266.    rc = dynalink('DOSCALL1',        -- rc 0 (false) if found
  267.                  'DOSSCANENV',
  268.                  selector(varname)    ||
  269.                  offset(varname)      ||
  270.                  selector(result_ptr) || -- string selector
  271.                  offset(result_ptr))     -- string offset
  272.   compile endif
  273.    if not rc then
  274.   compile if EPM
  275.       if arg(2) then
  276.          return itoa(rightstr(result_ptr,2),10) itoa(leftstr(result_ptr,2),10)
  277.       endif
  278.       return peekz(result_ptr)
  279.   compile else
  280.       env_seg=itoa(substr(result_ptr,3,2),10)
  281.       env_ofs = itoa(substr(result_ptr,1,2),10)
  282.       if arg(2) then
  283.          return env_seg env_ofs
  284.       endif
  285.       start = env_ofs
  286.       do while peek(env_seg,env_ofs,1) /== \0
  287.          env_ofs = env_ofs + 1
  288.       end
  289.       return peek(env_seg,start,env_ofs-start)
  290.   compile endif
  291.    endif
  292.  compile endif
  293. compile endif  -- USE_APPEND
  294.  
  295. /***
  296. defc testap=                     /* for testing:  testap <filename> */
  297.    res = append_path(arg(1))
  298.    if res then sayerror res else sayerror 'none' endif
  299. ***/
  300.  
  301. -------------------------------------------------------------------------------
  302. compile if not small
  303.  
  304. /* Useful if you want the cursor keys to act differently with ScrollLock on. */
  305. defproc scroll_lock
  306. compile if EPM
  307.    /* fix this later -- odd means toggled */
  308.    ks = getkeystate(VK_SCRLLOCK)
  309.    return (ks==KS_DOWNTOGGLE or ks==KS_UPTOGGLE)   -- any toggled
  310. compile else
  311. compile if E3
  312.    kbflags = asc(peek(64,23,1))  -- 0040:0017 = keyboard flags byte
  313. compile else
  314.    getshiftstate kbflags         -- New statement in 4.10.  No PCDOS.
  315. compile endif
  316.    return kbflags%16 - 2*(kbflags%32)  -- Scroll-lock is the 16 bit
  317. compile endif                          -- (bit-test operators would help)
  318.  
  319. /*** Test command.
  320. defc sltest
  321.    sayerror 'scroll_lock='scroll_lock()'.'
  322. ***/
  323.  
  324. /*
  325. The bits in the KB_flag are (from the BIOS listing):
  326.  
  327. INS_STATE      EQU   80H  = 128  ; Insert state is active
  328. CAPS_STATE     EQU   40H  =  64  ; Caps lock state has been toggled
  329. NUM_STATE      EQU   20H  =  32  ; Num lock state has been toggled
  330. SCROLL_STATE   EQU   10H  =  16  ; Scroll lock state has been toggled
  331. ALT_SHIFT      EQU   08H  =   8  ; Alternate shift key depressed
  332. CTL_SHIFT      EQU   04H  =   4  ; Control shift key depressed
  333. LEFT_SHIFT     EQU   02H  =   2  ; Left shift key depressed
  334. RIGHT_SHIFT    EQU   01H  =   1  ; Right shift key depressed
  335. */
  336. /*** Sample usage:
  337.   def up=
  338.      if scroll_lock() then      /* don't forget the parentheses */
  339.         executekey s_f3         /* if scroll lock on, act like scroll down */
  340.      else
  341.         up
  342.      endif
  343. ***/
  344.  
  345. -------------------------------------------------------------------------------
  346.  
  347. defproc beep   -- Version 4.02
  348. -- Two optional arguments:  pitch, duration.
  349. -- We make them optional by not declaring them in the DEFPROC, then retrieving
  350. -- them with the arg() function.  We do this because DOS has no use for the
  351. -- arguments.  (The alternative would be to declare them --
  352. -- defproc beep(pitch, duration) -- and ignore them on DOS, but that would use
  353. -- more p-code space.)
  354. --
  355. -- If the arguments are omitted on OS/2 we pick DOS-like values.
  356. compile if E3  -- If on DOS or real mode, standard beep.
  357.    return int86x(33,2*256 0 0 7,'')    /* Write BEL (x'07') to TTY */
  358. compile else
  359.       if arg()=2 then
  360.          pitch   = arg(1)
  361.          duration= arg(2)
  362.       endif
  363.       if not isnum(pitch) or not isnum(duration) or pitch=0 or duration=0 then
  364.          pitch   = 900  -- 900 Hz for 500 milliseconds sounds like a DOS beep.
  365.          duration= 500
  366.       endif
  367.  compile if EPM32
  368.       call dynalinkc('DOSCALLS',       -- dynamic link library name
  369.                     '#286',            -- ordinal value for Dos32Beep
  370.                     atol(pitch) ||     -- Hertz (25H-7FFFH)
  371.                     atol(duration),2)  -- Length of sound  in ms
  372.  compile else
  373.       call dynalink('DOSCALLS',      /* dynamic link library name  */
  374.                     '#50',           /* ordinal value for DOSBEEP  */
  375.                     atoi(pitch)||    /* Hertz (25H-7FFFH)          */
  376.                     atoi(duration))  /* Length of sound  in ms     */
  377.  compile endif
  378.       return
  379. compile endif
  380.  
  381. /*** demo command:
  382. defc testbeep=
  383.    parse value arg(1) with pitch duration
  384.    call beep(pitch,duration)
  385. ***/
  386.  
  387. -- New for EPM ----------------------------------------------------------------
  388. ;  jbl 12/30/88:  Provide DIR and other DOS-style query commands by redirecting
  389. ;  output to a file.
  390. defc dir   =
  391. compile if RING_OPTIONAL
  392.    universal ring_enabled
  393.    if not ring_enabled then
  394.       'ring_toggle'
  395.    endif
  396. compile endif
  397.    parse arg fspec
  398.    call parse_filename(fspec,.filename)
  399.    dos_command('dir' fspec)
  400.    sayerror ALT_1_LOAD__MSG
  401.  compile if EVERSION >= '5.50'
  402. ;  .font = registerfont('System Monospaced', 12, 0)
  403.    'postme monofont'  -- Must happen after DEFLOAD.
  404.  compile endif
  405.  
  406. defc set   = dos_command('set')
  407. defc vol   = dos_command('vol' arg(1))
  408. defc path  = dos_command('path')
  409. defc dpath = dos_command('dpath')
  410.  
  411. compile if EVERSION > 4
  412. defc os2
  413.  compile if EPM  -- Create a OS/2 windowed cmd prompt & execute a command in it.
  414.     command=arg(1)
  415.     if command='' then    -- prompt user for command
  416.        command=entrybox(ENTER_CMD__MSG)
  417.        if command='' then return; endif
  418.     endif
  419.     'cmd /c start /win 'command
  420.  compile else
  421.    'DOS' arg(1)
  422.  compile endif
  423. compile endif
  424.  
  425. defproc dos_command=
  426. universal vTEMP_FILENAME
  427. compile if RING_OPTIONAL
  428.    universal ring_enabled
  429.    if not ring_enabled then
  430.       'ring_toggle'
  431.    endif
  432. compile endif
  433. compile if E3
  434.       'dos' arg(1) '>'vTEMP_FILENAME  -- DOS (box) can't redirect STDERR
  435. compile else
  436.       quietshell 'dos' arg(1) '>'vTEMP_FILENAME '2>&1'
  437. compile endif
  438.  
  439.    'e' argsep'D' argsep'Q' vTEMP_FILENAME
  440.    if not rc then .filename = '.DOS' arg(1); endif
  441.    call erasetemp(vTEMP_FILENAME)
  442.  
  443. compile endif          -- Not SMALL
  444.