home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / TPMSDOS.ZIP / TPMSDOS.LIB
Encoding:
Text File  |  1985-12-28  |  6.9 KB  |  251 lines
  1. {=============================================================================}
  2.  
  3. {          Get DOS Version Number - 30H
  4.  
  5. Entry     Register Contents
  6. -----     -----------------
  7. AH        30H
  8.  
  9. Return    Register Contents
  10. ------    -----------------
  11. AL        Major DOS version no.
  12. AH        Minor DOS version no.
  13. Remarks:  If AL returns a zero,
  14.           the version of DOS is
  15.           pre-DOS 2.0.
  16. {----------------------------------------------------------------------------}
  17.  
  18. program get_dos_version;
  19. type
  20.    regpack = record
  21.       AX,BX,CX,DX,BP,SI,DI,DS,ES,flags:integer;
  22.       end;
  23. var
  24.    register: regpack;
  25.    major, minor: integer;
  26.  
  27. begin
  28.    register.Ax := $3000;            {AH=30, AL=00}
  29.    msdos(register);                 {perform standard interrupt 21 request}
  30.    major := register.AX and $00FF;  {mask of high byte}
  31.    minor := register.AX shr 8;      {shift right 8 bits}
  32.    if major = 0 then writeln('DOS Version ',major,'.',minor)
  33.       else writeln ('DOS Version ',major,'.',minor);
  34.  
  35. end.
  36.  
  37. {=============================================================================}
  38.  
  39. {                        Get System Time - 21cH
  40.  
  41. Entry       Register Contents
  42. -----       -----------------
  43. AH          2CH
  44.  
  45. Return      Register Contents
  46. ------      -----------------
  47. CH          hour (0-23)
  48. CL          minutes (0-59)
  49. DH          seconds (0-59)
  50. DL          hundreds (0-99)
  51.  
  52. Remarks:    none}
  53. {----------------------------------------------------------------------------}
  54.  
  55. program get_system_time;
  56. type
  57.    regpack = record
  58.       AX,BX,CX,DX,BP,SI,DI,DS,ES,flags:integer;
  59.       end;
  60. var
  61.    register: regpack;
  62.    hour,min,sec,hun:integer;
  63.  
  64. begin
  65.    register.AX := $2c00;
  66.    msdos (register);
  67.    with register do
  68.       begin
  69.          hour := CX shr 8;
  70.          min := CX and $00ff;
  71.          sec := DX shr 8;
  72.          hun := DX and $00ff;
  73.          end;
  74.  
  75. writeln ('The system time is currently ', hour,':',min,':',sec,'.',hun);
  76. end.
  77.  
  78. {============================================================================}
  79.  
  80. {                    Get System Date - 2AH
  81.  
  82. Entry      Register Contents
  83. -----      -----------------
  84. AH         2AH
  85.  
  86. Return     Register Contents
  87. ------     -----------------
  88. AL         day of the week (0-6)
  89. DH         month
  90. CX         year
  91.  
  92. remarks:   none}
  93. {----------------------------------------------------------------------------}
  94.  
  95. program get_system_date;
  96.  
  97. type
  98.    str9 = string[9];
  99.    regpack = record
  100.       AX,BX,CX,DX,BP,SI,DI,DS,ES,flags:integer;
  101.       end;
  102. const;
  103.      daystr:array [1..7] of str9 = ('Sunday','Monday','Tuesday','Wednesday',
  104.                                     'Thursday','Friday','Saturday');
  105.  
  106. var
  107.      register:regpack;
  108.      daynum,month,day,year:integer;
  109.      mstr,dstr,ystr:string[2];
  110.  
  111. begin
  112.      register.AX := $2a00;
  113.      msdos (register);
  114.      daynum := (register.AX and $00ff) +1;
  115.      month := register.DX shr 8;
  116.      day := register.DX and $00ff;
  117.      year := register.CX - $76c;  {subtract 1900 so we get a 2 digit year}
  118.  
  119. writeln ('Today is  ',daystr[daynum],',',month,'/',day,'/',year,'.');
  120. end.
  121.  
  122. {============================================================================}
  123.  
  124. {                     Get Default Disk Drive  - 19H
  125.  
  126. Entry       Register Contents
  127. -----       -----------------
  128. AH          19H
  129.  
  130. Return      Register Contents
  131. ------      -----------------
  132. AL          Current default drive (a=0,b=1,etc)
  133.  
  134. remarks:    none}
  135. {----------------------------------------------------------------------------}
  136.  
  137. program get_default_drive;
  138. type
  139.    regpack = record
  140.       AX,BX,CX,DX,BP,SI,DI,DS,ES,flags:integer;
  141.       end;
  142. var
  143.    register: regpack;
  144.    drive:char;
  145.  
  146. begin
  147.    register.AX := $1900;
  148.    msdos (register);
  149.    drive := chr(65) + (register.AX and $00ff));
  150.    writeln ('Default Disk Drive is ', drive,':');
  151.  
  152. end.
  153. {============================================================================}
  154.  
  155. {                   Select Default Disk Drive - 0EH
  156.  
  157. Entry        Register Contents
  158. -----        -----------------
  159. AH           OEH
  160. DL          drive number (a=0,b=1,etc)
  161.  
  162. Return       Register Contents
  163. ------       -----------------
  164. AL           total number of drives
  165.  
  166. remarks:    this routine enables your program to change the default disk drive}
  167. {----------------------------------------------------------------------------}
  168.  
  169. program select_default_drive;
  170. type
  171.    regpack = record
  172.       AX,BX,CX,DX,BP,SI,DI,DS,ES,flags:integer;
  173.       end;
  174. var
  175.    drive: char;
  176.    register: regpack;
  177.  
  178. begin
  179.    drive := `B';                  {we'll set the default  to drive 'B'}
  180.    register.AX := $0E00;
  181.    register.DX := ord(drive) - 65;
  182.    msdos(register);
  183.    end.
  184.  
  185. {============================================================================}
  186.  
  187. {                      Get Current Directory - 47H
  188.  
  189. Entry        Register Contents
  190. -----        -----------------
  191. AH           47H
  192. DS           Segment pointer for 64 byte character array
  193. SI           Offset pointerfor 64 byte character array
  194. DL           Drive number (0=default, 1=A, 2=B, etc)
  195.  
  196. Return       Register Contents
  197. ------       -----------------
  198. AX           error code if carry set
  199. DS           segment of character array
  200. SI           offset of character array]
  201.  
  202. Remarks:     The default pathstring does not include the drive letter or the
  203. backlash.  After the function call is made, check cary flag for error cond-
  204. ition, if set the error code is returned in AX.  If carry flag is not set,
  205. ignore condition in AX.}
  206. {----------------------------------------------------------------------------}
  207.  
  208. program get_current_directory;
  209. type
  210.    infotext = string[255];
  211.    regpack = record
  212.       AX,BX,CX,DX,BP,SI,DI,DS,ES,flags:integer;
  213.       end;
  214. var
  215.    register: regpack;
  216.    current_directory: array[1..64] of char;
  217.  
  218. {----------------------------------------------------------------------------}
  219. function errcode(rgstr,flg:integer): integer;
  220.    begin
  221.       if (flg and $0001) = $0001 then errcode := rgstr else errcode := 0;
  222.    end;
  223. {----------------------------------------------------------------------------}
  224. function ASCZ_TO_ASC(datstr: infotext): infotext;
  225. var
  226.    inc: integer;
  227.    str: infotext;
  228.  
  229. begin
  230.    str := '';
  231.    inc := 0;
  232.    repeat
  233.       inc := inc +1;
  234.       if datastr[inc] <> chr(0) then str := str + datastr[inc];
  235.    until ((datastr[inc] = chr(0) or (inc = length (datastr)));
  236.    ASCZ_TO_ASC := str;
  237. end;
  238. {----------------------------------------------------------------------------}
  239. begin
  240.    register.AX := $4700;
  241.    register.DS := seg(current_directory);
  242.    register.SI := ofs(current_directory);
  243.    register.DX := 0;        {we'll use the default disk drive in our example}
  244.    msdos(register);
  245.    if errcode(register.AX,register.flags) = 0
  246.       then write('Current Directory on default drive is ' ,ASCZ_TO_ASC
  247.       (current_directory));
  248. end.
  249.  
  250. {============================================================================}
  251.