home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / bpos2api.zip / DOS.PAS < prev    next >
Pascal/Delphi Source File  |  1993-11-17  |  12KB  |  490 lines
  1. Unit Dos;
  2.  
  3. Interface
  4.  
  5. uses
  6.   DosTypes;
  7.  
  8. Const
  9.   fmClosed = $D7B0;
  10.   fmInput  = $D7B1;
  11.   fmOutput = $D7B2;
  12.   fmInOut  = $D7B3;
  13.  
  14. Const
  15.   ReadOnly  = $01;
  16.   Hidden    = $02;
  17.   SysFile   = $04;
  18.   VolumeID  = $08;
  19.   Directory = $10;
  20.   Archive   = $20;
  21.   AnyFile   = $37;
  22.  
  23. Type
  24.   ComStr  = String[127];
  25.   PathStr = String[79];
  26.   DirStr  = String[67];
  27.   NameStr = String[8];
  28.   ExtStr  = String[4];
  29.  
  30. Type
  31.   FileRec = Record
  32.               Handle   : Word;
  33.               Mode     : Word;
  34.               RecSize  : Word;
  35.               Private  : Array[1..26] of Byte;
  36.               UserData : Array[1..16] of Byte;
  37.               Name     : Array[0..79] of Char;
  38.             End;
  39. Type
  40.   TextBuf = Array[0..127] of Char;
  41.   TextRec = Record
  42.               Handle    : Word;
  43.               Mode      : Word;
  44.               BufSize   : Word;
  45.               Private   : Word;
  46.               BufPos    : Word;
  47.               BufEnd    : Word;
  48.               BufPtr    : ^TextBuf;
  49.               OpenFunc  : Pointer;
  50.               InOutFunc : Pointer;
  51.               FlushFunc : Pointer;
  52.               CloseFunc : Pointer;
  53.               UserData  : Array[1..16] of Byte;
  54.               Name      : Array[0..79] of Char;
  55.               Buffer    : TextBuf;
  56.             End;
  57.  
  58. Type
  59.   SearchRec = Record
  60.                 Fill : Array[1..21] of Byte;
  61.                 Attr : Byte;
  62.                 Time : LongInt;
  63.                 Size : LongInt;
  64.                 Name : String[12];
  65.               End;
  66.   DateTime = record
  67.     Year,Month,Day,Hour,Min,Sec: Word;
  68.   end;
  69.  
  70. Const
  71.   ExecFlags     : Word = 0;   { EXEC_SYNC }
  72.  
  73. Var
  74.   DosError      : Integer;
  75.   GlobalInfoSeg : PGlobalInfoSeg;
  76.   LocalInfoSeg  : PLocalInfoSeg;
  77.  
  78.   Function  DosVersion : Word;
  79.   Procedure GetDate(Var Year,Month,Day,DayofWeek : Word);
  80.   Procedure SetDate(Year,Month,Day : Word);
  81.   Procedure GetTime(Var Hour,Minute,Second,Sec100 : Word);
  82.   Procedure SetTime(Hour,Minute,Second,Sec100 : Word);
  83.   Procedure GetVerify(Var Verify : Boolean);
  84.   Procedure SetVerify(Verify : Boolean);
  85.   Function  DiskFree(Drive : Byte) : LongInt;
  86.   Function  DiskSize(Drive : Byte) : LongInt;
  87.   Procedure GetFAttr(Var f;Var Attr : Word);
  88.   Procedure SetFAttr(Var f;Attr : Word);
  89.   Procedure GetFTime(Var f;Var Time : LongInt);
  90.   Procedure SetFTime(Var f;Time : LongInt);
  91.   Procedure FindFirst(Path : PathStr;Attr : Word;Var S : SearchRec);
  92.   Procedure FindNext(Var S : SearchRec);
  93.   Procedure PackTime(Var T : DateTime;Var P : LongInt);
  94.   Procedure UnpackTime(P : LongInt;Var T : DateTime);
  95.   Function  FSearch(Path : PathStr;DirList : String) : PathStr;
  96.   Function  FExpand(Path : PathStr) : PathStr;
  97.   Procedure FSplit(Path : PathStr;Var Dir : DirStr;Var Name : NameStr;Var Ext : ExtStr);
  98.   Function  EnvCount : Integer;
  99.   Function  EnvStr(Index : Integer) : String;
  100.   Function  GetEnv(EnvVar : String) : String;
  101.   Procedure Exec(Path : PathStr;ComLine : ComStr);
  102.   Function  DosExitCode : Word;
  103.   Procedure PlaySound(Frequency,Duration : Word);
  104.  
  105. Implementation
  106.  
  107. uses
  108.   DosProcs;
  109.  
  110.   Function DosVersion : Word;
  111.   Var
  112.     Version : Word;
  113.   Begin
  114.     DosGetVersion(Version);
  115.     DosVersion := Version;
  116.   End;
  117.  
  118.   Procedure GetDate(Var Year,Month,Day,DayofWeek : Word);
  119.   Var
  120.     DT : TDateTime;
  121.   Begin
  122.     DosGetDateTime(DT);
  123.     Year      := DT.Year;
  124.     Month     := DT.Month;
  125.     Day       := DT.Day;
  126.     DayOfWeek := DT.WeekDay;
  127.   End;
  128.  
  129.   Procedure SetDate(Year,Month,Day : Word);
  130.   Var
  131.     DT : TDateTime;
  132.   Begin
  133.     DosGetDateTime(DT);
  134.     If DosError = 0 then
  135.       Begin
  136.         DT.Year    := Year;
  137.         DT.Month   := Month;
  138.         DT.Day     := Day;
  139.         DosSetDateTime(DT);
  140.       End;
  141.   End;
  142.  
  143.   Procedure GetTime(Var Hour,Minute,Second,Sec100 : Word);
  144.   Var
  145.     DT : TDateTime;
  146.   Begin
  147.     DosGetDateTime(DT);
  148.     Hour   := DT.Hours;
  149.     Minute := DT.Minutes;
  150.     Second := DT.Seconds;
  151.     Sec100 := DT.Hundredths;
  152.   End;
  153.  
  154.   Procedure SetTime(Hour,Minute,Second,Sec100 : Word);
  155.   Var
  156.     DT : TDateTime;
  157.   Begin
  158.     DosGetDateTime(DT);
  159.     DT.Hours      := Hour;
  160.     DT.Minutes    := Minute;
  161.     DT.Seconds    := Second;
  162.     DT.Hundredths := Sec100;
  163.     DosSetDateTime(DT);
  164.   End;
  165.  
  166.   Procedure GetVerify(Var Verify : Boolean);
  167.   Var
  168.     V : Word;
  169.   Begin
  170.     DosError := DosQVerify(V);
  171.     If DosError = 0 then
  172.       Verify := Boolean(V)
  173.     else
  174.       Verify := False;
  175.   End;
  176.  
  177.   Procedure SetVerify(Verify : Boolean);
  178.   Begin
  179.     DosError := DosSetVerify(Verify);
  180.   End;
  181.  
  182.   Function DiskFree(Drive : Byte) : LongInt;
  183.   Var
  184.     FI : TFSAllocate;
  185.   Begin
  186.     DosError := DosQFSInfo(Drive,1,FI,sizeof(FI));
  187.     If DosError = 0 then
  188.       DiskFree := FI.cUnitAvail * FI.cSectorUnit * FI.cbSector
  189.     else
  190.       DiskFree := -1;
  191.   End;
  192.  
  193.   Function DiskSize(Drive : Byte) : LongInt;
  194.   Var
  195.     FI : TFSAllocate;
  196.   Begin
  197.     DosError := DosQFSInfo(Drive,1,FI,sizeof(FI));
  198.     If DosError = 0 then
  199.       DiskSize := FI.cUnit * FI.cSectorUnit * FI.cbSector
  200.     else
  201.       DiskSize := -1;
  202.   End;
  203.  
  204.   Procedure GetFAttr(Var f;Var Attr : Word);
  205.   Var
  206.     A : Word;
  207.   Begin
  208.     DosError := DosQFileMode(FileRec(f).Name,A,0);
  209.     If DosError = 0 then
  210.       Attr := A
  211.     else
  212.       Attr := 0;
  213.   End;
  214.  
  215.   Procedure SetFAttr(Var f;Attr : Word);
  216.   Begin
  217.     DosError := DosSetFileMode(FileRec(f).Name,Attr,0);
  218.   End;
  219.  
  220.   Procedure GetFTime(Var f;Var Time : LongInt);
  221.   Var
  222.     FI : TFileStatus;
  223.     T1 : Record
  224.            Time,Date : Word;
  225.          End Absolute Time;
  226.   Begin
  227.     DosError := DosQFileInfo(FileRec(f).Handle,1,FI,SizeOf(FI));
  228.     If DosError = 0 then
  229.       Begin
  230.         T1.Time := FI.fTimeLastWrite;
  231.         T1.Date := FI.fDateLastWrite;
  232.       End
  233.     else
  234.       Begin
  235.         T1.Time := 0;
  236.         T1.Date := 0;
  237.       End;
  238.   End;
  239.  
  240.   Procedure SetFTime(Var f;Time : LongInt);
  241.   Var
  242.     FI : TFileStatus;
  243.     T1 : Record
  244.            Time,Date : Word;
  245.          End Absolute Time;
  246.   Begin
  247.     DosError := DosQFileInfo(FileRec(f).Handle,1,FI,SizeOf(FI));
  248.     If DosError = 0 then
  249.       Begin
  250.         FI.fTimeLastWrite := T1.Time;
  251.         FI.fDateLastWrite := T1.Date;
  252.         DosError := DosSetFileInfo(FileRec(f).Handle,1,FI,SizeOf(FI));
  253.       End;
  254.   End;
  255.  
  256.   Procedure FindFirst(Path : PathStr;Attr : Word;Var S : SearchRec);
  257.   Var
  258.     FF    : TFileFindBuf;
  259.     N     : String;
  260.     Count : Word;
  261.   Type
  262.     PWord = ^Word;
  263.   Begin
  264.     N := Path + #0;
  265.     Count := 1;
  266.     PWord(@S)^ := $FFFF; { HDIR_CREATE }
  267.     DosError := DosFindFirst(@N[1],PWord(@S)^,Attr,FF,SizeOf(FF),Count,0);
  268.     If DosError = 0 then
  269.       Begin
  270.         S.Attr := FF.AttrFile;
  271.         S.Time := (LongInt(FF.fDateLastWrite) Shl 16) + FF.fTimeLastWrite;
  272.         S.Size := FF.cbFileAlloc;
  273.         Move(FF.cchName,S.Name,SizeOf(S.Name))
  274.       End;
  275.   End;
  276.  
  277.   Procedure FindNext(Var S : SearchRec);
  278.   Var
  279.     FF    : TFileFindBuf;
  280.     Count : Word;
  281.   Type
  282.     PWord = ^Word;
  283.   Begin
  284.     Count := 1;
  285.     DosError := DosFindNext(PWord(@S)^,FF,SizeOf(FF),Count);
  286.     If DosError = 0 then
  287.       Begin
  288.         S.Attr := FF.AttrFile;
  289.         S.Time := (LongInt(FF.fDateLastWrite) Shl 16) + FF.fTimeLastWrite;
  290.         S.Size := FF.cbFileAlloc;
  291.         Move(FF.cchName,S.Name,SizeOf(S.Name))
  292.       End
  293.     else
  294.       DosFindClose(PWord(@S)^);
  295.   End;
  296.  
  297.   Procedure PackTime(Var T : DateTime;Var P : LongInt);
  298.   Var
  299.     P1 : Record
  300.            Time,Date : Word;
  301.          End Absolute P;
  302.   Begin
  303.     P1.Date := (T.Year - 1980) Shl 9 + T.Month Shl 5 + T.Day;
  304.     P1.Time := T.Hour Shl 11 + T.Min Shl 5 + T.Sec Shr 1;
  305.   End;
  306.  
  307.   Procedure UnpackTime(P : LongInt;Var T : DateTime);
  308.   Var
  309.     P1 : Record
  310.            Time,Date : Word;
  311.          End Absolute P;
  312.   Begin
  313.     T.Year  := P1.Date Shr 9 + 1980;
  314.     T.Month := (P1.Date Shr 5) And 15;
  315.     T.Day   := P1.Date And 31;
  316.     T.Hour  := P1.Time Shr 11;
  317.     T.Min   := (P1.Time Shr 5) And 63;
  318.     T.Sec   := (P1.Time And 31) Shl 1;
  319.   End;
  320.  
  321.   Function FSearch(Path : PathStr;DirList : String) : PathStr;
  322.   Var
  323.     Name   : String;
  324.     Attrib : Word;
  325.     p      : Byte;
  326.   Begin
  327.     FSearch := '';
  328.     Name := Path;
  329.     Repeat
  330.       Name := Name + #0;
  331.       DosError := DosQFileMode(@Name[1],Attrib,0);
  332.       If (DosError = 0) and ((Attrib And $18) = 0) then
  333.         Begin
  334.           FSearch := Copy(Name,1,Length(Name) - 1);
  335.           Break;
  336.         End
  337.       else
  338.         Begin
  339.           If DirList = '' then Break;
  340.           p := Pos(';',DirList);
  341.           If p <> 0 then
  342.             Begin
  343.               Name := Copy(DirList,1,p - 1) + '\' + Path;
  344.               DirList := Copy(DirList,p + 1,255);
  345.             End
  346.           else
  347.             Begin
  348.               Name := DirList + '\' + Path;
  349.               DirList := '';
  350.             End;
  351.         End;
  352.     Until False;
  353.   End;
  354.  
  355.   Function FExpand(Path : PathStr) : PathStr;
  356.   Var
  357.     s : String;
  358.   Begin
  359.     GetDir(0,s);
  360.     If s <> '' then
  361.       If s[Length(s) - 1] <> '\' then
  362.         s := s + '\';
  363.     FExpand := s + Path;
  364.   End;
  365.  
  366.   Procedure FSplit(Path : PathStr;Var Dir : DirStr;Var Name : NameStr;Var Ext : ExtStr);
  367.   Var
  368.     l : Integer;
  369.   Begin
  370.     l := Length(Path);
  371.     While Not(Path[l] in ['\',':']) and (l > 0) do Dec(l);
  372.     Dir := Copy(Path,1,l);
  373.     Path := Copy(Path,l + 1,255);
  374.     l := Pos('.',Path);
  375.     If l <> 0 then
  376.       Begin
  377.         Name := Copy(Path,1,l - 1);
  378.         Ext  := Copy(Path,l,4);
  379.       End
  380.     else
  381.       Begin
  382.         Name := Path;
  383.         Ext  := '';
  384.       End;
  385.   End;
  386.  
  387.   Function EnvCount : Integer;
  388.   Var
  389.     p   : PChar;
  390.     i,l : Integer;
  391.   Begin
  392.     p := Ptr(EnvironmentSeg,0);
  393.     i := 0;
  394.     Repeat
  395.       l := 0;
  396.       While p^ <> #0 do
  397.         Begin
  398.           Inc(l); Inc(p);
  399.         End;
  400.       Inc(p);
  401.       If l = 0 then Break;
  402.       Inc(i);
  403.     Until False;
  404.     EnvCount := i;
  405.   End;
  406.  
  407.   Function EnvStr(Index : Integer) : String;
  408.   Var
  409.     p : PChar;
  410.     s : String;
  411.     i : Integer;
  412.   Begin
  413.     p := Ptr(EnvironmentSeg,0);
  414.     s := '';
  415.     For i := 1 to Index do
  416.       Begin
  417.         s := '';
  418.         While p^ <> #0 do
  419.           Begin
  420.             s := s + p^; Inc(p);
  421.           End;
  422.         Inc(p);
  423.         If s = '' then Break;
  424.       End;
  425.     EnvStr := s;
  426.   End;
  427.  
  428.   Function GetEnv(EnvVar : String) : String;
  429.   Var
  430.     Count,i : Integer;
  431.     s       : String;
  432.     p       : Byte;
  433.   Begin
  434.     Count := EnvCount;
  435.     For i := 1 to Count do
  436.       Begin
  437.         s := EnvStr(i);
  438.         p := Pos('=',s);
  439.         If p <> 0 then
  440.           If Copy(s,1,p - 1) = EnvVar then
  441.             Begin
  442.               GetEnv := Copy(s,p + 1,255);
  443.               Exit;
  444.             End;
  445.       End;
  446.     GetEnv := '';
  447.   End;
  448.  
  449. Var
  450.   ExecResult : TResultCodes;
  451.  
  452.   Procedure Exec(Path : PathStr;ComLine : ComStr);
  453.   Var
  454.     b : Array[0..255] of Char;
  455.   Begin
  456.     Path := Path + #0;
  457.     ComLine := ComLine + #0#0;
  458.     DosError := DosExecPgm(b,256,ExecFlags,@ComLine[1],Ptr(EnvironmentSeg,0),ExecResult,@Path[1]);
  459.   End;
  460.  
  461.   Function DosExitCode : Word;
  462.   Begin
  463.     DosExitCode := ExecResult.CodeResult;
  464.   End;
  465.  
  466.   Procedure PlaySound(Frequency,Duration : Word);
  467.   Begin
  468.     DosBeep(Frequency,Duration);
  469.   End;
  470.  
  471.   Procedure DosInit;
  472.   Var
  473.     GlobalSel,LocalSel : Word;
  474.   Begin
  475.     If DosGetInfoSeg(GlobalSel,LocalSel) = 0 then
  476.       Begin
  477.         GlobalInfoSeg := Ptr(GlobalSel,0);
  478.         LocalInfoSeg  := Ptr(LocalSel,0);
  479.       End
  480.     else
  481.       Begin
  482.         GlobalInfoSeg := Nil;
  483.         LocalInfoSeg  := Nil;
  484.       End;
  485.   End;
  486.  
  487. Begin
  488.   DosInit;
  489. End.
  490.