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