home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / bpos2tv.zip / DOS.PAS < prev    next >
Pascal/Delphi Source File  |  1994-02-18  |  13KB  |  574 lines
  1. Unit Dos;
  2.  
  3. Interface
  4.  
  5. uses
  6.   OS2Def, BSEDos;
  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 : HDIR;
  61.                 Attr : Byte;
  62.                 Time : LongInt;
  63.                 Size : LongInt;
  64.                 Name : String[80];
  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 : PGInfoSeg;
  76.   LocalInfoSeg  : PLInfoSeg;
  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.   Strings;
  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 : BSEDos.DateTime;
  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 : BSEDos.DateTime;
  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 : BSEDos.DateTime;
  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 : BSEDos.DateTime;
  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(ord(Verify));
  180.   End;
  181.  
  182.   Function DiskFree(Drive : Byte) : LongInt;
  183.   Var
  184.     FI : FSAllocate;
  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 : FSAllocate;
  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 : FileStatus;
  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 : FileStatus;
  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    : FileFindBuf;
  259.     N     : String;
  260.     Count : Word;
  261.   Begin
  262.     N := Path + #0;
  263.     Count := 1;
  264.     PUSHORT(@S)^ := $FFFF; { HDIR_CREATE }
  265.     DosError := DosFindFirst(@N[1],PHDir(@S),Attr,@FF,SizeOf(FF),@Count,0);
  266.     If DosError = 0 then
  267.       Begin
  268.         S.Attr := FF.AttrFile;
  269.         S.Time := (LongInt(FF.fDateLastWrite) Shl 16) + FF.fTimeLastWrite;
  270.         S.Size := FF.cbFileAlloc;
  271.         Move(FF.cchName,S.Name,SizeOf(S.Name))
  272.       End;
  273.   End;
  274.  
  275.   Procedure FindNext(Var S : SearchRec);
  276.   Var
  277.     FF    : FileFindBuf;
  278.     Count : Word;
  279.   Type
  280.     PWord = ^Word;
  281.   Begin
  282.     Count := 1;
  283.     DosError := DosFindNext(PWord(@S)^,@FF,SizeOf(FF),@Count);
  284.     If DosError = 0 then
  285.       Begin
  286.         S.Attr := FF.AttrFile;
  287.         S.Time := (LongInt(FF.fDateLastWrite) Shl 16) + FF.fTimeLastWrite;
  288.         S.Size := FF.cbFileAlloc;
  289.         Move(FF.cchName,S.Name,SizeOf(S.Name))
  290.       End
  291.     else
  292.       DosFindClose(PWord(@S)^);
  293.   End;
  294.  
  295.   Procedure PackTime(Var T : DateTime;Var P : LongInt);
  296.   Var
  297.     P1 : Record
  298.            Time,Date : Word;
  299.          End Absolute P;
  300.   Begin
  301.     P1.Date := (T.Year - 1980) Shl 9 + T.Month Shl 5 + T.Day;
  302.     P1.Time := T.Hour Shl 11 + T.Min Shl 5 + T.Sec Shr 1;
  303.   End;
  304.  
  305.   Procedure UnpackTime(P : LongInt;Var T : DateTime);
  306.   Var
  307.     P1 : Record
  308.            Time,Date : Word;
  309.          End Absolute P;
  310.   Begin
  311.     T.Year  := P1.Date Shr 9 + 1980;
  312.     T.Month := (P1.Date Shr 5) And 15;
  313.     T.Day   := P1.Date And 31;
  314.     T.Hour  := P1.Time Shr 11;
  315.     T.Min   := (P1.Time Shr 5) And 63;
  316.     T.Sec   := (P1.Time And 31) Shl 1;
  317.   End;
  318.  
  319.   Function FSearch(Path : PathStr;DirList : String) : PathStr;
  320.   Var
  321.     Dir,FName,Dest : array[0..255] of char;
  322.   Begin
  323.     StrPCopy(FName, Path);
  324.     StrPCopy(Dir, DirList);
  325.     if DosSearchPath(0, Dir, FName, @Dest, sizeof(Dest)) = 0 then
  326.       FSearch := StrPas(Dest)
  327.     else
  328.       FSearch := '';
  329.   End;
  330.  
  331.   Function FExpand(Path : PathStr) : PathStr; assembler;
  332.   Var
  333.     Disk : word;
  334.     Mask : longint;
  335.     Len : word;
  336.   asm
  337.     PUSH    DS
  338.     CLD
  339.     LDS    SI,Path
  340.     LODSB
  341.     MOV    CL,AL
  342.     XOR    CH,CH
  343.     ADD    CX,SI
  344.     LES    DI,@Result
  345.     INC    DI
  346.     LODSW
  347.     CMP    SI,CX
  348.     JA    @@1
  349.     CMP    AH,':'
  350.     JNE    @@1
  351.     CMP    AL,'a'
  352.     JB    @@2
  353.     CMP    AL,'z'
  354.     JA    @@2
  355.     SUB    AL,20H
  356.     JMP    @@2
  357. @@1:    DEC    SI
  358.     DEC    SI
  359.         PUSHA
  360.         PUSH    SS
  361.         LEA     AX,Disk
  362.         PUSH    AX
  363.         PUSH    SS
  364.         LEA     AX,Mask
  365.         PUSH    AX
  366.         CALL    DosQCurDisk {Get current drive}
  367.         POPA
  368.         MOV     AL,byte ptr Disk
  369.     ADD    AL,'A'-1
  370.     MOV    AH,':'
  371. @@2:    STOSW
  372.     CMP    SI,CX
  373.     JE    @@21
  374.     CMP    BYTE PTR [SI],'\'
  375.     JE    @@3
  376. @@21:    SUB    AL,'A'-1
  377.     MOV    DL,AL
  378.     MOV    AL,'\'
  379.     STOSB
  380.         PUSHA
  381.         XOR     AX,AX
  382.         PUSH    AX
  383.         PUSH    ES
  384.         PUSH    DI
  385.         MOV     Len,252
  386.         PUSH    SS
  387.         LEA     AX,Len
  388.         PUSH    AX
  389.         CALL    DosQCurDir
  390.         POPA
  391.     CMP    BYTE PTR ES:[DI],0
  392.     JE    @@3
  393.     PUSH    CX
  394.     MOV    CX,-1
  395.     XOR    AL,AL
  396.     REPNE    SCASB
  397.     DEC    DI
  398.     MOV    AL,'\'
  399.     STOSB
  400.     POP    CX
  401. @@3:    SUB    CX,SI
  402.     REP    MOVSB
  403.     XOR    AL,AL
  404.     STOSB
  405.     LDS    SI,@Result
  406.     INC    SI
  407.     MOV    DI,SI
  408.     PUSH    DI
  409. @@4:    LODSB
  410.     OR    AL,AL
  411.     JE    @@6
  412.     CMP    AL,'\'
  413.     JE    @@6
  414.     CMP    AL,'a'
  415.     JB    @@5
  416.     CMP    AL,'z'
  417.     JA    @@5
  418.     SUB    AL,20H
  419. @@5:    STOSB
  420.     JMP    @@4
  421. @@6:    CMP    WORD PTR [DI-2],'.\'
  422.     JNE    @@7
  423.     DEC    DI
  424.     DEC    DI
  425.     JMP    @@9
  426. @@7:    CMP    WORD PTR [DI-2],'..'
  427.     JNE    @@9
  428.     CMP    BYTE PTR [DI-3],'\'
  429.     JNE    @@9
  430.     SUB    DI,3
  431.     CMP    BYTE PTR [DI-1],':'
  432.     JE    @@9
  433. @@8:    DEC    DI
  434.     CMP    BYTE PTR [DI],'\'
  435.     JNE    @@8
  436. @@9:    OR    AL,AL
  437.     JNE    @@5
  438.     CMP    BYTE PTR [DI-1],':'
  439.     JNE    @@10
  440.     MOV    AL,'\'
  441.     STOSB
  442. @@10:    MOV    AX,DI
  443.     POP    DI
  444.     SUB    AX,DI
  445.     DEC    DI
  446.     STOSB
  447.     POP    DS
  448.   End;
  449.  
  450.   Procedure FSplit(Path : PathStr;Var Dir : DirStr;Var Name : NameStr;Var Ext : ExtStr);
  451.   Var
  452.     l : Integer;
  453.   Begin
  454.     l := Length(Path);
  455.     While Not(Path[l] in ['\',':']) and (l > 0) do Dec(l);
  456.     Dir := Copy(Path,1,l);
  457.     Path := Copy(Path,l + 1,255);
  458.     l := Pos('.',Path);
  459.     If l <> 0 then
  460.       Begin
  461.         Name := Copy(Path,1,l - 1);
  462.         Ext  := Copy(Path,l,4);
  463.       End
  464.     else
  465.       Begin
  466.         Name := Path;
  467.         Ext  := '';
  468.       End;
  469.   End;
  470.  
  471.   Function EnvCount : Integer;
  472.   Var
  473.     p   : PChar;
  474.     i,l : Integer;
  475.   Begin
  476.     p := Ptr(EnvironmentSeg,0);
  477.     i := 0;
  478.     Repeat
  479.       l := 0;
  480.       While p^ <> #0 do
  481.         Begin
  482.           Inc(l); Inc(p);
  483.         End;
  484.       Inc(p);
  485.       If l = 0 then Break;
  486.       Inc(i);
  487.     Until False;
  488.     EnvCount := i;
  489.   End;
  490.  
  491.   Function EnvStr(Index : Integer) : String;
  492.   Var
  493.     p : PChar;
  494.     s : String;
  495.     i : Integer;
  496.   Begin
  497.     p := Ptr(EnvironmentSeg,0);
  498.     s := '';
  499.     For i := 1 to Index do
  500.       Begin
  501.         s := '';
  502.         While p^ <> #0 do
  503.           Begin
  504.             s := s + p^; Inc(p);
  505.           End;
  506.         Inc(p);
  507.         If s = '' then Break;
  508.       End;
  509.     EnvStr := s;
  510.   End;
  511.  
  512.   Function GetEnv(EnvVar : String) : String;
  513.   Var
  514.     Count,i : Integer;
  515.     s       : String;
  516.     p       : Byte;
  517.   Begin
  518.     Count := EnvCount;
  519.     For i := 1 to Count do
  520.       Begin
  521.         s := EnvStr(i);
  522.         p := Pos('=',s);
  523.         If p <> 0 then
  524.           If Copy(s,1,p - 1) = EnvVar then
  525.             Begin
  526.               GetEnv := Copy(s,p + 1,255);
  527.               Exit;
  528.             End;
  529.       End;
  530.     GetEnv := '';
  531.   End;
  532.  
  533. Var
  534.   ExecResult : ResultCodes;
  535.  
  536.   Procedure Exec(Path : PathStr;ComLine : ComStr);
  537.   Var
  538.     b : Array[0..255] of Char;
  539.   Begin
  540.     Path := Path + #0;
  541.     ComLine := ComLine + #0#0;
  542.     DosError := DosExecPgm(b,256,ExecFlags,@ComLine[1],Ptr(EnvironmentSeg,0),@ExecResult,@Path[1]);
  543.   End;
  544.  
  545.   Function DosExitCode : Word;
  546.   Begin
  547.     DosExitCode := ExecResult.CodeResult;
  548.   End;
  549.  
  550.   Procedure PlaySound(Frequency,Duration : Word);
  551.   Begin
  552.     DosBeep(Frequency,Duration);
  553.   End;
  554.  
  555.   Procedure DosInit;
  556.   Var
  557.     GlobalSel,LocalSel : Word;
  558.   Begin
  559.     If DosGetInfoSeg(@GlobalSel,@LocalSel) = 0 then
  560.       Begin
  561.         GlobalInfoSeg := Ptr(GlobalSel,0);
  562.         LocalInfoSeg  := Ptr(LocalSel,0);
  563.       End
  564.     else
  565.       Begin
  566.         GlobalInfoSeg := Nil;
  567.         LocalInfoSeg  := Nil;
  568.       End;
  569.   End;
  570.  
  571. Begin
  572.   DosInit;
  573. End.
  574.