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