home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / bp7os2 / dos.pas < prev    next >
Pascal/Delphi Source File  |  1993-12-30  |  30KB  |  934 lines
  1. {*RG--*}
  2. {$S-,R-,Q-,I-,B-}
  3. {*--RG*}
  4.  
  5. Unit Dos;
  6.  
  7. {**********************************************************}
  8. {                                                          }
  9. { BP4OS2: CRT Interface Unit                               }
  10. {                                                          }
  11. {         Portions of this file                            }
  12. {         Copyright (C) 1988,92 Borland International      }
  13. {         Used with permission                             }
  14. {                                                          }
  15. {----------------------------------------------------------}
  16. {  Borland - Interface                                     }
  17. {  Matthias Withopf / c't - limited Port to OS/2           }
  18. {  Rohit Gupta  -  Completed DOS compatability             }
  19. {  Rick Widmer - Added comments                            }
  20. {**********************************************************}
  21.  
  22.  
  23.  
  24. {****************************************}
  25. {                                        }
  26. {      ***    ****   *****     *         }
  27. {      *  *   *        *      * *        }
  28. {      ***    ***      *      ***        }
  29. {      *  *   *        *     *   *       }
  30. {      ***    ****     *     *   *       }
  31. {                                        }
  32. { Please report problems (and successes) }
  33. { on BPASCAL section 17. Prefix all      }
  34. { messages with BP4OS2.                  }
  35. {                                        }
  36. { Internet: 72162.470@compuserve.com     }
  37. {                                        }
  38. { NOTE:  Flags, Registers, MSDOS, INTR   }
  39. {        GetIntVec and SetIntVec are     }
  40. {        in Compatab.Pas                 }
  41. {                                        }
  42. {        The functions of Keep and       }
  43. {        SwapVectors are not needed      }
  44. {        with OS/2, they are not         }
  45. {        supported.                      }
  46. {                                        }
  47. {        GetCBreak and SetCBreak have    }
  48. {        not been needed yet, and are    }
  49. {        not ported.                     }
  50. {                                        }
  51. {****************************************}
  52.  
  53. Interface
  54.  
  55. Const
  56.  
  57. { File mode magic numbers }
  58.  
  59.   fmClosed = $D7B0;
  60.   fmInput  = $D7B1;
  61.   fmOutput = $D7B2;
  62.   fmInOut  = $D7B3;
  63.  
  64.  
  65. { File attribute constants }
  66.  
  67.   ReadOnly  = $01;
  68.   Hidden    = $02;
  69.   SysFile   = $04;
  70.   VolumeId  = $08;
  71.   Directory = $10;
  72.   Archive   = $20;
  73.   AnyFile   = $37;
  74.  
  75. Type
  76.  
  77. { String types }
  78.  
  79.   ComStr  = String[127];
  80.   PathStr = String[79];
  81.   DirStr  = String[67];
  82.   NameStr = String[8];
  83.   ExtStr  = String[4];
  84.  
  85. Type
  86.  
  87. { Typed-file and untyped-file record }
  88.  
  89.   FileRec = Record
  90.               Handle   : Word;
  91.               Mode     : Word;
  92.               RecSize  : Word;
  93.               Private  : Array[1..26] of Byte;
  94.               UserData : Array[1..16] of Byte;
  95.               Name     : Array[0..79] of Char;
  96.             End;
  97.  
  98. { Textfile record }
  99.  
  100.   TextBuf = Array[0..127] of Char;
  101.   TextRec = Record
  102.               Handle    : Word;
  103.               Mode      : Word;
  104.               BufSize   : Word;
  105.               Private   : Word;
  106.               BufPos    : Word;
  107.               BufEnd    : Word;
  108.               BufPtr    : ^TextBuf;
  109.               OpenFunc  : Pointer;
  110.               InOutFunc : Pointer;
  111.               FlushFunc : Pointer;
  112.               CloseFunc : Pointer;
  113.               UserData  : Array[1..16] of Byte;
  114.               Name      : Array[0..79] of Char;
  115.               Buffer    : TextBuf;
  116.             End;
  117.  
  118.  
  119. { Search record used by FindFirst and FindNext }
  120.  
  121.   SearchRec = Record
  122.                 Fill : Array[1..21] of Byte;
  123.                 Attr : Byte;
  124.                 Time : LongInt;
  125.                 Size : LongInt;
  126.                 Name : String[12];
  127.               End;
  128.  
  129.  
  130. { Date and time record used by PackTime and UnpackTime }
  131.  
  132.   DateTime = Record
  133.                Year,Month,Day,Hour,Min,Sec : Word;
  134.              End;
  135.  
  136.  
  137.  
  138. {*  MW  *}
  139.   TPID = Word;
  140.   TTID = Word;
  141.   TSel = Word;
  142.  
  143.   PGlobalInfoSeg = ^TGlobalInfoSeg;
  144.   TGlobalInfoSeg = Record
  145.                      time                : LongInt;
  146.                      msecs               : LongInt;
  147.                      hour                : Byte;
  148.                      minutes             : Byte;
  149.                      seconds             : Byte;
  150.                      hundredths          : Byte;
  151.                      timezone            : Word;
  152.                      cusecTimerInterval  : Word;
  153.                      day                 : Byte;
  154.                      month               : Byte;
  155.                      year                : Word;
  156.                      weekday             : Byte;
  157.                      uchMajorVersion     : Byte;
  158.                      uchMinorVersion     : Byte;
  159.                      chRevisionLetter    : Byte;
  160.                      sgCurrent           : Byte;
  161.                      sgMax               : Byte;
  162.                      cHugeShift          : Byte;
  163.                      fProtectModeOnly    : Byte;
  164.                      pidForeground       : Word;
  165.                      fDynamicSched       : Byte;
  166.                      csecMaxWait         : Byte;
  167.                      cmsecMinSlice       : Word;
  168.                      cmsecMaxSlice       : Word;
  169.                      bootdrive           : Word;
  170.                      amecRAS             : Array[1..32] of Byte;
  171.                      csgWindowableVioMax : Byte;
  172.                      csgPMMax            : Byte;
  173.                    End;
  174.  
  175.   PLocalInfoSeg = ^TLocalInfoSeg;
  176.   TLocalInfoSeg  = Record
  177.                      pidCurrent          : TPID;
  178.                      pidParent           : TPID;
  179.                      prtyCurrent         : Word;
  180.                      tidCurrent          : TTID;
  181.                      sgCurrent           : Word;
  182.                      rfProcStatus        : Byte;
  183.                      dummy1              : Byte;
  184.                      fForeground         : WordBool;
  185.                      typeProcess         : Byte;
  186.                      dummy2              : Byte;
  187.                      selEnvironment      : TSel;
  188.                      offCmdLine          : Word;
  189.                      cbDataSegment       : Word;
  190.                      cbStack             : Word;
  191.                      cbHeap              : Word;
  192.                      hmod                : Word;
  193.                      selDS               : TSel;
  194.                    End;
  195.  
  196. Const
  197.  
  198.   ExecFlags     : Word = 0;   { EXEC_SYNC }
  199. {*  MW  *}
  200.  
  201. Var
  202.  
  203. { Error status variable }
  204.  
  205.   DosError      : Integer;
  206.  
  207. { MW   OS/2 Global Information Segment pointer }
  208.  
  209.   GlobalInfoSeg : PGlobalInfoSeg;
  210.  
  211. { MW   OS/2 Local Information Segment pointer }
  212.  
  213.   LocalInfoSeg  : PLocalInfoSeg;
  214.  
  215. { DosVersion returns the DOS version number. The low byte of    }
  216. { the result is the major version number, and the high byte is  }
  217. { the minor version number. For example, DOS 3.20 returns 3 in  }
  218. { the low byte, and 20 in the high byte.                        }
  219.  
  220.   Function  DosVersion : Word;
  221.  
  222. { Intr executes a specified software interrupt with a specified }
  223. { Registers package.       ***  Moved to Compatib  ***          }
  224.  
  225. { MsDos invokes the DOS function call handler with a specified  }
  226. { Registers package.       ***  Moved to Compatib  ***          }
  227.  
  228. { GetDate returns the current date set in the operating system. }
  229. { Ranges of the values returned are: Year 1980-2099, Month      }
  230. { 1-12, Day 1-31 and DayOfWeek 0-6 (0 corresponds to Sunday).   }
  231.  
  232.   Procedure GetDate(Var Year,Month,Day,DayofWeek : Word);
  233.  
  234. { SetDate sets the current date in the operating system. Valid  }
  235. { parameter ranges are: Year 1980-2099, Month 1-12 and Day      }
  236. { 1-31. If the date is not valid, the function call is ignored. }
  237.  
  238.   Procedure SetDate(Year,Month,Day : Word);
  239.  
  240. { GetTime returns the current time set in the operating system. }
  241. { Ranges of the values returned are: Hour 0-23, Minute 0-59,    }
  242. { Second 0-59 and Sec100 (hundredths of seconds) 0-99.          }
  243.  
  244.   Procedure GetTime(Var Hour,Minute,Second,Sec100 : Word);
  245.  
  246. { SetTime sets the time in the operating system. Valid          }
  247. { parameter ranges are: Hour 0-23, Minute 0-59, Second 0-59 and }
  248. { Sec100 (hundredths of seconds) 0-99. If the time is not       }
  249. { valid, the function call is ignored.                          }
  250.  
  251.   Procedure SetTime(Hour,Minute,Second,Sec100 : Word);
  252.  
  253. { GetCBreak returns the state of Ctrl-Break checking in DOS.    }
  254. { When off (False), DOS only checks for Ctrl-Break during I/O   }
  255. { to console, printer, or communication devices. When on        }
  256. { (True), checks are made at every system call.                 }
  257.  
  258.  
  259. { SetCBreak sets the state of Ctrl-Break checking in DOS.       }
  260.  
  261.  
  262. { GetVerify returns the state of the verify flag in DOS. When   }
  263. { off (False), disk writes are not verified. When on (True),    }
  264. { all disk writes are verified to insure proper writing.        }
  265.  
  266.   Procedure GetVerify(Var Verify : Boolean);
  267.  
  268. { SetVerify sets the state of the verify flag in DOS.           }
  269.  
  270.   Procedure SetVerify(Verify : Boolean);
  271.  
  272. { DiskFree returns the number of free bytes on the specified    }
  273. { drive number (0=Default,1=A,2=B,..). DiskFree returns -1 if   }
  274. { the drive number is invalid.                                  }
  275.  
  276.   Function  DiskFree(Drive : Byte) : LongInt;
  277.  
  278. { DiskSize returns the size in bytes of the specified drive     }
  279. { number (0=Default,1=A,2=B,..). DiskSize returns -1 if the     }
  280. { drive number is invalid.                                      }
  281.  
  282.   Function  DiskSize(Drive : Byte) : LongInt;
  283.  
  284. { GetFAttr returns the attributes of a file. F must be a file   }
  285. { variable (typed, untyped or textfile) which has been assigned }
  286. { a name. The attributes are examined by ANDing with the        }
  287. { attribute masks defined as constants above. Errors are        }
  288. { reported in DosError.                                         }
  289.  
  290.   Procedure GetFAttr(Var f;Var Attr : Word);
  291.  
  292. { SetFAttr sets the attributes of a file. F must be a file      }
  293. { variable (typed, untyped or textfile) which has been assigned }
  294. { a name. The attribute value is formed by adding (or ORing)    }
  295. { the appropriate attribute masks defined as constants above.   }
  296. { Errors are reported in DosError.                              }
  297.  
  298.   Procedure SetFAttr(Var f;Attr : Word);
  299.  
  300. { GetFTime returns the date and time a file was last written.   }
  301. { F must be a file variable (typed, untyped or textfile) which  }
  302. { has been assigned and opened. The Time parameter may be       }
  303. { unpacked throgh a call to UnpackTime. Errors are reported in  }
  304. { DosError.                                                     }
  305.  
  306.   Procedure GetFTime(Var f;Var Time : LongInt);
  307.  
  308. { SetFTime sets the date and time a file was last written.      }
  309. { F must be a file variable (typed, untyped or textfile) which  }
  310. { has been assigned and opened. The Time parameter may be       }
  311. { created through a call to PackTime. Errors are reported in    }
  312. { DosError.                                                     }
  313.  
  314.   Procedure SetFTime(Var f;Time : LongInt);
  315.  
  316. { FindFirst searches the specified (or current) directory for   }
  317. { the first entry that matches the specified filename and       }
  318. { attributes. The result is returned in the specified search    }
  319. { record. Errors (and no files found) are reported in DosError. }
  320.  
  321.   Procedure FindFirst(Path : PathStr;Attr : Word;Var S : SearchRec);
  322.  
  323. { FindNext returs the next entry that matches the name and      }
  324. { attributes specified in a previous call to FindFirst. The     }
  325. { search record must be one passed to FindFirst. Errors (and no }
  326. { more files) are reported in DosError.                         }
  327.  
  328.   Procedure FindNext(Var S : SearchRec);
  329.  
  330. { UnpackTime converts a 4-byte packed date/time returned by     }
  331. { FindFirst, FindNext or GetFTime into a DateTime record.       }
  332.  
  333.   Procedure UnpackTime(P : LongInt;Var T : DateTime);
  334.  
  335. { PackTime converts a DateTime record into a 4-byte packed      }
  336. { date/time used by SetFTime.                                   }
  337.  
  338.   Procedure PackTime(Var T : DateTime;Var P : LongInt);
  339.  
  340. { GetIntVec returns the address stored in the specified         }
  341. { interrupt vector.         ***  Moved to Compatib  ***         }
  342.  
  343.  
  344. { SetIntVec sets the address in the interrupt vector table for  }
  345. { the specified interrupt.  ***  Moved to Compatib  ***         }
  346.  
  347.  
  348. { FSearch searches for the file given by Path in the list of    }
  349. { directories given by DirList. The directory paths in DirList  }
  350. { must be separated by semicolons. The search always starts     }
  351. { with the current directory of the current drive. The returned }
  352. { value is a concatenation of one of the directory paths and    }
  353. { the file name, or an empty string if the file could not be    }
  354. { located.                                                      }
  355.  
  356.   Function  FSearch(Path : PathStr;DirList : String) : PathStr;
  357.  
  358. { FExpand expands the file name in Path into a fully qualified  }
  359. { file name. The resulting name consists of a drive letter, a   }
  360. { colon, a root relative directory path, and a file name.       }
  361. { Embedded '.' and '..' directory references are removed.       }
  362.  
  363.   Function  FExpand(Path : PathStr) : PathStr;
  364.  
  365. { FSplit splits the file name specified by Path into its three  }
  366. { components. Dir is set to the drive and directory path with   }
  367. { any leading and trailing backslashes, Name is set to the file }
  368. { name, and Ext is set to the extension with a preceding dot.   }
  369. { Each of the component strings may possibly be empty, if Path  }
  370. { contains no such component.                                   }
  371.  
  372.   Procedure FSplit(Path : PathStr;Var Dir : DirStr;Var Name : NameStr;Var Ext : ExtStr);
  373.  
  374. { EnvCount returns the number of strings contained in the DOS   }
  375. { environment.                                                  }
  376.  
  377.   Function  EnvCount : Integer;
  378.  
  379. { EnvStr returns a specified environment string. The returned   }
  380. { string is of the form "VAR=VALUE". The index of the first     }
  381. { string is one. If Index is less than one or greater than      }
  382. { EnvCount, EnvStr returns an empty string.                     }
  383.  
  384.   Function  EnvStr(Index : Integer) : String;
  385.  
  386. { GetEnv returns the value of a specified environment variable. }
  387. { The variable name can be in upper or lower case, but it must  }
  388. { not include the '=' character. If the specified environment   }
  389. { variable does not exist, GetEnv returns an empty string.      }
  390.  
  391.   Function  GetEnv(EnvVar : String) : String;
  392.  
  393. { SwapVectors swaps the contents of the SaveIntXX pointers in   }
  394. { the System unit with the current contents of the interrupt    }
  395. { vectors. SwapVectors is typically called just before and just }
  396. { after a call to Exec. This insures that the Exec'd process    }
  397. { does not use any interrupt handlers installed by the current  }
  398. { process, and vice versa.                                      }
  399. {                                                               }
  400. {**                                                           **}
  401. {**   SwapVectors is no longer needed.  Exec starts a separate**}
  402. {** session that does not depend on the machine state, or use **}
  403. {** any memory of this session.                               **}
  404. {**                                                           **}
  405.  
  406. { Keep (or Terminate Stay Resident) terminates the program and  }
  407. { makes it stay in memory. The entire program stays in memory,  }
  408. { including data segment, stack segment, and heap. The ExitCode }
  409. { corresponds to the one passed to the Halt standard procedure. }
  410. {                                                               }
  411. {**                                                           **}
  412. {**    OS/2 makes the whole idea of TSR programs obsolete.    **}
  413. {**  this procedure is no longer supported.                   **}
  414. {**                                                           **}
  415.  
  416. { Exec executes another program. The program is specified by    }
  417. { the Path parameter, and the command line is specified by the  }
  418. { CmdLine parameter. To execute a DOS internal command, run     }
  419. { COMMAND.COM, e.g. "Exec('\COMMAND.COM','/C DIR *.PAS');".     }
  420. { Note the /C in front of the command. Errors are reported in   }
  421. { DosError. When compiling a program that uses Exec, be sure    }
  422. { to specify a maximum heap size as there will otherwise not be }
  423. { enough memory.                                                }
  424.  
  425.   Procedure Exec(Path : PathStr;ComLine : ComStr);
  426.  
  427. { DosExitCode returns the exit code of a sub-process. The low   }
  428. { byte is the code sent by the terminating process. The high    }
  429. { byte is zero for normal termination, 1 if terminated by       }
  430. { Ctrl-C, 2 if terminated due to a device error, or 3 if        }
  431. { terminated by the Keep procedure (function call 31 hex).      }
  432.  
  433.   Function  DosExitCode : Word;
  434.  
  435.  
  436.   Procedure PlaySound(Frequency,Duration : Word);
  437.  
  438. Implementation
  439.  
  440. Type
  441.   OS2DateTime = Record
  442.                   Hours,
  443.                   Minutes,
  444.                   Seconds,
  445.                   Hundredths,
  446.                   Day,
  447.                   Month        : Byte;
  448.                   Year         : Word;
  449.                   TimeZone     : Integer;
  450.                   WeekDay      : Byte;
  451.                 End;
  452.  
  453.   OS2FSAllocate = Record
  454.                     idFileSystem : LongInt;
  455.                     cSectorUnit  : LongInt;
  456.                     cUnit        : LongInt;
  457.                     cUnitAvail   : LongInt;
  458.                     cbSector     : Word;
  459.                   End;
  460.  
  461.   OS2FileStatus = Record
  462.                     fDateCreation   : Word;
  463.                     fTimeCreation   : Word;
  464.                     fDateLastAccess : Word;
  465.                     fTimeLastAccess : Word;
  466.                     fDateLastWrite  : Word;
  467.                     fTimeLastWrite  : Word;
  468.                     cbFile          : LongInt;
  469.                     cbFileAlloc     : LongInt;
  470.                     AttrFile        : Word;
  471.                   End;
  472.  
  473.   OS2FileFindBuf = Record
  474.                     fDateCreation   : Word;
  475.                     fTimeCreation   : Word;
  476.                     fDateLastAccess : Word;
  477.                     fTimeLastAccess : Word;
  478.                     fDateLastWrite  : Word;
  479.                     fTimeLastWrite  : Word;
  480.                     cbFile          : LongInt;
  481.                     cbFileAlloc     : LongInt;
  482.                     AttrFile        : Word;
  483.                     cchName         : Byte;
  484.                     achName         : Array[0..12] of Char;
  485.                    End;
  486.  
  487.   Function DosGetInfoSeg(Var GlobalSeg,LocalSeg : TSel) : Word; Far;
  488.     External 'DOSCALLS' Index $08;
  489.   Function DosSetDateTime(Var DateTime : OS2DateTime) : Word; Far;
  490.     External 'DOSCALLS' Index $1C;
  491.   Function DosGetDateTime(Var DateTime : OS2DateTime) : Word; Far;
  492.     External 'DOSCALLS' Index $21;
  493.   Function DosBeep(Freq,Durat : Word) : Word; Far;
  494.     External 'DOSCALLS' Index $32;
  495.   Function DosFindClose(DirHandle : Word) : Word; Far;
  496.     External 'DOSCALLS' Index $3F;
  497.   Function DosFindFirst(PathName : PChar;Var DirHandle : Word;Attrib : Word;Var FindBuf;BufLen : Word;
  498.                         Var SearchCount : Word;Reserved : LongInt) : Word; Far;
  499.     External 'DOSCALLS' Index $40;
  500.   Function DosFindNext(DirHandle : Word;Var FindBuf;BufLen : Word;Var SearchCount : Word) : Word; Far;
  501.     External 'DOSCALLS' Index $41;
  502.   Function DosQFileInfo(Handle : Word;InfoLevel : Word;Var Info;InfoLen : Word) : Word; Far;
  503.     External 'DOSCALLS' Index $4A;
  504.   Function DosQFileMode(Name : PChar;Var Attrib : Word;Reserved : LongInt) : Word; Far;
  505.     External 'DOSCALLS' Index $4B;
  506.   Function DosQFSInfo(DriveNo : Word;InfoLevel : Word;Var Info;InfoLen : Word) : Word; Far;
  507.     External 'DOSCALLS' Index $4C;
  508.   Function DosQVerify(Var Verify : Word) : Word; Far;
  509.     External 'DOSCALLS' Index $4E;
  510.   Function DosSetFileInfo(Handle : Word;InfoLevel : Word;Var Info;InfoLen : Word) : Word; Far;
  511.     External 'DOSCALLS' Index $53;
  512.   Function DosSetFileMode(Name : PChar;Attrib : Word;Reserved : LongInt) : Word; Far;
  513.     External 'DOSCALLS' Index $54;
  514.   Function DosSetVerify(Verify : Word) : Word; Far;
  515.     External 'DOSCALLS' Index $56;
  516.   Function DosGetVersion(Var Version : Word) : Word; Far;
  517.     External 'DOSCALLS' Index $5C;
  518.   Function DosExecPgm(Var FailBuf;FailBufLen : Word;Flags : Word;Args : PChar;Env : PChar;
  519.                       Var Result;ExecName : PChar) : Word; Far;
  520.     External 'DOSCALLS' Index $90;
  521.  
  522.   Function DosVersion : Word;
  523.   Var
  524.     Version : Word;
  525.   Begin
  526.     DosError := DosGetVersion(Version);
  527.     If DosError = 0 then
  528.       DosVersion := Version
  529.     else
  530.       DosVersion := 0;
  531.   End;
  532.  
  533.   Procedure GetDate(Var Year,Month,Day,DayofWeek : Word);
  534.   Var
  535.     DT : OS2DateTime;
  536.   Begin
  537.     DosError := DosGetDateTime(DT);
  538.     If DosError = 0 then
  539.       Begin
  540.         Year      := DT.Year;
  541.         Month     := DT.Month;
  542.         Day       := DT.Day;
  543.         DayOfWeek := DT.WeekDay;
  544.       End
  545.     else
  546.       Begin
  547.         Year      := 0;
  548.         Month     := 0;
  549.         Day       := 0;
  550.         DayOfWeek := 0;
  551.       End;
  552.   End;
  553.  
  554. {*RG--*}
  555.   Procedure SetDate(Year,Month,Day : Word);
  556.   Var
  557.     DT : OS2DateTime;
  558.   Begin
  559.     DosError := DosGetDateTime(DT);
  560.     If DosError = 0 then
  561.       Begin
  562.         DT.Year    := Year;
  563.         DT.Month   := Month;
  564.         DT.Day     := Day;
  565.         DT.WeekDay := 0;            {  Day Of Week  }
  566.         DosSetDateTime(DT);
  567.       End;
  568.   End;
  569. {*--RG*}
  570.  
  571.   Procedure GetTime(Var Hour,Minute,Second,Sec100 : Word);
  572.   Var
  573.     DT : OS2DateTime;
  574.   Begin
  575.     DosError := DosGetDateTime(DT);
  576.     If DosError = 0 then
  577.       Begin
  578.         Hour   := DT.Hours;
  579.         Minute := DT.Minutes;
  580.         Second := DT.Seconds;
  581.         Sec100 := DT.Hundredths;
  582.       End
  583.     else
  584.       Begin
  585.         Hour   := 0;
  586.         Minute := 0;
  587.         Second := 0;
  588.         Sec100 := 0;
  589.       End;
  590.   End;
  591.  
  592.   Procedure SetTime(Hour,Minute,Second,Sec100 : Word);
  593.   Var
  594.     DT : OS2DateTime;
  595.   Begin
  596.     DosError := DosGetDateTime(DT);
  597.     If DosError = 0 then
  598.       Begin
  599.         DT.Hours      := Hour;
  600.         DT.Minutes    := Minute;
  601.         DT.Seconds    := Second;
  602.         DT.Hundredths := Sec100;
  603.         DosSetDateTime(DT);
  604.       End;
  605.   End;
  606.  
  607.   Procedure GetVerify(Var Verify : Boolean);
  608.   Var
  609.     V : Word;
  610.   Begin
  611.     DosError := DosQVerify(V);
  612.     If DosError = 0 then
  613.       Verify := Boolean(V)
  614.     else
  615.       Verify := False;
  616.   End;
  617.  
  618.   Procedure SetVerify(Verify : Boolean);
  619.   Begin
  620.     DosError := DosSetVerify(Word(Verify));
  621.   End;
  622.  
  623.   Function DiskFree(Drive : Byte) : LongInt;
  624.   Var
  625.     FI : OS2FSAllocate;
  626.   Begin
  627.     DosError := DosQFSInfo(Drive,1,FI,sizeof(FI));
  628.     If DosError = 0 then
  629.       DiskFree := FI.cUnitAvail * FI.cSectorUnit * FI.cbSector
  630.     else
  631.       DiskFree := -1;
  632.   End;
  633.  
  634.   Function DiskSize(Drive : Byte) : LongInt;
  635.   Var
  636.     FI : OS2FSAllocate;
  637.   Begin
  638.     DosError := DosQFSInfo(Drive,1,FI,sizeof(FI));
  639.     If DosError = 0 then
  640.       DiskSize := FI.cUnit * FI.cSectorUnit * FI.cbSector
  641.     else
  642.       DiskSize := -1;
  643.   End;
  644.  
  645.   Procedure GetFAttr(Var f;Var Attr : Word);
  646.   Var
  647.     A : Word;
  648.   Begin
  649.     DosError := DosQFileMode(FileRec(f).Name,A,0);
  650.     If DosError = 0 then
  651.       Attr := A
  652.     else
  653.       Attr := 0;
  654.   End;
  655.  
  656.   Procedure SetFAttr(Var f;Attr : Word);
  657.   Begin
  658.     DosError := DosSetFileMode(FileRec(f).Name,Attr,0);
  659.   End;
  660.  
  661.   Procedure GetFTime(Var f;Var Time : LongInt);
  662.   Var
  663.     FI : OS2FileStatus;
  664.     T1 : Record
  665.            Time,Date : Word;
  666.          End Absolute Time;
  667.   Begin
  668.     DosError := DosQFileInfo(FileRec(f).Handle,1,FI,SizeOf(FI));
  669.     If DosError = 0 then
  670.       Begin
  671.         T1.Time := FI.fTimeLastWrite;
  672.         T1.Date := FI.fDateLastWrite;
  673.       End
  674.     else
  675.       Begin
  676.         T1.Time := 0;
  677.         T1.Date := 0;
  678.       End;
  679.   End;
  680.  
  681.   Procedure SetFTime(Var f;Time : LongInt);
  682.   Var
  683.     FI : OS2FileStatus;
  684.     T1 : Record
  685.            Time,Date : Word;
  686.          End Absolute Time;
  687.   Begin
  688.     DosError := DosQFileInfo(FileRec(f).Handle,1,FI,SizeOf(FI));
  689.     If DosError = 0 then
  690.       Begin
  691.         FI.fTimeLastWrite := T1.Time;
  692.         FI.fDateLastWrite := T1.Date;
  693.         DosError := DosSetFileInfo(FileRec(f).Handle,1,FI,SizeOf(FI));
  694.       End;
  695.   End;
  696.  
  697.   Procedure FindFirst(Path : PathStr;Attr : Word;Var S : SearchRec);
  698.   Var
  699.     FF    : OS2FileFindBuf;
  700.     N     : String;
  701.     Count : Word;
  702.   Type
  703.     PWord = ^Word;
  704.   Begin
  705.     N := Path + #0;
  706.     Count := 1;
  707.     PWord(@S)^ := $FFFF; { HDIR_CREATE }
  708.     DosError := DosFindFirst(@N[1],PWord(@S)^,Attr,FF,SizeOf(FF),Count,0);
  709.     If DosError = 0 then
  710.       Begin
  711.         S.Attr := FF.AttrFile;
  712.         S.Time := (LongInt(FF.fDateLastWrite) Shl 16) + FF.fTimeLastWrite;
  713.         S.Size := FF.cbFile;
  714.         Move(FF.cchName,S.Name,SizeOf(S.Name))
  715.       End;
  716.   End;
  717.  
  718.   Procedure FindNext(Var S : SearchRec);
  719.   Var
  720.     FF    : OS2FileFindBuf;
  721.     Count : Word;
  722.   Type
  723.     PWord = ^Word;
  724.   Begin
  725.     Count := 1;
  726.     DosError := DosFindNext(PWord(@S)^,FF,SizeOf(FF),Count);
  727.     If DosError = 0 then
  728.       Begin
  729.         S.Attr := FF.AttrFile;
  730.         S.Time := (LongInt(FF.fDateLastWrite) Shl 16) + FF.fTimeLastWrite;
  731.         S.Size := FF.cbFile;
  732.         Move(FF.cchName,S.Name,SizeOf(S.Name))
  733.       End
  734.     else
  735.       DosFindClose(PWord(@S)^);
  736.   End;
  737.  
  738.   Procedure PackTime(Var T : DateTime;Var P : LongInt);
  739.   Var
  740.     P1 : Record
  741.            Time,Date : Word;
  742.          End Absolute P;
  743.   Begin
  744.     P1.Date := (T.Year - 1980) Shl 9 + T.Month Shl 5 + T.Day;
  745.     P1.Time := T.Hour Shl 11 + T.Min Shl 5 + T.Sec Shr 1;
  746.   End;
  747.  
  748.   Procedure UnpackTime(P : LongInt;Var T : DateTime);
  749.   Var
  750.     P1 : Record
  751.            Time,Date : Word;
  752.          End Absolute P;
  753.   Begin
  754.     T.Year  := P1.Date Shr 9 + 1980;
  755.     T.Month := (P1.Date Shr 5) And 15;
  756.     T.Day   := P1.Date And 31;
  757.     T.Hour  := P1.Time Shr 11;
  758.     T.Min   := (P1.Time Shr 5) And 63;
  759.     T.Sec   := (P1.Time And 31) Shl 1;
  760.   End;
  761.  
  762.   Function FSearch(Path : PathStr;DirList : String) : PathStr;
  763.   Var
  764.     Name   : String;
  765.     Attrib : Word;
  766.     p      : Byte;
  767.   Begin
  768.     FSearch := '';
  769.     Name := Path;
  770.     Repeat
  771.       Name := Name + #0;
  772.       DosError := DosQFileMode(@Name[1],Attrib,0);
  773.       If (DosError = 0) and ((Attrib And $18) = 0) then
  774.         Begin
  775.           FSearch := Copy(Name,1,Length(Name) - 1);
  776.           Break;
  777.         End
  778.       else
  779.         Begin
  780.           If DirList = '' then Break;
  781.           p := Pos(';',DirList);
  782.           If p <> 0 then
  783.             Begin
  784.               Name := Copy(DirList,1,p - 1) + '\' + Path;
  785.               DirList := Copy(DirList,p + 1,255);
  786.             End
  787.           else
  788.             Begin
  789.               Name := DirList + '\' + Path;
  790.               DirList := '';
  791.             End;
  792.         End;
  793.     Until False;
  794.   End;
  795.  
  796.   Function FExpand(Path : PathStr) : PathStr;
  797.   Var
  798.     s : String;
  799.   Begin
  800.     GetDir(0,s);
  801.     If s <> '' then
  802.       If s[Length(s) - 1] <> '\' then
  803.         s := s + '\';
  804.     FExpand := s + Path;
  805.   End;
  806.  
  807.   Procedure FSplit(Path : PathStr;Var Dir : DirStr;Var Name : NameStr;Var Ext : ExtStr);
  808.   Var
  809.     l : Integer;
  810.   Begin
  811.     l := Length(Path);
  812.     While Not(Path[l] in ['\',':']) and (l > 0) do Dec(l);
  813.     Dir := Copy(Path,1,l);
  814.     Path := Copy(Path,l + 1,255);
  815.     l := Pos('.',Path);
  816.     If l <> 0 then
  817.       Begin
  818.         Name := Copy(Path,1,l - 1);
  819.         Ext  := Copy(Path,l,4);
  820.       End
  821.     else
  822.       Begin
  823.         Name := Path;
  824.         Ext  := '';
  825.       End;
  826.   End;
  827.  
  828.   Function EnvCount : Integer;
  829.   Var
  830.     p   : PChar;
  831.     i,l : Integer;
  832.   Begin
  833.     p := Ptr(EnvironmentSeg,0);
  834.     i := 0;
  835.     Repeat
  836.       l := 0;
  837.       While p^ <> #0 do
  838.         Begin
  839.           Inc(l); Inc(p);
  840.         End;
  841.       Inc(p);
  842.       If l = 0 then Break;
  843.       Inc(i);
  844.     Until False;
  845.     EnvCount := i;
  846.   End;
  847.  
  848.   Function EnvStr(Index : Integer) : String;
  849.   Var
  850.     p : PChar;
  851.     s : String;
  852.     i : Integer;
  853.   Begin
  854.     p := Ptr(EnvironmentSeg,0);
  855.     s := '';
  856.     For i := 1 to Index do
  857.       Begin
  858.         s := '';
  859.         While p^ <> #0 do
  860.           Begin
  861.             s := s + p^; Inc(p);
  862.           End;
  863.         Inc(p);
  864.         If s = '' then Break;
  865.       End;
  866.     EnvStr := s;
  867.   End;
  868.  
  869.   Function GetEnv(EnvVar : String) : String;
  870.   Var
  871.     Count,i : Integer;
  872.     s       : String;
  873.     p       : Byte;
  874.   Begin
  875.     Count := EnvCount;
  876.     For i := 1 to Count do
  877.       Begin
  878.         s := EnvStr(i);
  879.         p := Pos('=',s);
  880.         If p <> 0 then
  881.           If Copy(s,1,p - 1) = EnvVar then
  882.             Begin
  883.               GetEnv := Copy(s,p + 1,255);
  884.               Exit;
  885.             End;
  886.       End;
  887.     GetEnv := '';
  888.   End;
  889.  
  890. Var
  891.   ExecResult : Record
  892.                  CodeTerminate,CodeResult : Word;
  893.                End;
  894.  
  895.   Procedure Exec(Path : PathStr;ComLine : ComStr);
  896.   Var
  897.     b : Array[0..255] of Char;
  898.     c : string;
  899.   Begin
  900.     if (length(comline)>0) and (comline[1] <> ' ') then
  901.        c := path + #0+' '+comline+#0+#0
  902.     else c := path + #0+comline+#0+#0;
  903.     DosError := DosExecPgm(b,256,ExecFlags,@c[1],Ptr(EnvironmentSeg,0),ExecResult,@c[1]);
  904.   End;
  905.  
  906.   Function DosExitCode : Word;
  907.   Begin
  908.     DosExitCode := ExecResult.CodeResult;
  909.   End;
  910.  
  911.   Procedure PlaySound(Frequency,Duration : Word);
  912.   Begin
  913.     DosBeep(Frequency,Duration);
  914.   End;
  915.  
  916.   Procedure DosInit;
  917.   Var
  918.     GlobalSel,LocalSel : Word;
  919.   Begin
  920.     If DosGetInfoSeg(GlobalSel,LocalSel) = 0 then
  921.       Begin
  922.         GlobalInfoSeg := Ptr(GlobalSel,0);
  923.         LocalInfoSeg  := Ptr(LocalSel,0);
  924.       End
  925.     else
  926.       Begin
  927.         GlobalInfoSeg := Nil;
  928.         LocalInfoSeg  := Nil;
  929.       End;
  930.   End;
  931.  
  932. Begin
  933.   DosInit;
  934. End.