Power-Programmierung/CD1.mdf/pascal/bp7os2/dos.pas

Pascal/Delphi Source File | 1993-12-30 | 29.6 KB | 934 lines

{*RG--*}
{$S-,R-,Q-,I-,B-}
{*--RG*}

Unit Dos;

{**********************************************************}
{                                                          }
{ BP4OS2: CRT Interface Unit                               }
{                                                          }
{         Portions of this file                            }
{         Copyright (C) 1988,92 Borland International      }
{         Used with permission                             }
{                                                          }
{----------------------------------------------------------}
{  Borland - Interface                                     }
{  Matthias Withopf / c't - limited Port to OS/2           }
{  Rohit Gupta  -  Completed DOS compatability             }
{  Rick Widmer - Added comments                            }
{**********************************************************}



{****************************************}
{                                        }
{      ***    ****   *****     *         }
{      *  *   *        *      * *        }
{      ***    ***      *      ***        }
{      *  *   *        *     *   *       }
{      ***    ****     *     *   *       }
{                                        }
{ Please report problems (and successes) }
{ on BPASCAL section 17. Prefix all      }
{ messages with BP4OS2.                  }
{                                        }
{ Internet: [e-mail]     }
{                                        }
{ NOTE:  Flags, Registers, MSDOS, INTR   }
{        GetIntVec and SetIntVec are     }
{        in Compatab.Pas                 }
{                                        }
{        The functions of Keep and       }
{        SwapVectors are not needed      }
{        with OS/2, they are not         }
{        supported.                      }
{                                        }
{        GetCBreak and SetCBreak have    }
{        not been needed yet, and are    }
{        not ported.                     }
{                                        }
{****************************************}

Interface

Const

{ File mode magic numbers }

  fmClosed = $D7B0;
  fmInput  = $D7B1;
  fmOutput = $D7B2;
  fmInOut  = $D7B3;


{ File attribute constants }

  ReadOnly  = $01;
  Hidden    = $02;
  SysFile   = $04;
  VolumeId  = $08;
  Directory = $10;
  Archive   = $20;
  AnyFile   = $37;

Type

{ String types }

  ComStr  = String[127];
  PathStr = String[79];
  DirStr  = String[67];
  NameStr = String[8];
  ExtStr  = String[4];

Type

{ Typed-file and untyped-file record }

  FileRec = Record
              Handle   : Word;
              Mode     : Word;
              RecSize  : Word;
              Private  : Array[1..26] of Byte;
              UserData : Array[1..16] of Byte;
              Name     : Array[0..79] of Char;
            End;

{ Textfile record }

  TextBuf = Array[0..127] of Char;
  TextRec = Record
              Handle    : Word;
              Mode      : Word;
              BufSize   : Word;
              Private   : Word;
              BufPos    : Word;
              BufEnd    : Word;
              BufPtr    : ^TextBuf;
              OpenFunc  : Pointer;
              InOutFunc : Pointer;
              FlushFunc : Pointer;
              CloseFunc : Pointer;
              UserData  : Array[1..16] of Byte;
              Name      : Array[0..79] of Char;
              Buffer    : TextBuf;
            End;


{ Search record used by FindFirst and FindNext }

  SearchRec = Record
                Fill : Array[1..21] of Byte;
                Attr : Byte;
                Time : LongInt;
                Size : LongInt;
                Name : String[12];
              End;


{ Date and time record used by PackTime and UnpackTime }

  DateTime = Record
               Year,Month,Day,Hour,Min,Sec : Word;
             End;



{*  MW  *}
  TPID = Word;
  TTID = Word;
  TSel = Word;

  PGlobalInfoSeg = ^TGlobalInfoSeg;
  TGlobalInfoSeg = Record
                     time                : LongInt;
                     msecs               : LongInt;
                     hour                : Byte;
                     minutes             : Byte;
                     seconds             : Byte;
                     hundredths          : Byte;
                     timezone            : Word;
                     cusecTimerInterval  : Word;
                     day                 : Byte;
                     month               : Byte;
                     year                : Word;
                     weekday             : Byte;
                     uchMajorVersion     : Byte;
                     uchMinorVersion     : Byte;
                     chRevisionLetter    : Byte;
                     sgCurrent           : Byte;
                     sgMax               : Byte;
                     cHugeShift          : Byte;
                     fProtectModeOnly    : Byte;
                     pidForeground       : Word;
                     fDynamicSched       : Byte;
                     csecMaxWait         : Byte;
                     cmsecMinSlice       : Word;
                     cmsecMaxSlice       : Word;
                     bootdrive           : Word;
                     amecRAS             : Array[1..32] of Byte;
                     csgWindowableVioMax : Byte;
                     csgPMMax            : Byte;
                   End;

  PLocalInfoSeg = ^TLocalInfoSeg;
  TLocalInfoSeg  = Record
                     pidCurrent          : TPID;
                     pidParent           : TPID;
                     prtyCurrent         : Word;
                     tidCurrent          : TTID;
                     sgCurrent           : Word;
                     rfProcStatus        : Byte;
                     dummy1              : Byte;
                     fForeground         : WordBool;
                     typeProcess         : Byte;
                     dummy2              : Byte;
                     selEnvironment      : TSel;
                     offCmdLine          : Word;
                     cbDataSegment       : Word;
                     cbStack             : Word;
                     cbHeap              : Word;
                     hmod                : Word;
                     selDS               : TSel;
                   End;

Const

  ExecFlags     : Word = 0;   { EXEC_SYNC }
{*  MW  *}

Var

{ Error status variable }

  DosError      : Integer;

{ MW   OS/2 Global Information Segment pointer }

  GlobalInfoSeg : PGlobalInfoSeg;

{ MW   OS/2 Local Information Segment pointer }

  LocalInfoSeg  : PLocalInfoSeg;

{ DosVersion returns the DOS version number. The low byte of    }
{ the result is the major version number, and the high byte is  }
{ the minor version number. For example, DOS 3.20 returns 3 in  }
{ the low byte, and 20 in the high byte.                        }

  Function  DosVersion : Word;

{ Intr executes a specified software interrupt with a specified }
{ Registers package.       ***  Moved to Compatib  ***          }

{ MsDos invokes the DOS function call handler with a specified  }
{ Registers package.       ***  Moved to Compatib  ***          }

{ GetDate returns the current date set in the operating system. }
{ Ranges of the values returned are: Year 1980-2099, Month      }
{ 1-12, Day 1-31 and DayOfWeek 0-6 (0 corresponds to Sunday).   }

  Procedure GetDate(Var Year,Month,Day,DayofWeek : Word);

{ SetDate sets the current date in the operating system. Valid  }
{ parameter ranges are: Year 1980-2099, Month 1-12 and Day      }
{ 1-31. If the date is not valid, the function call is ignored. }

  Procedure SetDate(Year,Month,Day : Word);

{ GetTime returns the current time set in the operating system. }
{ Ranges of the values returned are: Hour 0-23, Minute 0-59,    }
{ Second 0-59 and Sec100 (hundredths of seconds) 0-99.          }

  Procedure GetTime(Var Hour,Minute,Second,Sec100 : Word);

{ SetTime sets the time in the operating system. Valid          }
{ parameter ranges are: Hour 0-23, Minute 0-59, Second 0-59 and }
{ Sec100 (hundredths of seconds) 0-99. If the time is not       }
{ valid, the function call is ignored.                          }

  Procedure SetTime(Hour,Minute,Second,Sec100 : Word);

{ GetCBreak returns the state of Ctrl-Break checking in DOS.    }
{ When off (False), DOS only checks for Ctrl-Break during I/O   }
{ to console, printer, or communication devices. When on        }
{ (True), checks are made at every system call.                 }


{ SetCBreak sets the state of Ctrl-Break checking in DOS.       }


{ GetVerify returns the state of the verify flag in DOS. When   }
{ off (False), disk writes are not verified. When on (True),    }
{ all disk writes are verified to insure proper writing.        }

  Procedure GetVerify(Var Verify : Boolean);

{ SetVerify sets the state of the verify flag in DOS.           }

  Procedure SetVerify(Verify : Boolean);

{ DiskFree returns the number of free bytes on the specified    }
{ drive number (0=Default,1=A,2=B,..). DiskFree returns -1 if   }
{ the drive number is invalid.                                  }

  Function  DiskFree(Drive : Byte) : LongInt;

{ DiskSize returns the size in bytes of the specified drive     }
{ number (0=Default,1=A,2=B,..). DiskSize returns -1 if the     }
{ drive number is invalid.                                      }

  Function  DiskSize(Drive : Byte) : LongInt;

{ GetFAttr returns the attributes of a file. F must be a file   }
{ variable (typed, untyped or textfile) which has been assigned }
{ a name. The attributes are examined by ANDing with the        }
{ attribute masks defined as constants above. Errors are        }
{ reported in DosError.                                         }

  Procedure GetFAttr(Var f;Var Attr : Word);

{ SetFAttr sets the attributes of a file. F must be a file      }
{ variable (typed, untyped or textfile) which has been assigned }
{ a name. The attribute value is formed by adding (or ORing)    }
{ the appropriate attribute masks defined as constants above.   }
{ Errors are reported in DosError.                              }

  Procedure SetFAttr(Var f;Attr : Word);

{ GetFTime returns the date and time a file was last written.   }
{ F must be a file variable (typed, untyped or textfile) which  }
{ has been assigned and opened. The Time parameter may be       }
{ unpacked throgh a call to UnpackTime. Errors are reported in  }
{ DosError.                                                     }

  Procedure GetFTime(Var f;Var Time : LongInt);

{ SetFTime sets the date and time a file was last written.      }
{ F must be a file variable (typed, untyped or textfile) which  }
{ has been assigned and opened. The Time parameter may be       }
{ created through a call to PackTime. Errors are reported in    }
{ DosError.                                                     }

  Procedure SetFTime(Var f;Time : LongInt);

{ FindFirst searches the specified (or current) directory for   }
{ the first entry that matches the specified filename and       }
{ attributes. The result is returned in the specified search    }
{ record. Errors (and no files found) are reported in DosError. }

  Procedure FindFirst(Path : PathStr;Attr : Word;Var S : SearchRec);

{ FindNext returs the next entry that matches the name and      }
{ attributes specified in a previous call to FindFirst. The     }
{ search record must be one passed to FindFirst. Errors (and no }
{ more files) are reported in DosError.                         }

  Procedure FindNext(Var S : SearchRec);

{ UnpackTime converts a 4-byte packed date/time returned by     }
{ FindFirst, FindNext or GetFTime into a DateTime record.       }

  Procedure UnpackTime(P : LongInt;Var T : DateTime);

{ PackTime converts a DateTime record into a 4-byte packed      }
{ date/time used by SetFTime.                                   }

  Procedure PackTime(Var T : DateTime;Var P : LongInt);

{ GetIntVec returns the address stored in the specified         }
{ interrupt vector.         ***  Moved to Compatib  ***         }


{ SetIntVec sets the address in the interrupt vector table for  }
{ the specified interrupt.  ***  Moved to Compatib  ***         }


{ FSearch searches for the file given by Path in the list of    }
{ directories given by DirList. The directory paths in DirList  }
{ must be separated by semicolons. The search always starts     }
{ with the current directory of the current drive. The returned }
{ value is a concatenation of one of the directory paths and    }
{ the file name, or an empty string if the file could not be    }
{ located.                                                      }

  Function  FSearch(Path : PathStr;DirList : String) : PathStr;

{ FExpand expands the file name in Path into a fully qualified  }
{ file name. The resulting name consists of a drive letter, a   }
{ colon, a root relative directory path, and a file name.       }
{ Embedded '.' and '..' directory references are removed.       }

  Function  FExpand(Path : PathStr) : PathStr;

{ FSplit splits the file name specified by Path into its three  }
{ components. Dir is set to the drive and directory path with   }
{ any leading and trailing backslashes, Name is set to the file }
{ name, and Ext is set to the extension with a preceding dot.   }
{ Each of the component strings may possibly be empty, if Path  }
{ contains no such component.                                   }

  Procedure FSplit(Path : PathStr;Var Dir : DirStr;Var Name : NameStr;Var Ext : ExtStr);

{ EnvCount returns the number of strings contained in the DOS   }
{ environment.                                                  }

  Function  EnvCount : Integer;

{ EnvStr returns a specified environment string. The returned   }
{ string is of the form "VAR=VALUE". The index of the first     }
{ string is one. If Index is less than one or greater than      }
{ EnvCount, EnvStr returns an empty string.                     }

  Function  EnvStr(Index : Integer) : String;

{ GetEnv returns the value of a specified environment variable. }
{ The variable name can be in upper or lower case, but it must  }
{ not include the '=' character. If the specified environment   }
{ variable does not exist, GetEnv returns an empty string.      }

  Function  GetEnv(EnvVar : String) : String;

{ SwapVectors swaps the contents of the SaveIntXX pointers in   }
{ the System unit with the current contents of the interrupt    }
{ vectors. SwapVectors is typically called just before and just }
{ after a call to Exec. This insures that the Exec'd process    }
{ does not use any interrupt handlers installed by the current  }
{ process, and vice versa.                                      }
{                                                               }
{**                                                           **}
{**   SwapVectors is no longer needed.  Exec starts a separate**}
{** session that does not depend on the machine state, or use **}
{** any memory of this session.                               **}
{**                                                           **}

{ Keep (or Terminate Stay Resident) terminates the program and  }
{ makes it stay in memory. The entire program stays in memory,  }
{ including data segment, stack segment, and heap. The ExitCode }
{ corresponds to the one passed to the Halt standard procedure. }
{                                                               }
{**                                                           **}
{**    OS/2 makes the whole idea of TSR programs obsolete.    **}
{**  this procedure is no longer supported.                   **}
{**                                                           **}

{ Exec executes another program. The program is specified by    }
{ the Path parameter, and the command line is specified by the  }
{ CmdLine parameter. To execute a DOS internal command, run     }
{ COMMAND.COM, e.g. "Exec('\COMMAND.COM','/C DIR *.PAS');".     }
{ Note the /C in front of the command. Errors are reported in   }
{ DosError. When compiling a program that uses Exec, be sure    }
{ to specify a maximum heap size as there will otherwise not be }
{ enough memory.                                                }

  Procedure Exec(Path : PathStr;ComLine : ComStr);

{ DosExitCode returns the exit code of a sub-process. The low   }
{ byte is the code sent by the terminating process. The high    }
{ byte is zero for normal termination, 1 if terminated by       }
{ Ctrl-C, 2 if terminated due to a device error, or 3 if        }
{ terminated by the Keep procedure (function call 31 hex).      }

  Function  DosExitCode : Word;


  Procedure PlaySound(Frequency,Duration : Word);

Implementation

Type
  OS2DateTime = Record
                  Hours,
                  Minutes,
                  Seconds,
                  Hundredths,
                  Day,
                  Month        : Byte;
                  Year         : Word;
                  TimeZone     : Integer;
                  WeekDay      : Byte;
                End;

  OS2FSAllocate = Record
                    idFileSystem : LongInt;
                    cSectorUnit  : LongInt;
                    cUnit        : LongInt;
                    cUnitAvail   : LongInt;
                    cbSector     : Word;
                  End;

  OS2FileStatus = Record
                    fDateCreation   : Word;
                    fTimeCreation   : Word;
                    fDateLastAccess : Word;
                    fTimeLastAccess : Word;
                    fDateLastWrite  : Word;
                    fTimeLastWrite  : Word;
                    cbFile          : LongInt;
                    cbFileAlloc     : LongInt;
                    AttrFile        : Word;
                  End;

  OS2FileFindBuf = Record
                    fDateCreation   : Word;
                    fTimeCreation   : Word;
                    fDateLastAccess : Word;
                    fTimeLastAccess : Word;
                    fDateLastWrite  : Word;
                    fTimeLastWrite  : Word;
                    cbFile          : LongInt;
                    cbFileAlloc     : LongInt;
                    AttrFile        : Word;
                    cchName         : Byte;
                    achName         : Array[0..12] of Char;
                   End;

  Function DosGetInfoSeg(Var GlobalSeg,LocalSeg : TSel) : Word; Far;
    External 'DOSCALLS' Index $08;
  Function DosSetDateTime(Var DateTime : OS2DateTime) : Word; Far;
    External 'DOSCALLS' Index $1C;
  Function DosGetDateTime(Var DateTime : OS2DateTime) : Word; Far;
    External 'DOSCALLS' Index $21;
  Function DosBeep(Freq,Durat : Word) : Word; Far;
    External 'DOSCALLS' Index $32;
  Function DosFindClose(DirHandle : Word) : Word; Far;
    External 'DOSCALLS' Index $3F;
  Function DosFindFirst(PathName : PChar;Var DirHandle : Word;Attrib : Word;Var FindBuf;BufLen : Word;
                        Var SearchCount : Word;Reserved : LongInt) : Word; Far;
    External 'DOSCALLS' Index $40;
  Function DosFindNext(DirHandle : Word;Var FindBuf;BufLen : Word;Var SearchCount : Word) : Word; Far;
    External 'DOSCALLS' Index $41;
  Function DosQFileInfo(Handle : Word;InfoLevel : Word;Var Info;InfoLen : Word) : Word; Far;
    External 'DOSCALLS' Index $4A;
  Function DosQFileMode(Name : PChar;Var Attrib : Word;Reserved : LongInt) : Word; Far;
    External 'DOSCALLS' Index $4B;
  Function DosQFSInfo(DriveNo : Word;InfoLevel : Word;Var Info;InfoLen : Word) : Word; Far;
    External 'DOSCALLS' Index $4C;
  Function DosQVerify(Var Verify : Word) : Word; Far;
    External 'DOSCALLS' Index $4E;
  Function DosSetFileInfo(Handle : Word;InfoLevel : Word;Var Info;InfoLen : Word) : Word; Far;
    External 'DOSCALLS' Index $53;
  Function DosSetFileMode(Name : PChar;Attrib : Word;Reserved : LongInt) : Word; Far;
    External 'DOSCALLS' Index $54;
  Function DosSetVerify(Verify : Word) : Word; Far;
    External 'DOSCALLS' Index $56;
  Function DosGetVersion(Var Version : Word) : Word; Far;
    External 'DOSCALLS' Index $5C;
  Function DosExecPgm(Var FailBuf;FailBufLen : Word;Flags : Word;Args : PChar;Env : PChar;
                      Var Result;ExecName : PChar) : Word; Far;
    External 'DOSCALLS' Index $90;

  Function DosVersion : Word;
  Var
    Version : Word;
  Begin
    DosError := DosGetVersion(Version);
    If DosError = 0 then
      DosVersion := Version
    else
      DosVersion := 0;
  End;

  Procedure GetDate(Var Year,Month,Day,DayofWeek : Word);
  Var
    DT : OS2DateTime;
  Begin
    DosError := DosGetDateTime(DT);
    If DosError = 0 then
      Begin
        Year      := DT.Year;
        Month     := DT.Month;
        Day       := DT.Day;
        DayOfWeek := DT.WeekDay;
      End
    else
      Begin
        Year      := 0;
        Month     := 0;
        Day       := 0;
        DayOfWeek := 0;
      End;
  End;

{*RG--*}
  Procedure SetDate(Year,Month,Day : Word);
  Var
    DT : OS2DateTime;
  Begin
    DosError := DosGetDateTime(DT);
    If DosError = 0 then
      Begin
        DT.Year    := Year;
        DT.Month   := Month;
        DT.Day     := Day;
        DT.WeekDay := 0;            {  Day Of Week  }
        DosSetDateTime(DT);
      End;
  End;
{*--RG*}

  Procedure GetTime(Var Hour,Minute,Second,Sec100 : Word);
  Var
    DT : OS2DateTime;
  Begin
    DosError := DosGetDateTime(DT);
    If DosError = 0 then
      Begin
        Hour   := DT.Hours;
        Minute := DT.Minutes;
        Second := DT.Seconds;
        Sec100 := DT.Hundredths;
      End
    else
      Begin
        Hour   := 0;
        Minute := 0;
        Second := 0;
        Sec100 := 0;
      End;
  End;

  Procedure SetTime(Hour,Minute,Second,Sec100 : Word);
  Var
    DT : OS2DateTime;
  Begin
    DosError := DosGetDateTime(DT);
    If DosError = 0 then
      Begin
        DT.Hours      := Hour;
        DT.Minutes    := Minute;
        DT.Seconds    := Second;
        DT.Hundredths := Sec100;
        DosSetDateTime(DT);
      End;
  End;

  Procedure GetVerify(Var Verify : Boolean);
  Var
    V : Word;
  Begin
    DosError := DosQVerify(V);
    If DosError = 0 then
      Verify := Boolean(V)
    else
      Verify := False;
  End;

  Procedure SetVerify(Verify : Boolean);
  Begin
    DosError := DosSetVerify(Word(Verify));
  End;

  Function DiskFree(Drive : Byte) : LongInt;
  Var
    FI : OS2FSAllocate;
  Begin
    DosError := DosQFSInfo(Drive,1,FI,sizeof(FI));
    If DosError = 0 then
      DiskFree := FI.cUnitAvail * FI.cSectorUnit * FI.cbSector
    else
      DiskFree := -1;
  End;

  Function DiskSize(Drive : Byte) : LongInt;
  Var
    FI : OS2FSAllocate;
  Begin
    DosError := DosQFSInfo(Drive,1,FI,sizeof(FI));
    If DosError = 0 then
      DiskSize := FI.cUnit * FI.cSectorUnit * FI.cbSector
    else
      DiskSize := -1;
  End;

  Procedure GetFAttr(Var f;Var Attr : Word);
  Var
    A : Word;
  Begin
    DosError := DosQFileMode(FileRec(f).Name,A,0);
    If DosError = 0 then
      Attr := A
    else
      Attr := 0;
  End;

  Procedure SetFAttr(Var f;Attr : Word);
  Begin
    DosError := DosSetFileMode(FileRec(f).Name,Attr,0);
  End;

  Procedure GetFTime(Var f;Var Time : LongInt);
  Var
    FI : OS2FileStatus;
    T1 : Record
           Time,Date : Word;
         End Absolute Time;
  Begin
    DosError := DosQFileInfo(FileRec(f).Handle,1,FI,SizeOf(FI));
    If DosError = 0 then
      Begin
        T1.Time := FI.fTimeLastWrite;
        T1.Date := FI.fDateLastWrite;
      End
    else
      Begin
        T1.Time := 0;
        T1.Date := 0;
      End;
  End;

  Procedure SetFTime(Var f;Time : LongInt);
  Var
    FI : OS2FileStatus;
    T1 : Record
           Time,Date : Word;
         End Absolute Time;
  Begin
    DosError := DosQFileInfo(FileRec(f).Handle,1,FI,SizeOf(FI));
    If DosError = 0 then
      Begin
        FI.fTimeLastWrite := T1.Time;
        FI.fDateLastWrite := T1.Date;
        DosError := DosSetFileInfo(FileRec(f).Handle,1,FI,SizeOf(FI));
      End;
  End;

  Procedure FindFirst(Path : PathStr;Attr : Word;Var S : SearchRec);
  Var
    FF    : OS2FileFindBuf;
    N     : String;
    Count : Word;
  Type
    PWord = ^Word;
  Begin
    N := Path + #0;
    Count := 1;
    PWord(@S)^ := $FFFF; { HDIR_CREATE }
    DosError := DosFindFirst(@N[1],PWord(@S)^,Attr,FF,SizeOf(FF),Count,0);
    If DosError = 0 then
      Begin
        S.Attr := FF.AttrFile;
        S.Time := (LongInt(FF.fDateLastWrite) Shl 16) + FF.fTimeLastWrite;
        S.Size := FF.cbFile;
        Move(FF.cchName,S.Name,SizeOf(S.Name))
      End;
  End;

  Procedure FindNext(Var S : SearchRec);
  Var
    FF    : OS2FileFindBuf;
    Count : Word;
  Type
    PWord = ^Word;
  Begin
    Count := 1;
    DosError := DosFindNext(PWord(@S)^,FF,SizeOf(FF),Count);
    If DosError = 0 then
      Begin
        S.Attr := FF.AttrFile;
        S.Time := (LongInt(FF.fDateLastWrite) Shl 16) + FF.fTimeLastWrite;
        S.Size := FF.cbFile;
        Move(FF.cchName,S.Name,SizeOf(S.Name))
      End
    else
      DosFindClose(PWord(@S)^);
  End;

  Procedure PackTime(Var T : DateTime;Var P : LongInt);
  Var
    P1 : Record
           Time,Date : Word;
         End Absolute P;
  Begin
    P1.Date := (T.Year - 1980) Shl 9 + T.Month Shl 5 + T.Day;
    P1.Time := T.Hour Shl 11 + T.Min Shl 5 + T.Sec Shr 1;
  End;

  Procedure UnpackTime(P : LongInt;Var T : DateTime);
  Var
    P1 : Record
           Time,Date : Word;
         End Absolute P;
  Begin
    T.Year  := P1.Date Shr 9 + 1980;
    T.Month := (P1.Date Shr 5) And 15;
    T.Day   := P1.Date And 31;
    T.Hour  := P1.Time Shr 11;
    T.Min   := (P1.Time Shr 5) And 63;
    T.Sec   := (P1.Time And 31) Shl 1;
  End;

  Function FSearch(Path : PathStr;DirList : String) : PathStr;
  Var
    Name   : String;
    Attrib : Word;
    p      : Byte;
  Begin
    FSearch := '';
    Name := Path;
    Repeat
      Name := Name + #0;
      DosError := DosQFileMode(@Name[1],Attrib,0);
      If (DosError = 0) and ((Attrib And $18) = 0) then
        Begin
          FSearch := Copy(Name,1,Length(Name) - 1);
          Break;
        End
      else
        Begin
          If DirList = '' then Break;
          p := Pos(';',DirList);
          If p <> 0 then
            Begin
              Name := Copy(DirList,1,p - 1) + '\' + Path;
              DirList := Copy(DirList,p + 1,255);
            End
          else
            Begin
              Name := DirList + '\' + Path;
              DirList := '';
            End;
        End;
    Until False;
  End;

  Function FExpand(Path : PathStr) : PathStr;
  Var
    s : String;
  Begin
    GetDir(0,s);
    If s <> '' then
      If s[Length(s) - 1] <> '\' then
        s := s + '\';
    FExpand := s + Path;
  End;

  Procedure FSplit(Path : PathStr;Var Dir : DirStr;Var Name : NameStr;Var Ext : ExtStr);
  Var
    l : Integer;
  Begin
    l := Length(Path);
    While Not(Path[l] in ['\',':']) and (l > 0) do Dec(l);
    Dir := Copy(Path,1,l);
    Path := Copy(Path,l + 1,255);
    l := Pos('.',Path);
    If l <> 0 then
      Begin
        Name := Copy(Path,1,l - 1);
        Ext  := Copy(Path,l,4);
      End
    else
      Begin
        Name := Path;
        Ext  := '';
      End;
  End;

  Function EnvCount : Integer;
  Var
    p   : PChar;
    i,l : Integer;
  Begin
    p := Ptr(EnvironmentSeg,0);
    i := 0;
    Repeat
      l := 0;
      While p^ <> #0 do
        Begin
          Inc(l); Inc(p);
        End;
      Inc(p);
      If l = 0 then Break;
      Inc(i);
    Until False;
    EnvCount := i;
  End;

  Function EnvStr(Index : Integer) : String;
  Var
    p : PChar;
    s : String;
    i : Integer;
  Begin
    p := Ptr(EnvironmentSeg,0);
    s := '';
    For i := 1 to Index do
      Begin
        s := '';
        While p^ <> #0 do
          Begin
            s := s + p^; Inc(p);
          End;
        Inc(p);
        If s = '' then Break;
      End;
    EnvStr := s;
  End;

  Function GetEnv(EnvVar : String) : String;
  Var
    Count,i : Integer;
    s       : String;
    p       : Byte;
  Begin
    Count := EnvCount;
    For i := 1 to Count do
      Begin
        s := EnvStr(i);
        p := Pos('=',s);
        If p <> 0 then
          If Copy(s,1,p - 1) = EnvVar then
            Begin
              GetEnv := Copy(s,p + 1,255);
              Exit;
            End;
      End;
    GetEnv := '';
  End;

Var
  ExecResult : Record
                 CodeTerminate,CodeResult : Word;
               End;

  Procedure Exec(Path : PathStr;ComLine : ComStr);
  Var
    b : Array[0..255] of Char;
    c : string;
  Begin
    if (length(comline)>0) and (comline[1] <> ' ') then
       c := path + #0+' '+comline+#0+#0
    else c := path + #0+comline+#0+#0;
    DosError := DosExecPgm(b,256,ExecFlags,@c[1],Ptr(EnvironmentSeg,0),ExecResult,@c[1]);
  End;

  Function DosExitCode : Word;
  Begin
    DosExitCode := ExecResult.CodeResult;
  End;

  Procedure PlaySound(Frequency,Duration : Word);
  Begin
    DosBeep(Frequency,Duration);
  End;

  Procedure DosInit;
  Var
    GlobalSel,LocalSel : Word;
  Begin
    If DosGetInfoSeg(GlobalSel,LocalSel) = 0 then
      Begin
        GlobalInfoSeg := Ptr(GlobalSel,0);
        LocalInfoSeg  := Ptr(LocalSel,0);
      End
    else
      Begin
        GlobalInfoSeg := Nil;
        LocalInfoSeg  := Nil;
      End;
  End;

Begin
  DosInit;
End.