home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / compiler / surpas / mslib.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-10-04  |  10.3 KB  |  291 lines
  1.  
  2.  
  3. (****************************************************************)
  4. (*                                *)
  5. (*           MS-DOS FUNCTION CALL SUPPORT ROUTINES        *)
  6. (*             for SURPAS-86 1.0            *)
  7. (*                                *)
  8. (*            Copyright 1987                 *)
  9. (*                 Tixaku Pty Ltd                 *)
  10. (*                                *)
  11. (****************************************************************)
  12.  
  13.  
  14. (* This include file contains a number of subroutines which may    *)
  15. (* be used to access various MS-DOS functions not directly sup-    *)
  16. (* ported by SURPAS Pascal. To use the procedures in this file,    *)
  17. (* either include the entire file in the compilation of your    *)
  18. (* program, or copy the type and variable declarations plus the    *)
  19. (* procedures you need into your source text. Note that some of    *)
  20. (* the routines require MS-DOS version 2.0 or later. Don't at-    *)
  21. (* tempt to use these under pre-2.0 versions.            *)
  22.  
  23. (*$R- Turn off range checking.                    *)
  24.  
  25. TYPE
  26.  
  27. (* Register pack type used in software interrupts.        *)
  28.  
  29.   REGPACK = RECORD
  30.           AX,BX,CX,DX,BP,SI,DI,DS,ES,FLAGS: INTEGER;
  31.             END;
  32.  
  33. (* File name type used by INITDIR and READDIR routines.        *)
  34.  
  35.   FILENAME = STRING[11];
  36.  
  37. (* Unopened FCB type used by INITDIR and READDIR routines.    *)
  38.  
  39.   UNOFCB = RECORD
  40.          DRV: BYTE;
  41.          NAM: ARRAY[1..11] OF CHAR;
  42.        END;
  43.  
  44. (* Sector buffer type used by DIR routines.            *)
  45.  
  46.   SECTOR = ARRAY[0..127] OF BYTE;
  47.  
  48. (* Path string type.                        *)
  49.  
  50.   PATHSTR = STRING[63];
  51.  
  52. VAR
  53.  
  54. (* Register pack variable used in software interrupts.        *)
  55.  
  56.   REGS: REGPACK;
  57.  
  58. (* Unopened FCB used by INITDIR and READDIR routines.        *)
  59.  
  60.   UFCB: UNOFCB AT CSEG:$5C;
  61.  
  62. (* Sector buffer used by INITDIR and READDIR routines.        *)
  63.  
  64.   SBUF: SECTOR AT CSEG:$80;
  65.  
  66. (* End-of-directory flag set by INITDIR and READDIR routines.    *)
  67.  
  68.   EOFDIR: BOOLEAN;
  69.  
  70. (* INITDIR initializes a directory read operation. DRIVE speci-    *)
  71. (* fies the drive number (0=default, 1=A:, 2=B:, etc.) and FNAM    *)
  72. (* specifies the search file name. The search file name must be    *)
  73. (* exactly 11 characters long (name is first 8 characters, type    *)
  74. (* is last 3 characters) and it may contains ? wild cards to    *)
  75. (* match any character in that position. Following a call to    *)
  76. (* INITDIR, the EOFDIR variable is TRUE if the directory is    *)
  77. (* empty, otherwise FALSE. The file names may be read using the    *)
  78. (* READDIR routine below.                    *)
  79.  
  80. PROCEDURE INITDIR(DRIVE: INTEGER; FNAM: FILENAME);
  81. BEGIN
  82.   REGS.AX:=$1A00; REGS.DX:=OFS(SBUF); REGS.DS:=SEG(SBUF);
  83.   SWINT($21,REGS);
  84.   UFCB.DRV:=DRIVE; MOVE(FNAM[1],UFCB.NAM,11);
  85.   REGS.AX:=$1100; REGS.DX:=OFS(UFCB); REGS.DS:=SEG(UFCB);
  86.   SWINT($21,REGS); EOFDIR:=LO(REGS.AX)<>0;
  87. END;
  88.  
  89. (* READDIR reads the next directory entry. INITDIR must be cal-    *)
  90. (* led before READDIR to establish the search file name. FNAM    *)
  91. (* returns the next file name (of length 11) or an empty string    *)
  92. (* if EOFDIR is    TRUE. Use a $V- compiler directive if the FNAM    *)
  93. (* parameter is not of type STRING[11].                *)
  94.  
  95. PROCEDURE READDIR(VAR FNAM: FILENAME);
  96. BEGIN
  97.   IF EOFDIR THEN FNAM:='' ELSE
  98.   BEGIN
  99.     MOVE(SBUF[1],FNAM[1],11); FNAM[0]:=@11;
  100.     REGS.AX:=$1A00; REGS.DX:=OFS(SBUF); REGS.DS:=SEG(SBUF);
  101.     SWINT($21,REGS);
  102.     REGS.AX:=$1200; REGS.DX:=OFS(UFCB); REGS.DS:=SEG(UFCB);
  103.     SWINT($21,REGS); EOFDIR:=LO(REGS.AX)<>0;
  104.   END;
  105. END;
  106.  
  107. (* GETDISK returns the currently selected drive (0=A:, 1=B:,    *)
  108. (* etc.).                                                       *)
  109.  
  110. PROCEDURE GETDISK(VAR DRIVE: INTEGER);
  111. BEGIN
  112.   REGS.AX:=$1900; SWINT($21,REGS); DRIVE:=LO(REGS.AX);
  113. END;
  114.  
  115. (* SETDISK changes the default disk to the drive specified in   *)
  116. (* DRIVE (0=A:, 1=B:, etc.).                                    *)
  117.  
  118. PROCEDURE SETDISK(DRIVE: INTEGER);
  119. BEGIN
  120.   REGS.AX:=$0E00; REGS.DX:=DRIVE; SWINT($21,REGS);
  121. END;
  122.  
  123. (* GETDATE returns the current date set in the operating sys-    *)
  124. (* tem. Ranges of the values returned are: YEAR 1980-2099,    *)
  125. (* MONTH 1-12, DAY 1-31 and DOFW (day of week) 0-6 with 0 cor-    *)
  126. (* responding to sunday, 1 to monday, etc.).            *)
  127.  
  128. PROCEDURE GETDATE(VAR YEAR,MONTH,DAY,DOFW: INTEGER);
  129. BEGIN
  130.   REGS.AX:=$2A00; SWINT($21,REGS);
  131.   YEAR:=REGS.CX; MONTH:=HI(REGS.DX);
  132.   DAY:=LO(REGS.DX); DOFW:=LO(REGS.AX);
  133. END;
  134.  
  135. (* SETDATE sets the current date in the operating system. Valid    *)
  136. (* parameter ranges are: YEAR 1980-2099, MONTH 1-12 and DAY 1-    *)
  137. (* 31. If the date is not valid, the function call is ignored.    *)
  138.  
  139. PROCEDURE SETDATE(YEAR,MONTH,DAY: INTEGER);
  140. BEGIN
  141.   REGS.AX:=$2B00; REGS.CX:=YEAR;
  142.   REGS.DX:=SWAP(MONTH)+DAY; SWINT($21,REGS);
  143. END;
  144.  
  145. (* GETTIME returns the current time set in the operating sys-    *)
  146. (* tem. Ranges of the values returned are: HOUR 0-23, MINUTE    *)
  147. (* 0-59, SECOND 0-59 and SEC100 (hundredths of seconds) 0-99.    *)
  148.  
  149. PROCEDURE GETTIME(VAR HOUR,MINUTE,SECOND,SEC100: INTEGER);
  150. BEGIN
  151.   REGS.AX:=$2C00; SWINT($21,REGS);
  152.   HOUR:=HI(REGS.CX); MINUTE:=LO(REGS.CX);
  153.   SECOND:=HI(REGS.DX); SEC100:=LO(REGS.DX);
  154. END;
  155.  
  156. (* SETTIME sets the time in the operating system. Valid parame-    *)
  157. (* ter ranges are: HOUR 0-23, MINUTE 0-59, SECOND 0-59 and    *)
  158. (* SEC100 (hundredths of seconds) 0-99. If the time is not va-    *)
  159. (* lid, the function call is ignored.                *)
  160.  
  161. PROCEDURE SETTIME(HOUR,MINUTE,SECOND,SEC100: INTEGER);
  162. BEGIN
  163.   REGS.AX:=$2D00; REGS.CX:=SWAP(HOUR)+MINUTE;
  164.   REGS.DX:=SWAP(SECOND)+SEC100; SWINT($21,REGS);
  165. END;
  166.  
  167. (* GETDOSVER returns the MS-DOS version number. For version    *)
  168. (* 1.28 the MAJOR number would be 1 and the MINOR number 28.    *)
  169. (* For pre-1.28, MAJOR returns 0. Note that version 1.1 is the    *)
  170. (* same as 1.10, not 1.01.                    *)
  171.  
  172. PROCEDURE GETDOSVER(VAR MAJOR,MINOR: INTEGER);
  173. BEGIN
  174.   REGS.AX:=$3000; SWINT($21,REGS);
  175.   MAJOR:=LO(REGS.AX); MINOR:=HI(REGS.AX);
  176. END;
  177.  
  178. (* DISKFREE returns the free space on disk along with other    *)
  179. (* additional information about the disk. DRIVE specifies the    *)
  180. (* drive number (0=default, 1=A:, 2=B:, etc.). CLA is number of    *)
  181. (* clusters available, CPD is clusters per drive, BPS is bytes    *)
  182. (* per sector and SPC is sectors per cluster. The total number    *)
  183. (* of bytes per disk is (CPD+0.0)*BPS*SPC. The number of bytes    *)
  184. (* free    is (CLA+0.0)*BPS*SPC. Real zero (0.0) must be added to    *)
  185. (* convert the type of the expression to real as an overflow    *)
  186. (* would otherwise occur. SPC returns -1 if the drive number is    *)
  187. (* invalid. This function is only available in MS-DOS 2.0 or    *)
  188. (* later.                            *)
  189.  
  190. PROCEDURE DISKFREE(DRIVE: INTEGER; VAR CLA,CPD,BPS,SPC: INTEGER);
  191. BEGIN
  192.   REGS.AX:=$3600; REGS.DX:=DRIVE; SWINT($21,REGS);
  193.   CLA:=REGS.BX; CPD:=REGS.DX; BPS:=REGS.CX; SPC:=REGS.AX;
  194. END;
  195.  
  196. (* CREATEDIR creates a sub-directory. PATH must be a valid path    *)
  197. (* name. STATUS returns the status of the operation. 0 means no    *)
  198. (* error, 3 indicates an invalid path name, and 5 indicates    *)
  199. (* that there is no room in the parent directory or that a     *)
  200. (* file/directory of that name already exists. This function is    *)
  201. (* only available in MS-DOS 2.0 or later.            *)
  202.  
  203. PROCEDURE CREATEDIR(PATH: PATHSTR; VAR STATUS: INTEGER);
  204. VAR
  205.   N: INTEGER;
  206. BEGIN
  207.   N:=LEN(PATH); MOVE(PATH[1],PATH[0],N); PATH[N]:=@0;
  208.   REGS.AX:=$3900; REGS.DX:=OFS(PATH); REGS.DS:=SEG(PATH);
  209.   SWINT($21,REGS);
  210.   IF REGS.FLAGS AND 1=0 THEN STATUS:=0 ELSE STATUS:=REGS.AX;
  211. END;
  212.  
  213. (* REMOVEDIR removes a sub-directory from its parent directory.    *)
  214. (* PATH must be a valid path name. STATUS returns the status of    *)
  215. (* the operation. 0 means no error, 3 indicates    an invalid path    *)
  216. (* name, 5 indicates that the path is not empty, not a directo-    *)
  217. (* ry, the root directory or corrupted, and 16 indicates that    *)
  218. (* the path specified is the current directory on a drive. This    *)
  219. (* function is only available in MS-DOS 2.0 or later.        *)
  220.  
  221. PROCEDURE REMOVEDIR(PATH: PATHSTR; VAR STATUS: INTEGER);
  222. VAR
  223.   N: INTEGER;
  224. BEGIN
  225.   N:=LEN(PATH); MOVE(PATH[1],PATH[0],N); PATH[N]:=@0;
  226.   REGS.AX:=$3A00; REGS.DX:=OFS(PATH); REGS.DS:=SEG(PATH);
  227.   SWINT($21,REGS);
  228.   IF REGS.FLAGS AND 1=0 THEN STATUS:=0 ELSE STATUS:=REGS.AX;
  229. END;
  230.  
  231. (* SETDIR changes the current directory to the path name speci-    *)
  232. (* fied in the PATH parameter. STATUS returns the status of the    *)
  233. (* operation. 0 means no error and 3 indicates that the path    *)
  234. (* does not exist. This function is only available in MS-DOS    *)
  235. (* 2.0 or later.                        *)
  236.  
  237. PROCEDURE SETDIR(PATH: PATHSTR; VAR STATUS: INTEGER);
  238. VAR
  239.   N: INTEGER;
  240. BEGIN
  241.   N:=LEN(PATH); MOVE(PATH[1],PATH[0],N); PATH[N]:=@0;
  242.   REGS.AX:=$3B00; REGS.DX:=OFS(PATH); REGS.DS:=SEG(PATH);
  243.   SWINT($21,REGS);
  244.   IF REGS.FLAGS AND 1=0 THEN STATUS:=0 ELSE STATUS:=REGS.AX;
  245. END;
  246.  
  247. (* GETDIR returns the path name of the current directory on the    *)
  248. (* drive specified (0=default, 1=A:, 2=B:, etc.). The path does    *)
  249. (* not include the drive specifier or leading path separator.    *)
  250. (* STATUS returns the status of the operation. 0 means no error    *)
  251. (* and 15 indicates an invalid drive number. Use a $V- compiler    *)
  252. (* directive if the PATH parameter is not of type STRING[63].    *)
  253. (* This function is only available in MS-DOS 2.0 or later.    *)
  254.  
  255. PROCEDURE GETDIR(DRIVE: INTEGER;
  256.   VAR PATH: PATHSTR; VAR STATUS: INTEGER);
  257. VAR
  258.   N: INTEGER;
  259. BEGIN
  260.   REGS.AX:=$4700; REGS.DX:=DRIVE; REGS.SI:=OFS(PATH);
  261.   REGS.DS:=SEG(PATH); SWINT($21,REGS);
  262.   IF REGS.FLAGS AND 1=0 THEN
  263.   BEGIN
  264.     N:=0; WHILE PATH[N]<>@0 DO N:=N+1;
  265.     MOVE(PATH[0],PATH[1],N); PATH[0]:=CHR(N);
  266.     STATUS:=0;
  267.   END ELSE
  268.   STATUS:=REGS.AX;
  269. END;
  270.  
  271. (* RENFILE attempts to rename the file designated by OPATH into    *)
  272. (* the path designated by NPATH. STATUS returns the status of    *)
  273. (* the operation. 0 means no error, 2 indicates that the file    *)
  274. (* named by OPATH does not exist, 5 indicates that the path    *)
  275. (* specified in OPATH is a directory or that the file specified    *)
  276. (* by NPATH already exists or that there is no room to create a    *)
  277. (* new directory entry, and 17 indicates that OPATH and NPATH    *)
  278. (* are not on the same drive. This function is only available    *)
  279. (* in MS-DOS 2.0 or later.                    *)
  280.  
  281. PROCEDURE RENFILE(OPATH,NPATH: PATHSTR; VAR STATUS: INTEGER);
  282. VAR
  283.   N: INTEGER;
  284. BEGIN
  285.   N:=LEN(OPATH); MOVE(OPATH[1],OPATH[0],N); OPATH[N]:=@0;
  286.   N:=LEN(NPATH); MOVE(NPATH[1],NPATH[0],N); NPATH[N]:=@0;
  287.   REGS.AX:=$5600; REGS.DX:=OFS(OPATH); REGS.DI:=OFS(NPATH);
  288.   REGS.DS:=SEG(OPATH); REGS.ES:=SEG(NPATH); SWINT($21,REGS);
  289.   IF REGS.FLAGS AND 1=0 THEN STATUS:=0 ELSE STATUS:=REGS.AX;
  290. END;
  291.