home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / sp15demo.zip / libsrc.zip / LIBSRC / DOS.PAS < prev    next >
Pascal/Delphi Source File  |  1996-02-25  |  40KB  |  1,570 lines
  1. UNIT Dos;
  2.  
  3. {**************************************************************************
  4.  *                 General Unit for Speed-Pascal/2                        *
  5.  *                                                                        *
  6.  *                                                                        *
  7.  * Copyright (C) 1995..96 SpeedSoft                                       *
  8.  *                                                                        *
  9.  *                                                                        *
  10.  **************************************************************************}
  11.  
  12. {$R-,S-}
  13.  
  14.  
  15. INTERFACE
  16.  
  17. {$IFDEF OS2}
  18. USES BseDos,Os2Def;
  19. {$ENDIF}
  20.  
  21. {$IFDEF Win95}
  22. USES WinNT,WinBase;
  23. {$ENDIF}
  24.  
  25. CONST
  26.  
  27. { Flags bit masks }
  28.  
  29.   FCarry     = 1;
  30.   FParity    = 4;
  31.   FAuxiliary = 16;
  32.   FZero      = 64;
  33.   FSign      = 128;
  34.   FOverflow  = 2048;
  35.  
  36. { File attribute constants }
  37.  
  38.   {$IFDEF OS2}
  39.   ReadOnly  = FILE_READONLY;
  40.   Hidden    = FILE_HIDDEN;
  41.   SysFile   = FILE_SYSTEM;
  42.   VolumeID  = 0;  //not defined ???
  43.   Directory = FILE_DIRECTORY;
  44.   Archive   = FILE_ARCHIVED;
  45.   AnyFile   = FILE_READONLY|FILE_HIDDEN|FILE_SYSTEM|FILE_DIRECTORY|FILE_ARCHIVED;
  46.   {$ENDIF}
  47.   {$IFDEF Win95}
  48.   ReadOnly  = FILE_ATTRIBUTE_READONLY;
  49.   Hidden    = FILE_ATTRIBUTE_HIDDEN;
  50.   SysFile   = FILE_ATTRIBUTE_SYSTEM;
  51.   VolumeID  = 0;  //not defined ???
  52.   Directory = FILE_ATTRIBUTE_DIRECTORY;
  53.   Archive   = FILE_ATTRIBUTE_ARCHIVE;
  54.   AnyFile   = FILE_ATTRIBUTE_READONLY|FILE_ATTRIBUTE_HIDDEN|
  55.               FILE_ATTRIBUTE_SYSTEM|FILE_ATTRIBUTE_DIRECTORY|
  56.               FILE_ATTRIBUTE_ARCHIVE;
  57.   {$ENDIF}
  58.  
  59. {Compare File times result codes}
  60.   F_EQUAL          =0;
  61.   F_FIRST_GREATER  =1;
  62.   F_SECOND_GREATER =2;
  63.   F_ERROR          =255;
  64.  
  65. type
  66.       CmdStr  = STRING;        { Command line string }
  67.       PathStr = STRING;        { File pathname string }
  68.       DirStr  = STRING;        { Drive and directory string }
  69.       NameStr = STRING;        { File name string }
  70.       ExtStr  = STRING;        { File extension string }
  71.  
  72.  
  73.       Registers =
  74.          record
  75.            case integer of
  76.              0: (EAX,EBX,ECX,EDX,EBP,ESI,EDI,DS_ES,EFlags:LongWord);
  77.              1: (AX,X_AX,BX,X_BX,CX,X_CX,DX,X_DX,BP,X_BP,SI,X_SI,
  78.                  DI,X_DI,DS,ES,Flags,X_FLAGS: Word);
  79.              2: (AL,AH,X_AL,X_AH,BL,BH,X_BL,X_BH,CL,CH,X_CL,X_CH,
  80.                  DL,DH,X_DL,X_DH: Byte);
  81.            end;
  82.  
  83. { Search record used by FindFirst and FindNext }
  84.  
  85. TYPE
  86.    SearchRec = record
  87.                      Fill: array[1..21] of Byte;
  88.                      Attr: Byte;
  89.                      Time: Longint;
  90.                      Size: Longint;
  91.                      Name: string;
  92.  
  93.                      {private}
  94.                      HDir:LONGWORD;
  95.                      {$IFDEF OS2}
  96.                      SearchRecIntern:FILEFINDBUF3;
  97.                      {$ENDIF}
  98.                      {$IFDEF Win95}
  99.                      SearchRecIntern:WIN32_FIND_DATA;
  100.                      InternalAttr:LONGWORD;
  101.                      {$ENDIF}
  102.                end;
  103.  
  104.   TSearchRec=SearchRec;
  105.  
  106.   {$IFDEF OS2}
  107.   ExecResultCode=RESULTCODES;
  108.   {$ENDIF}
  109.  
  110.   FileRec = RECORD
  111.                   Handle          : LongWord;     {FileHandle            }
  112.                   RecSize         : LongWord;     {Record size           }
  113.                   Name            : STRING;       {(Long) file name      }
  114.                   EAS             : POINTER;      {extended attributes   }
  115.                   Mode            : LONGWORD;     {Current file mode     }
  116.                   Reserved        : POINTER;      {for private extensions}
  117.                   Block           : LONGWORD;     {current block in file }
  118.                   LBlock          : LONGWORD;     {Last block in file    }
  119.                   Offset          : LONGWORD;     {Current offset in Block}
  120.                   LOffset         : LONGWORD;     {Last Offset in LBlock }
  121.                   Changed         : LONGBOOL;     {TRUE if Block has changed}
  122.                   Buffer          : POINTER;      {I/O Buffer            }
  123.                   MaxCacheMem     : LONGWORD;     {Size of I/O Buffer    }
  124.                   Flags           : LONGWORD;     {Assign flags $6666    }
  125.                   Reserved1       : LONGWORD;     {dont use              }
  126.                   {312 byte til here}
  127.              END;
  128.  
  129.     TextRec=FileRec;
  130.  
  131. VAR DosError:LongInt;   {DOS unit error status}
  132.  
  133. CONST
  134.     ExecViaSession:BOOLEAN=TRUE; {Set to TRUE if you want to
  135.                                   use Exec on another session.
  136.                                   Then you cannot get the result
  137.                                   code but you can wait via
  138.                                   DosExitCode for the session to
  139.                                   terminate}
  140.     AsynchEXEC:BOOLEAN=TRUE;      {Standard: asynchronous EXEC}
  141.     LastExecResult:LONGWORD=0;
  142.  
  143. {Time/Date functions}
  144. FUNCTION GetDate(VAR Year,Month,Day,DayOfWeek: Word):LONGINT;
  145. FUNCTION SetDate(Year,Month,Day: Word):LONGINT;
  146. FUNCTION GetTime(VAR Hour,Minute,Second,Sec100: Word):LONGINT;
  147. FUNCTION SetTime(Hour,Minute,Second,Sec100: Word):LONGINT;
  148. FUNCTION GetFAttr(VAR F:FILE; VAR Attr: LongWord):LONGINT;
  149. FUNCTION SetFAttr(VAR F:FILE; Attr: LongWord):LONGINT;
  150. FUNCTION GetFTime(VAR F:FILE;VAR Time:LONGINT):LONGINT;
  151. FUNCTION SetFTime(VAR F:FILE;Time:LONGINT):LONGINT;
  152. FUNCTION GetFTime2(VAR F:FILE; VAR year,month,day,hours,minutes,secs:Word):LONGINT;
  153. FUNCTION SetFTime2(VAR F:FILE; year,month,day,hours,minutes,secs:Word):LONGINT;
  154. PROCEDURE PackTime(VAR T: DateTime; VAR Time: Longint);
  155. PROCEDURE UnpackTime(Time: Longint; VAR DT: DateTime);
  156.  
  157. {File find functions}
  158. FUNCTION FindFirst(Path: PathStr; Attr: LongWord; var F: SearchRec):LONGINT;
  159. FUNCTION FindNext(var F: SearchRec):LONGINT;
  160. PROCEDURE FindClose(var F: SearchRec);
  161. FUNCTION FSearch(Path: PathStr; DirList: String): PathStr;
  162.  
  163. {Common functions}
  164. FUNCTION  DosVersion:LongWord;
  165. FUNCTION GetVerify(var Verify: Boolean):LONGINT;
  166. FUNCTION SetVerify(Verify: Boolean):LONGINT;
  167. FUNCTION  GetEnv(CONST env:STRING):STRING;
  168. FUNCTION EnvStr(Index:LONGINT):STRING;
  169. FUNCTION EnvCount:LONGINT;
  170. PROCEDURE SwapVectors; {ignored}
  171.  
  172. {Disk functions}
  173. FUNCTION  DiskFree(Drive: Byte): LongWord;
  174. FUNCTION  DiskSize(Drive: Byte): LongWord;
  175. FUNCTION  FExpand(Path: PathStr): PathStr;
  176. FUNCTION  FSplit(CONST Path: PathStr;VAR Dir: DirStr;
  177.                  VAR Name: NameStr;VAR Ext: ExtStr):LONGINT;
  178. FUNCTION  CompareFileTimes(First,Second:STRING):BYTE;
  179.  
  180. {Process functions}
  181. FUNCTION Exec(CONST Path: PathStr; CmdLine: STRING):LONGWORD;
  182. FUNCTION DosExitCode(SessID:LONGWORD):LONGWORD;
  183. FUNCTION ProcessActive(pid:LONGWORD):BOOLEAN;
  184. FUNCTION KillProcess(pid:LONGWORD):LONGINT;
  185.  
  186. {Thread functions}
  187. FUNCTION StartThread(ThreadAddr:POINTER;StackSize:LONGWORD;
  188.                       Params:POINTER;VAR Tid:LONGWORD):LONGINT;
  189. FUNCTION SuspendThread(Tid:LONGWORD):LONGINT;
  190. FUNCTION ResumeThread(Tid:LONGWORD):LONGINT;
  191. FUNCTION KillThread(Tid:LONGWORD):LONGINT;
  192. PROCEDURE Flush (VAR F:FILE);
  193.  
  194. PROCEDURE Delay(ms:LONGWORD);
  195.  
  196. IMPLEMENTATION
  197.  
  198. VAR
  199.    TempCmdLine:STRING;
  200.  
  201. PROCEDURE Delay(ms:LONGWORD);
  202. BEGIN
  203.      {$IFDEF OS2}
  204.      DosSleep(ms);
  205.      {$ENDIF}
  206.      {$IFDEF Win95}
  207.      Sleep(ms);
  208.      {$ENDIF}
  209. END;
  210.  
  211. PROCEDURE SwapVectors;
  212. BEGIN
  213.      {This function is ignored}
  214.      DosError:=0;
  215. END;
  216.  
  217. FUNCTION FExpand(Path:PathStr):PathStr;
  218. VAR  i,p,t:BYTE;
  219.      s:STRING;
  220. LABEL l,l2;
  221. BEGIN
  222.      t := pos(';',Path);
  223.      IF t <> 0 THEN
  224.      BEGIN
  225.           s := Path;
  226.           delete(s,1,t);
  227.           Path[0] := chr(t);
  228.           Path := Path + FExpand(s);
  229.      END;
  230.  
  231.      GetDir(0,s);
  232.      IF length(s)=3 THEN IF s[2]=':' THEN IF s[3] IN ['\','/'] THEN dec(s[0]);
  233.  
  234.      IF pos('\',Path) = 1 THEN Path := copy(s,1,2) + Path;
  235.      IF (Length(Path) >= 2) AND (Path[2] = ':') THEN
  236.      BEGIN
  237.           s := copy(Path,1,2);
  238.           delete(Path,1,2);
  239.      END;
  240.      IF not (Path[1] IN ['\','/']) THEN Path := '\'+ Path;
  241.  
  242.      REPEAT
  243.            IF ((pos('\..',Path) = 1)OR(pos('/..',Path) = 1)) THEN
  244.            BEGIN
  245.                 IF (Length(Path) >= 4) AND (not (Path[4] IN ['\','/'])) THEN goto l2;
  246.                 delete(Path,1,3);
  247.                 FOR i := Length(s) DOWNTO 3 DO
  248.                 BEGIN
  249.                      IF s[i] = ':' THEN break;
  250.                      dec(s[0]);
  251.                      IF s[i] IN ['\','/'] THEN break;
  252.                 END;
  253.            END
  254.            ELSE
  255.            IF ((pos('\.',Path) = 1)OR(pos('/.',Path) =1)) THEN
  256.            BEGIN
  257.                 IF (Length(Path) >= 3) AND (not (Path[3] IN ['\','/'])) THEN goto l2;
  258.                 delete(Path,1,2);
  259.            END
  260.            ELSE
  261.            IF ((pos('\',Path) = 1)OR(pos('/',Path) = 1)) THEN
  262.            BEGIN
  263. l2:
  264.                 delete(Path,1,1);
  265.                 s := s + '\';
  266.            END
  267.            ELSE
  268.            BEGIN
  269. l:
  270.                 p := pos('\',Path);
  271.                 IF p=0 THEN p := pos('/',Path);
  272.                 IF p > 0 THEN
  273.                 BEGIN
  274.                      s := s + copy(Path,1,p-1);
  275.                      delete(Path,1,p-1);
  276.                 END
  277.                 ELSE
  278.                 BEGIN
  279.                      s := s + Path;
  280.                      Path := '';
  281.                 END;
  282.            END;
  283.      UNTIL Path = '';
  284.      IF Length(s) = 2 THEN s := s +'\';
  285.  
  286.      Result := s;
  287. END;
  288.  
  289. FUNCTION KillThread(Tid:LONGWORD):LONGINT;
  290. BEGIN
  291.      {$IFDEF OS2}
  292.      DosError:=DosKillThread(Tid);
  293.      {$ENDIF}
  294.      {$IFDEF Win95}
  295.      DosError:=BYTE(CloseHandle(Tid)=FALSE);
  296.      {$ENDIF}
  297.      result:=DosError;
  298. END;
  299.  
  300. FUNCTION SuspendThread(Tid:LONGWORD):LONGINT;
  301. BEGIN
  302.      {$IFDEF OS2}
  303.      DosError:=DosSuspendThread(Tid);
  304.      {$ENDIF}
  305.      {$IFDEF Win95}
  306.      DosError:=BYTE(WinBase.SuspendThread(Tid)=$FFFFFFFF);
  307.      {$ENDIF}
  308.      result:=DosError;
  309. END;
  310.  
  311. FUNCTION ResumeThread(Tid:LONGWORD):LONGINT;
  312. BEGIN
  313.      {$IFDEF OS2}
  314.      DosError:=DosResumeThread(Tid);
  315.      {$ENDIF}
  316.      {$IFDEF Win95}
  317.      DosError:=BYTE(WinBase.ResumeThread(Tid)=$FFFFFFFF);
  318.      {$ENDIF}
  319.      result:=DosError;
  320. END;
  321.  
  322. FUNCTION StartThread(ThreadAddr:POINTER;StackSize:LONGWORD;
  323.                       Params:POINTER;VAR Tid:LONGWORD):LONGINT;
  324. VAR id:LONGWORD;
  325. BEGIN
  326.      {$IFDEF OS2}
  327.      DosError:=DosCreateThread(Tid,ThreadAddr,Params,
  328.                                STACK_SPARSE,StackSize);
  329.      {$ENDIF}
  330.      {$IFDEF Win95}
  331.      Tid:=WinBase.CreateThread(NIL,StackSize,ThreadAddr,Params,0,id);
  332.      IF Tid=0 THEN DosError:=1
  333.      ELSE DosError:=0;
  334.      {$ENDIF}
  335.      result:=DosError;
  336. END;
  337.  
  338.  
  339. FUNCTION KillProcess(pid:LONGWORD):LONGINT;
  340. BEGIN
  341.      {$IFDEF OS2}
  342.      DosError:=DosKillProcess(0,pid);
  343.      {$ENDIF}
  344.      {$IFDEF Win95}
  345.      DosError:=BYTE(TerminateProcess(pid,0)=FALSE);
  346.      {$ENDIF}
  347.      result:=DosError;
  348. END;
  349.  
  350. FUNCTION ProcessActive(pid:LONGWORD):BOOLEAN;
  351. VAR r,rpid:LONGWORD;
  352.     {$IFDEF OS2}
  353.     res:Execresultcode;
  354.     {$ENDIF}
  355. BEGIN
  356.      {$IFDEF OS2}
  357.      r:=DosWaitChild(DCWA_PROCESS,DCWW_NOWAIT,res,rpid,pid);
  358.      DosError:=r;
  359.      IF r=129 {child not complete} THEN ProcessActive:=TRUE
  360.      ELSE ProcessActive:=FALSE; {Child complete or illegal pid}
  361.      {$ENDIF}
  362.      {$IFDEF Win95}
  363.      DosError:=1;  //not supported
  364.      {$ENDIF}
  365. END;
  366.  
  367. FUNCTION FSplit(CONST Path: PathStr;
  368.                  VAR Dir:DirStr;VAR Name:NameStr;VAR Ext:ExtStr):LONGINT;
  369. Var  i    : Integer ;
  370.      Trv  : Boolean ;
  371. Begin
  372.      Trv:=False ;
  373.      For i:=Length(Path) DownTo 1 Do
  374.      If (Path[i] IN ['\','/']) Or (Path[i]=':') Then
  375.      Begin
  376.           Trv:=True ;
  377.           Dir:=Copy(Path, 1, i) ;       { or i-1 if Path[i]='\' ? }
  378.           IF Dir[length(Dir)]='/' THEN Dir[length(Dir)]:='\';
  379.           Name:=Copy(Path, i+1, 255) ;
  380.           Break ;
  381.      End ;
  382.      If Not Trv Then
  383.      Begin
  384.           Dir:='' ;
  385.           Name:=Path ;
  386.      End ;
  387.  
  388.      Trv:=False ;
  389.      For i:=Length(Name) DownTo 1 Do
  390.      If Name[i]='.' Then
  391.      Begin
  392.           Trv:=True ;
  393.           Ext:=Copy(Name, i, 255) ;
  394.           Name:=Copy(Name, 1, i-1) ;
  395.           Break ;
  396.      End ;
  397.      If Not Trv Then Ext:='' ;
  398.      result:=0;
  399. End;
  400.  
  401.  
  402. FUNCTION FSearch(Path: PathStr; DirList: String): PathStr;
  403. var
  404.    r,c,c1:CSTRING;
  405.    p:PChar;
  406. BEGIN
  407.      c:=DirList;
  408.      c1:=Path;
  409.      {$IFDEF OS2}
  410.      DosError:=DosSearchPath(0,c,c1,r,255);
  411.      {$ENDIF}
  412.      {$IFDEF Win95}
  413.      DosError:=BYTE(SearchPath(c,c1,NIL,255,r,p)=0);
  414.      {$ENDIF}
  415.      IF DosError<>0 THEN r:='';
  416.      FSearch:=r;
  417. END;
  418.  
  419. FUNCTION PackTimeIntern(hour,minute,twosec:Word):Word;
  420. VAR time:Word;
  421. BEGIN
  422.      ASM
  423.         MOV BL,$Hour
  424.         SHL BL,3          //multiply with 8
  425.         MOV AL,$minute
  426.         SHR AL,3          //divide by 8
  427.         ADD AL,BL
  428.         SHL AX,8          //Shift
  429.         MOV $time,AX
  430.  
  431.         MOV BL,$minute
  432.         AND BL,7
  433.         SHL BL,5          //multiply with 2 and shift
  434.         ADD BL,$TwoSec
  435.         MOV $time,BL
  436.      END;
  437.      DosError:=0;
  438.      PackTimeIntern:=Time;
  439. END;
  440.  
  441. FUNCTION PackdateIntern(year,month,day:Word):Word;
  442. VAR Date:Word;
  443. BEGIN
  444.      ASM
  445.         MOV AL,$month
  446.         MOV BL,0
  447.         CMP AL,7
  448.         JNA !mo1
  449.         MOV BL,1
  450.         SUB AL,8
  451. !mo1:
  452.         MOV CX,$year
  453.         SUB CX,1980
  454.         SHL CX,1          //multiply with 2
  455.         MOVZX BX,BL
  456.         ADD CX,BX
  457.         SHL CX,8         //Shift
  458.         MOV $Date,CX
  459.  
  460.         SHL AL,5         //multiply month with 2 and shift
  461.         ADD AL,$Day
  462.         MOV $Date,AL
  463.      END;
  464.      DosError:=0;
  465.      PackDateIntern:=Date;
  466. END;
  467.  
  468. PROCEDURE PackTime(var T: DateTime; var Time: Longint);
  469. VAR year,month,day,hour,min,sec:WORD;
  470. BEGIN
  471.      year:=T.year;
  472.      month:=T.month;
  473.      day:=T.day;
  474.      hour:=T.hour;
  475.      min:=T.min;
  476.      sec:=T.sec;
  477.      ASM
  478.         MOV AX,$year
  479.         SUB AX,1980
  480.         MOV CL,9
  481.         SHL AX,CL
  482.         XCHG AX,DX
  483.         MOV AX,$month
  484.         MOV CL,5
  485.         SHL AX,CL
  486.         ADD DX,AX
  487.         MOV AX,$day
  488.         ADD DX,AX
  489.         MOV AX,$hour
  490.         MOV CL,11
  491.         SHL AX,CL
  492.         XCHG AX,BX
  493.         MOV AX,$min
  494.         MOV CL,5
  495.         SHL AX,CL
  496.         ADD BX,AX
  497.         MOV AX,$sec
  498.         SHR AX,1
  499.         ADD AX,BX
  500.         MOV EDI,$Time
  501.         CLD
  502.         STOSW
  503.         XCHG AX,DX
  504.         STOSW
  505.      END;
  506. END;
  507.  
  508. PROCEDURE UnPackTimeIntern(pack:Word;var hour,minute,twosec:Word);
  509. VAR h,min,sec:WORD;
  510. BEGIN
  511.     ASM
  512.        MOV DX,$pack
  513.  
  514.        MOV AL,DH    //Hour/Minute
  515.        AND AL,248   //Mask Hour
  516.        SHR AL,3     //divide by 8
  517.        MOVZX AX,AL
  518.        MOV $h,AX
  519.  
  520.        MOV AL,DH    //Hour/Minute
  521.        AND AL,7     //Mask Minute
  522.        SHL AL,3     //multiply with 8
  523.        MOV BL,AL
  524.  
  525.        MOV AL,DL    //Minute/sec
  526.        AND AL,224   //Mask minute
  527.        SHR AL,5     //divide by 2 and shift
  528.        ADD AL,BL
  529.        MOVZX AX,AL
  530.        MOV $min,AX
  531.  
  532.        MOV AL,DL    //Minute/sec
  533.        AND AL,31    //Mask twoseconds
  534.        MOVZX AX,AL
  535.        MOV $sec,AX
  536.      END;
  537.      DosError:=0;
  538.      Hour:=h;
  539.      minute:=min;
  540.      twosec:=sec;
  541. END;
  542.  
  543. PROCEDURE UnPackDateIntern(pack:Word;var year,month,day:Word);
  544. VAR y,m,dy:Word;
  545. BEGIN
  546.      ASM
  547.         MOV DX,$pack
  548.  
  549.         MOV AL,DH    //Year/Month
  550.         AND AL,254   //Clear Bit 1
  551.         SHR AL,1     //Divide by 2
  552.         MOVZX AX,AL
  553.         ADD AX,1980
  554.         MOV $y,AX    //Year
  555.         MOV BL,0
  556.         MOV AL,DH    //Year/Month
  557.         AND AL,1     //Mask HSB month
  558.         CMP AL,1
  559.         JNE !ml7
  560.         MOV BL,8
  561. !ml7:
  562.         MOV AL,DL    //month/Day
  563.         AND AL,224   //mask month (upper 3 bits)
  564.         SHR AL,5     //divide by 2 and shift
  565.         ADD AL,BL
  566.         MOVZX AX,AL
  567.         MOV $m,AX    //Month
  568.  
  569.         MOV AL,DL    //Month/day
  570.         AND AL,31    //Mask day
  571.         MOVZX AX,AL
  572.         MOV $dy,AX    //day
  573.      END;
  574.      DosError:=0;
  575.      year:=y;
  576.      month:=m;
  577.      day:=dy;
  578. END;
  579.  
  580. PROCEDURE UnpackTime(Time: Longint; var DT: DateTime);
  581. VAR
  582.     y,m,dy,h,mi,s:WORD;
  583. BEGIN
  584.      ASM
  585.         MOV AX,$Time+2
  586.         MOV CL,9
  587.         SHR AX,CL
  588.         ADD AX,1980
  589.         MOV $y,AX
  590.         MOV AX,$Time+2
  591.         MOV CL,5
  592.         SHR AX,CL
  593.         AND AX,15
  594.         MOV $m,AX
  595.         MOV AX,$Time+2
  596.         AND AX,31
  597.         MOV $dy,AX
  598.         MOV AX,$Time
  599.         MOV CL,11
  600.         SHR AX,CL
  601.         MOV $h,AX
  602.         MOV AX,$Time
  603.         MOV CL,5
  604.         SHR AX,CL
  605.         AND AX,63
  606.         MOV $mi,AX
  607.         MOV AX,$Time
  608.         AND AX,31
  609.         SHL AX,1
  610.         MOV $s,AX
  611.      END;
  612.      DT.year:=y;
  613.      DT.month:=m;
  614.      DT.day:=dy;
  615.      DT.hour:=h;
  616.      DT.min:=mi;
  617.      DT.sec:=s;
  618.      DT.hundredths:=0;
  619. END;
  620.  
  621. FUNCTION FindFirst(Path: PathStr; Attr: LongWord; var F: SearchRec):LONGINT;
  622. VAR
  623.     count,size,tt:LONGWORD;
  624.     t:BYTE;
  625.     c:CSTRING;
  626. BEGIN
  627.      c:=Path;
  628.      DosError:=0;
  629.      {$IFDEF OS2}
  630.      F.HDir:=-1;  {HDIR_CREATE}
  631.      count:=1;
  632.      DosError:=DosFindFirst(c,F.Hdir,Attr,F.SearchRecIntern,
  633.                             sizeof(FILEFINDBUF3),count,FIL_STANDARD);
  634.      IF ((DosError<>0)or(Count=0)) THEN
  635.      BEGIN
  636.           IF DosError=0 THEN DosError:=18;
  637.           FindClose(F);
  638.           result:=DosError;
  639.           exit;
  640.      END;
  641.      tt:=F.SearchRecIntern.fdateLastWrite;
  642.      f.Time:=(tt SHL 16)+F.SearchRecIntern.ftimeLastWrite;
  643.      f.Size:=F.SearchRecIntern.cbFile;
  644.      f.Attr:=F.SearchRecIntern.AttrFile;
  645.      f.Name:=F.SearchRecIntern.achName;
  646.      {$ENDIF}
  647.      {$IFDEF Win95}
  648.      F.InternalAttr:=Attr;
  649.      F.HDir:=FindFirstFile(c,F.SearchRecIntern);
  650.      IF F.HDir=INVALID_HANDLE_VALUE THEN
  651.      BEGIN
  652.           DosError:=18;
  653.           result:=DosError;
  654.           exit;
  655.      END;
  656.      WHILE F.SearchRecIntern.dwFileAttributes AND F.InternalAttr<>F.InternalAttr DO
  657.      BEGIN
  658.           IF FindNextFile(F.HDir,F.SearchRecIntern)=FALSE THEN
  659.           BEGIN
  660.                WinBase.FindClose(F.HDir);
  661.                DosError:=18;
  662.                result:=DosError;
  663.                exit;
  664.           END;
  665.      END;
  666.      f.Time:=F.SearchRecIntern.ftLastWriteTime.dwLowDateTime;
  667.      f.Size:=F.SearchRecIntern.nFileSizeLow;
  668.      f.Attr:=F.SearchRecIntern.dwFileAttributes;
  669.      f.Name:=F.SearchRecIntern.cFileName;
  670.      {$ENDIF}
  671.      result:=DosError;
  672. END;
  673.  
  674. FUNCTION FindNext(var F: SearchRec):LONGINT;
  675. VAR
  676.     Count,size,tt:LONGWORD;
  677.     t:BYTE;
  678. BEGIN
  679.      DosError:=0;
  680.      {$IFDEF OS2}
  681.      Count:=1;
  682.      DosError:=DosFindNext(F.Hdir,F.SearchRecIntern,
  683.                            sizeof(FILEFINDBUF3),count);
  684.      IF ((DosError<>0)or(Count=0)) THEN
  685.      BEGIN
  686.           IF DosError=0 THEN DosError:=18;
  687.           FindClose(F);
  688.           result:=DosError;
  689.           exit;
  690.      END;
  691.      tt:=F.SearchRecIntern.fdateLastWrite;
  692.      f.Time:=(tt SHL 16)+F.SearchRecIntern.ftimeLastWrite;
  693.      f.Size:=F.SearchRecIntern.cbFile;
  694.      f.Attr:=F.SearchRecIntern.AttrFile;
  695.      f.Name:=F.SearchRecIntern.achName;
  696.      {$ENDIF}
  697.      {$IFDEF Win95}
  698.      IF FindNextFile(F.HDir,F.SearchRecIntern)=FALSE THEN
  699.      BEGIN
  700.           WinBase.FindClose(F.HDir);
  701.           DosError:=18;
  702.           result:=DosError;
  703.           exit;
  704.      END;
  705.      WHILE F.SearchRecIntern.dwFileAttributes AND F.InternalAttr<>F.InternalAttr DO
  706.      BEGIN
  707.           IF FindNextFile(F.HDir,F.SearchRecIntern)=FALSE THEN
  708.           BEGIN
  709.                WinBase.FindClose(F.HDir);
  710.                DosError:=18;
  711.                result:=DosError;
  712.                exit;
  713.           END;
  714.      END;
  715.      f.Time:=F.SearchRecIntern.ftLastWriteTime.dwLowDateTime;
  716.      f.Size:=F.SearchRecIntern.nFileSizeLow;
  717.      f.Attr:=F.SearchRecIntern.dwFileAttributes;
  718.      f.Name:=F.SearchRecIntern.cFileName;
  719.      {$ENDIF}
  720.      result:=DosError;
  721. END;
  722.  
  723. PROCEDURE FindClose(var F: SearchRec);
  724. BEGIN
  725.      {$IFDEF OS2}
  726.      DosFindClose(F.HDir);
  727.      {$ENDIF}
  728.      {$IFDEF Win95}
  729.      WinBase.FindClose(F.HDir);
  730.      {$ENDIF}
  731.      F.HDir:=0;
  732. END;
  733.  
  734. FUNCTION DosExitCode(SessId:LONGWORD):LONGWORD;
  735. VAR
  736.    rc:LONGWORD;
  737.    {$IFDEF OS2}
  738.    Status:STATUSDATA;
  739.    return:ExecResultCode;
  740.    {$ENDIF}
  741. BEGIN
  742.      {$IFDEF OS2}
  743.      IF ExecViaSession THEN
  744.      BEGIN
  745.           Status.length:=6;
  746.           Status.SelectInd:=0;
  747.           Status.BondInd:=0;
  748.           rc:=DosSelectSession(SessID);
  749.           While rc<>371 DO
  750.           BEGIN
  751.               rc:=DosSetSession(SessID,Status);
  752.           END;
  753.           DosExitCode:=0;
  754.      END
  755.      ELSE
  756.      BEGIN
  757.           IF LastExecResult=0 THEN
  758.           BEGIN
  759.                DosWaitChild(DCWA_PROCESS,DCWW_WAIT,return,SessId,SessId);
  760.                LastExecResult:=return.CodeResult;
  761.                DosExitCode:=return.CodeResult;
  762.           END
  763.           ELSE
  764.           BEGIN
  765.                DosExitCode:=LastExecResult;
  766.           END;
  767.      END;
  768.      {$ENDIF}
  769.      {$IFDEF Win95}
  770.      GetExitCodeProcess(SessId,result);
  771.      {$ENDIF}
  772. END;
  773.  
  774. FUNCTION Exec(CONST Path: PathStr; CmdLine: STRING):LONGWORD;
  775. VAR
  776.     {$IFDEF OS2}
  777.     aStartData:STARTDATA;
  778.     ObjectBuffer:STRING;
  779.     SessID:LONGWORD;
  780.     SessPID:PID;
  781.     ExecMode:BYTE;
  782.     result:ExecResultCode;
  783.     {$ENDIF}
  784.     {$IFDEF Win95}
  785.     aStartData:StartupInfo;
  786.     aProcessInfo:PROCESS_INFORMATION;
  787.     {$ENDIF}
  788.     c,c1:CSTRING;
  789. BEGIN
  790.      c:=Path;
  791.      c1:=CmdLine;
  792.      {$IFDEF OS2}
  793.      IF ExecViaSession THEN
  794.      BEGIN
  795.           aStartData.Length:=sizeof(STARTDATA);
  796.           aStartData.Related:=SSF_RELATED_CHILD;
  797.           aStartData.FgBg:=SSF_FGBG_BACK;
  798.           aStartData.TraceOpt:=SSF_TRACEOPT_NONE;
  799.           aStartData.PgmTitle:=@c;
  800.           aStartData.PgmName:=@c;
  801.           aStartData.PgmInputs:=@c1;
  802.           aStartData.TermQ:=NIL;
  803.           aStartData.Environment:=NIL;
  804.           aStartData.InheritOpt:=SSF_INHERTOPT_SHELL;
  805.           aStartData.SessionType:=SSF_TYPE_DEFAULT;
  806.           aStartData.IconFile:=NIL;
  807.           aStartData.PgmHandle:=0;
  808.           aStartData.PgmControl:=SSF_CONTROL_VISIBLE;
  809.           aStartData.InitXPos:=0;
  810.           aStartData.InitYPos:=0;
  811.           aStartData.InitXSize:=0;
  812.           aStartData.InitYSize:=0;
  813.           aStartData.Reserved:=0;
  814.           aStartData.ObjectBuffer:=@ObjectBuffer;
  815.           aStartData.ObjectBuffLen:=256;
  816.           DosError:=DosStartSession(aStartData,SessId,SessPid);
  817.           DosSelectSession(SessID);
  818.           Exec:=SessID;
  819.  
  820.           IF not AsynchExec THEN LastExecResult:=DosExitCode(SessID);
  821.      END
  822.      ELSE
  823.      BEGIN
  824.           LastExecResult:=0;
  825.           IF AsynchEXEC THEN DosExecPgm(@ObjectBuffer,256,2,c1,
  826.                                         NIL,result,c)
  827.           ELSE
  828.           BEGIN
  829.                c1:=#0+c1;
  830.                DosExecPgm(@ObjectBuffer,256,0,c1,
  831.                           NIL,result,c);
  832.                LastExecresult:=result.CodeResult;
  833.           END;
  834.      END;
  835.      {$ENDIF}
  836.      {$IFDEF Win95}
  837.      DosError:=0;
  838.      FillChar(aStartData,sizeof(aStartData),0);
  839.      aStartData.cb:=sizeof(aStartData);
  840.      IF not CreateProcess(c,c1,NIL,NIL,FALSE,CREATE_NEW_CONSOLE OR
  841.                           NORMAL_PRIORITY_CLASS,NIL,NIL,
  842.                           aStartData,aProcessInfo) THEN
  843.      BEGIN
  844.           DosError:=1;
  845.           exit;
  846.      END;
  847.      Exec:=aProcessInfo.hProcess;
  848.      {$ENDIF}
  849. END;
  850.  
  851.  
  852. FUNCTION GetFAttr(VAR F:FILE; var Attr: LongWord):LONGINT;
  853. VAR
  854.     {$IFDEF OS2}
  855.     s:FILESTATUS3;
  856.     size:LONGWORD;
  857.     savemode:ULONG;
  858.     {$ENDIF}
  859.     {$IFDEF Win95}
  860.     Name:CSTRING;
  861.     {$ENDIF}
  862.     ff:^FileRec;
  863.     b:BOOLEAN;
  864. BEGIN
  865.      b:=RaiseIoError;
  866.      ff:=@f;
  867.      DosError:=0;
  868.      {$IFDEF OS2}
  869.      savemode:=FileMode;
  870.      filemode:=fmInput;
  871.      {$i-}
  872.      reset(f);
  873.      {$i+}
  874.      IF IoResult<>0 THEN
  875.      BEGIN
  876.           RaiseIOError:=b;
  877.           DosError:=ioresult;
  878.           result:=DosError;
  879.           exit;
  880.      END;
  881.      size:=sizeof(FILESTATUS3);
  882.      DosError:=DosQueryFileInfo(ff^.Handle,FIL_STANDARD,s,size);
  883.      IF DosError=0 THEN
  884.      BEGIN
  885.           Attr:=s.attrFile;
  886.      END
  887.      ELSE Attr:=0; {invalid}
  888.      {$i-}
  889.      close(f);
  890.      {$i+}
  891.      IF IoResult<>0 THEN
  892.      BEGIN
  893.           RaiseIOError:=b;
  894.           DosError:=ioresult;
  895.           result:=DosError;
  896.           exit;
  897.      END;
  898.      filemode:=SaveMode;
  899.      {$ENDIF}
  900.      {$IFDEF Win95}
  901.      name:=ff^.Name;
  902.      Attr:=GetFileAttributes(Name);
  903.      IF Attr=$ffffffff THEN DosError:=GetLastError
  904.      ELSE DosError:=0;
  905.      {$ENDIF}
  906.      RaiseIOError:=b;
  907.      result:=DosError;
  908. END;
  909.  
  910. FUNCTION SetFAttr(VAR F:FILE; Attr: LongWord):LONGINT;
  911. VAR
  912.     {$IFDEF OS2}
  913.     s:FILESTATUS3;
  914.     size:LONGWORD;
  915.     savemode:ULONG;
  916.     {$ENDIF}
  917.     {$IFDEF Win95}
  918.     Name:CSTRING;
  919.     {$ENDIF}
  920.     ff:^FileRec;
  921.     b:BOOLEAN;
  922. BEGIN
  923.      b:=RaiseIOError;
  924.      ff:=@f;
  925.      DosError:=0;
  926.      {$IFDEF OS2}
  927.      savemode:=FileMode;
  928.      filemode:=fmInOut;
  929.      {$i-}
  930.      reset(f);
  931.      {$i+}
  932.      IF IoResult<>0 THEN
  933.      BEGIN
  934.           RaiseIOError:=b;
  935.           DosError:=ioresult;
  936.           result:=DosError;
  937.           exit;
  938.      END;
  939.      size:=sizeof(FILESTATUS3);
  940.      DosQueryFileInfo(ff^.Handle,FIL_STANDARD,s,size);
  941.      IF DosError=0 THEN
  942.      BEGIN
  943.           s.attrFile:=Attr;
  944.           DosError:=DosSetFileInfo(ff^.Handle,FIL_STANDARD,s,size);
  945.      END;
  946.      {$i-}
  947.      close(f);
  948.      {$i+}
  949.      IF IoResult<>0 THEN
  950.      BEGIN
  951.           RaiseIOError:=b;
  952.           DosError:=ioresult;
  953.           result:=DosError;
  954.           exit;
  955.      END;
  956.      filemode:=SaveMode;
  957.      {$ENDIF}
  958.      {$IFDEF Win95}
  959.      Name:=ff^.Name;
  960.      IF not SetFileAttributes(Name,Attr) THEN DosError:=GetLastError
  961.      ELSE DosError:=0;
  962.      {$ENDIF}
  963.      RaiseIOError:=b;
  964.      result:=DosError;
  965. END;
  966.  
  967.  
  968. FUNCTION GetFTime2(VAR F:FILE; VAR year,month,day,Hours,Minutes,Secs:WORD):LONGINT;
  969. VAR
  970.     {$IFDEF OS2}
  971.     s:FILESTATUS3;
  972.     size:LONGWORD;
  973.     {$ENDIF}
  974.     {$IFDEF Win95}
  975.     LastAccess,Creation,LastWrite:FILETIME;
  976.     {$ENDIF}
  977.     y,m,d,h,min,sec:Word;
  978.     date,time:WORD;
  979.     ff:^FileRec;
  980. BEGIN
  981.      ff:=@f;
  982.      DosError:=0;
  983.      {$IFDEF OS2}
  984.      size:=sizeof(FILESTATUS3);
  985.      DosError:=DosQueryFileInfo(ff^.Handle,1,s,size);
  986.      IF DosError=0 THEN
  987.      BEGIN
  988.           date:=s.fdateLastWrite;
  989.           time:=s.ftimelastwrite;
  990.  
  991.           UnpackDateIntern(Date,year,month,day);
  992.           UnpackTimeIntern(Time,hours,minutes,Secs);
  993.           Secs:=Secs*2;
  994.      END
  995.      ELSE
  996.      BEGIN
  997.           day:=0;
  998.           month:=0;
  999.           year:=0;
  1000.           Hours:=0;
  1001.           Minutes:=0;
  1002.           Secs:=0;
  1003.      END;
  1004.      {$ENDIF}
  1005.      {$IFDEF Win95}
  1006.      DosError:=0;
  1007.      IF not GetFileTime(ff^.Handle,Creation,LastAccess,LastWrite) THEN
  1008.      BEGIN
  1009.           day:=0;
  1010.           month:=0;
  1011.           year:=0;
  1012.           Hours:=0;
  1013.           Minutes:=0;
  1014.           Secs:=0;
  1015.           DosError:=GetLastError;
  1016.           exit;
  1017.      END;
  1018.  
  1019.      FileTimeToDosDateTime(Creation,date,time);
  1020.  
  1021.      UnpackDateIntern(Date,year,month,day);
  1022.      UnpackTimeIntern(Time,hours,minutes,Secs);
  1023.      Secs:=Secs*2;
  1024.      {$ENDIF}
  1025.      result:=DosError;
  1026. END;
  1027.  
  1028.  
  1029. FUNCTION SetFTime2(VAR F:FILE; year,month,day,Hours,Minutes,Secs:Word):LONGINT;
  1030. VAR
  1031.     {$IFDEF OS2}
  1032.     s:FILESTATUS3;
  1033.     size:LONGWORD;
  1034.     time,date:Word;
  1035.     TwoSecs:WORD;
  1036.     {$ENDIF}
  1037.     {$IFDEF Win95}
  1038.     LastAccess,Creation,LastWrite:FILETIME;
  1039.     time,date:Word;
  1040.     TwoSecs:WORD;
  1041.     dt:DateTime;
  1042.     {$ENDIF}
  1043.     ff:^FileRec;
  1044. label l;
  1045. BEGIN
  1046.      ff:=@f;
  1047.      DosError:=0;
  1048.      {$IFDEF OS2}
  1049.      TwoSecs:=Secs DIV 2;
  1050.      IF ((Month>12)or(Month=0)) THEN
  1051.      BEGIN
  1052. l:
  1053.           DosError:=1;
  1054.           result:=DosError;
  1055.           exit;
  1056.      END;
  1057.      IF ((Day>32)or(day=0)) THEN goto l;
  1058.      IF Hours>24 THEN goto l;
  1059.      IF Minutes>60 THEN goto l;
  1060.      IF TwoSecs>30 THEN goto l;
  1061.      size:=sizeof(FILESTATUS3);
  1062.      DosError:=DosQueryFileInfo(ff^.Handle,1,s,size);
  1063.      IF DosError=0 THEN
  1064.      BEGIN
  1065.           Date:=PackDateIntern(year,month,day);
  1066.           Time:=PackTimeIntern(Hours,Minutes,TwoSecs);
  1067.  
  1068.           s.fdatelastwrite:=date;
  1069.           s.ftimeLastWrite:=time;
  1070.           DosError:=DosSetFileInfo(ff^.Handle,1,s,size);
  1071.      END;
  1072.      {$ENDIF}
  1073.      {$IFDEF Win95}
  1074.      DosError:=0;
  1075.      IF not GetFileTime(ff^.Handle,Creation,LastAccess,LastWrite) THEN
  1076.      BEGIN
  1077.           DosError:=GetLastError;
  1078.           result:=DosError;
  1079.           exit;
  1080.      END;
  1081.  
  1082.      TwoSecs:=Secs DIV 2;
  1083.      IF ((Month>12)or(Month=0)) THEN
  1084.      BEGIN
  1085. l:
  1086.           DosError:=1;
  1087.           result:=DosError;
  1088.           exit;
  1089.      END;
  1090.      IF ((Day>32)or(day=0)) THEN goto l;
  1091.      IF Hours>24 THEN goto l;
  1092.      IF Minutes>60 THEN goto l;
  1093.      IF TwoSecs>30 THEN goto l;
  1094.  
  1095.      Date:=PackDateIntern(year,month,day);
  1096.      Time:=PackTimeIntern(Hours,Minutes,TwoSecs);
  1097.  
  1098.      DosDateTimeToFileTime(date,time,Creation);
  1099.  
  1100.      IF not SetFileTime(ff^.Handle,Creation,LastAccess,LastWrite) THEN
  1101.      BEGIN
  1102.           DosError:=GetlastError;
  1103.           result:=DosError;
  1104.           exit;
  1105.      END;
  1106.      {$ENDIF}
  1107.      result:=DosError;
  1108. END;
  1109.  
  1110. FUNCTION GetFTime(VAR f:FILE;VAR Time:LONGINT):LONGINT;
  1111. VAR
  1112.    DT:DateTime;
  1113.    m,d,h,i,s:WORD;
  1114. BEGIN
  1115.      result:=GetFTime2(f,DT.year,m,d,h,i,s);
  1116.      DT.month:=m;
  1117.      DT.day:=d;
  1118.      DT.hour:=h;
  1119.      DT.min:=i;
  1120.      DT.sec:=s;
  1121.      PackTime(DT,Time);
  1122. END;
  1123.  
  1124. FUNCTION SetFTime(VAR f:FILE;Time:LONGINT):LONGINT;
  1125. VAR
  1126.    DT:DateTime;
  1127. BEGIN
  1128.      UnpackTime(time,DT);
  1129.      {DT.sec:=DT.sec DIV 2;}
  1130.      result:=SetFTime2(f,DT.year,DT.month,DT.day,DT.hour,DT.min,DT.sec);
  1131. END;
  1132.  
  1133. FUNCTION DiskFree(Drive: Byte): LongWord;
  1134. VAR
  1135.     {$IFDEF OS2}
  1136.     a:FSALLOCATE;
  1137.     {$ENDIF}
  1138.     {$IFDEF Win95}
  1139.     c:CSTRING;
  1140.     {$ENDIF}
  1141.     s,d:LONGWORD;
  1142.     sec,freesec,clust,freeclust:LONGWORD;
  1143. BEGIN
  1144.      {$IFDEF OS2}
  1145.      s:=sizeof(FSALLOCATE);
  1146.      d:=Drive;
  1147.      DosError:=DosQueryFSInfo(d,1,a,s);
  1148.      IF DosError=0 THEN s:=a.cSectorUnit*a.cUnitAvail*a.cbSector
  1149.      ELSE s:=0;
  1150.      {$ENDIF}
  1151.      {$IFDEF Win95}
  1152.      DosError:=0;
  1153.      IF Drive=0 THEN
  1154.      BEGIN
  1155.           IF not GetDiskFreeSpace(NIL,s,sec,freeclust,clust) THEN
  1156.           BEGIN
  1157.                DosError:=GetLastError;
  1158.                result:=0;
  1159.                exit;
  1160.           END;
  1161.      END
  1162.      ELSE
  1163.      BEGIN
  1164.           c:=chr(ord('A')+(Drive-1))+':\';
  1165.           IF not GetDiskFreeSpace(c,s,sec,freeclust,clust) THEN
  1166.           BEGIN
  1167.                DosError:=GetLastError;
  1168.                result:=0;
  1169.                exit;
  1170.           END;
  1171.           s:=s*sec*freeclust;
  1172.      END;
  1173.      {$ENDIF}
  1174.      DiskFree:=s;
  1175. END;
  1176.  
  1177. FUNCTION DiskSize(Drive: Byte): LongWord;
  1178. VAR
  1179.     {$IFDEF OS2}
  1180.     a:FSALLOCATE;
  1181.     {$ENDIF}
  1182.     s,d,sec,freesec,clust,freeclust:LONGWORD;
  1183.     c:CSTRING;
  1184. BEGIN
  1185.      {$IFDEF OS2}
  1186.      s:=sizeof(FSALLOCATE);
  1187.      d:=Drive;
  1188.      DosErrorAPI(0); /* Action flag for disable */
  1189.      DosError:=DosQueryFSInfo(d,1,a,s);
  1190.      DosErrorAPI(1); /* Action flag for enable */
  1191.      IF DosError=0 THEN s:=a.cSectorUnit*a.cUnit*a.cbSector
  1192.      ELSE s:=$FFFFFFFF;
  1193.      {$ENDIF}
  1194.      {$IFDEF Win95}
  1195.      DosError:=0;
  1196.      IF Drive=0 THEN
  1197.      BEGIN
  1198.           IF not GetDiskFreeSpace(NIL,s,sec,freeclust,clust) THEN
  1199.           BEGIN
  1200.                DosError:=GetLastError;
  1201.                result:=$FFFFFFFF;
  1202.                exit;
  1203.           END;
  1204.      END
  1205.      ELSE
  1206.      BEGIN
  1207.           c:=chr(ord('A')+(Drive-1))+':\';
  1208.           IF not GetDiskFreeSpace(c,s,sec,freeclust,clust) THEN
  1209.           BEGIN
  1210.                DosError:=GetLastError;
  1211.                result:=$FFFFFFFF;
  1212.                exit;
  1213.           END;
  1214.           s:=s*sec*clust;
  1215.      END;
  1216.      {$ENDIF}
  1217.      DiskSize:=s;
  1218. END;
  1219.  
  1220. FUNCTION EnvStr(Index:LONGINT):String;
  1221. VAR
  1222.   P:^CSTRING;
  1223.   Count: Integer;
  1224. BEGIN
  1225.   ASM
  1226.      MOV EAX,SYSTEM.EnvStart
  1227.      MOV $P,EAX
  1228.   END;
  1229.   result:= '';
  1230.   IF ((Index>0)AND(P<>NIL)) THEN
  1231.   BEGIN
  1232.        Count := 1;
  1233.        WHILE ((Count<Index)AND(P^[0]<>#0)) DO
  1234.        BEGIN
  1235.             WHILE P^[1]<>#0 DO inc(P);
  1236.             inc(P);
  1237.             inc(P);
  1238.             Inc(Count);
  1239.        END;
  1240.        EnvStr := P^;
  1241.   END;
  1242. END;
  1243.  
  1244. FUNCTION EnvCount:LONGINT;
  1245. VAR
  1246.   P:^CSTRING;
  1247. BEGIN
  1248.   ASM
  1249.      MOV EAX,SYSTEM.EnvStart
  1250.      MOV $P,EAX
  1251.   END;
  1252.   result:=0;
  1253.   IF P<>NIL THEN
  1254.   BEGIN
  1255.        WHILE P^[0]<>#0 DO
  1256.        BEGIN
  1257.             WHILE P^[1]<>#0 DO inc(P);
  1258.             inc(P);
  1259.             inc(P);
  1260.             Inc(Result);
  1261.        END;
  1262.   END;
  1263. END;
  1264.  
  1265.  
  1266. FUNCTION GetEnv(CONST Env:String):String;
  1267. VAR
  1268.    e:PChar;
  1269.    c,c1:CSTRING;
  1270.    res:LONGWORD;
  1271. BEGIN
  1272.      c:=Env;
  1273.      {$IFDEF OS2}
  1274.      DosError:=DosScanEnv(c,e);
  1275.      {$ENDIF}
  1276.      {$IFDEF Win95}
  1277.      res:=GetEnvironmentVariable(c,c1,255);
  1278.      IF res=0 THEN DosError:=GetLastError
  1279.      ELSE e:=@c1;
  1280.      {$ENDIF}
  1281.      IF DosError<>0 THEN GetEnv:=''
  1282.      ELSE GetEnv:=e^;
  1283. END;
  1284.  
  1285. FUNCTION GetVerify(VAR Verify: Boolean):LONGINT;
  1286. VAR
  1287.    v:LONGWORD;
  1288. BEGIN
  1289.      {$IFDEF OS2}
  1290.      DosError:=DosQueryVerify(v);
  1291.      Verify:=v<>0;
  1292.      {$ENDIF}
  1293.      {$IFDEF Win95}
  1294.      DosError:=1;   //not supported
  1295.      {$ENDIF}
  1296.      result:=DosError;
  1297. END;
  1298.  
  1299. FUNCTION SetVerify(Verify: Boolean):LONGINT;
  1300. VAR
  1301.    v:LONGWORD;
  1302. BEGIN
  1303.      {$IFDEF OS2}
  1304.      v:=BYTE(Verify);
  1305.      DosError:=DosSetVerify(v);
  1306.      {$ENDIF}
  1307.      {$IFDEF Win95}
  1308.      DosError:=1;   //not supported
  1309.      {$ENDIF}
  1310.      result:=DosError;
  1311. END;
  1312.  
  1313. FUNCTION DosVersion:LongWord;
  1314. VAR
  1315.    MinorVersion,MajorVersion:LONGWORD;
  1316. BEGIN
  1317.      {$IFDEF OS2}
  1318.      DosQuerySysInfo(QSV_VERSION_MAJOR,QSV_VERSION_MAJOR,MajorVersion,4);
  1319.      DosQuerySysInfo(QSV_VERSION_MINOR,QSV_VERSION_MINOR,MinorVersion,4);
  1320.      DosVersion:=MajorVersion OR MINORVERSION SHL 8;
  1321.      {$ENDIF}
  1322.      {$IFDEF Win95}
  1323.      result:=GetVersion;
  1324.      {$ENDIF}
  1325. END;
  1326.  
  1327. FUNCTION GetDate(var Year,Month,Day,DayOfWeek: Word):LONGINT;
  1328. {$IFDEF OS2}
  1329. VAR d:DateTime;
  1330. {$ENDIF}
  1331. {$IFDEF Win95}
  1332. VAR d:SYSTEMTIME;
  1333. {$ENDIF}
  1334. BEGIN
  1335.      {$IFDEF OS2}
  1336.      DosGetDateTime(d);
  1337.      DosError:=0;
  1338.      Year:=d.year;
  1339.      Month:=d.month;
  1340.      Day:=d.Day;
  1341.      DayofWeek:=d.Weekday;
  1342.      {$ENDIF}
  1343.      {$IFDEF Win95}
  1344.      DosError:=0;
  1345.      GetSystemTime(d);
  1346.      Year:=d.wYear;
  1347.      Month:=d.wMonth;
  1348.      Day:=d.wDay;
  1349.      DayofWeek:=d.wDayOfWeek;
  1350.      {$ENDIF}
  1351.      result:=DosError;
  1352. END;
  1353.  
  1354. FUNCTION SetDate(Year,Month,Day: Word):LONGINT;
  1355. {$IFDEF OS2}
  1356. VAR d:DateTime;
  1357. {$ENDIF}
  1358. {$IFDEF Win95}
  1359. VAR d:SYSTEMTIME;
  1360. {$ENDIF}
  1361. BEGIN
  1362.      {$IFDEF OS2}
  1363.      DosGetDateTime(d);
  1364.      DosError:=0;
  1365.      d.year:=Year;
  1366.      d.month:=Month;
  1367.      d.day:=day;
  1368.      d.Weekday:=0;
  1369.      DosSetDateTime(d);
  1370.      {$ENDIF}
  1371.      {$IFDEF Win95}
  1372.      DosError:=0;
  1373.      GetSystemTime(d);
  1374.      d.wYear:=Year;
  1375.      d.wMonth:=Month;
  1376.      d.wDay:=Day;
  1377.      d.wDayOfWeek:=0;
  1378.      SetSystemTime(d);
  1379.      {$ENDIF}
  1380.      result:=DosError;
  1381. END;
  1382.  
  1383. FUNCTION GetTime(var Hour,Minute,Second,Sec100: Word):LONGINT;
  1384. {$IFDEF OS2}
  1385. VAR d:DateTime;
  1386. {$ENDIF}
  1387. {$IFDEF Win95}
  1388. VAR d:SYSTEMTIME;
  1389. {$ENDIF}
  1390. BEGIN
  1391.      {$IFDEF OS2}
  1392.      DosGetDateTime(d);
  1393.      DosError:=0;
  1394.      Hour:=d.hour;
  1395.      Minute:=d.min;
  1396.      Second:=d.Sec;
  1397.      Sec100:=d.Hundredths;
  1398.      {$ENDIF}
  1399.      {$IFDEF Win95}
  1400.      DosError:=0;
  1401.      GetSystemTime(d);
  1402.      Hour:=d.wHour;
  1403.      Minute:=d.wMinute;
  1404.      Second:=d.wSecond;
  1405.      Sec100:=d.wMilliseconds;
  1406.      {$ENDIF}
  1407.      result:=DosError;
  1408. END;
  1409.  
  1410. FUNCTION SetTime(Hour,Minute,Second,Sec100: Word):LONGINT;
  1411. {$IFDEF OS2}
  1412. VAR d:DateTime;
  1413. {$ENDIF}
  1414. {$IFDEF Win95}
  1415. VAR d:SYSTEMTIME;
  1416. {$ENDIF}
  1417. BEGIN
  1418.      {$IFDEF OS2}
  1419.      DosGetDateTime(d);
  1420.      DosError:=0;
  1421.      d.Hour:=Hour;
  1422.      d.Min:=Minute;
  1423.      d.Sec:=Second;
  1424.      d.Hundredths:=Sec100;
  1425.      DosSetDateTime(d);
  1426.      {$ENDIF}
  1427.      {$IFDEF Win95}
  1428.      DosError:=0;
  1429.      GetSystemTime(d);
  1430.      d.wHour:=Hour;
  1431.      d.wMinute:=Minute;
  1432.      d.wSecond:=Second;
  1433.      d.wMilliseconds:=sec100;
  1434.      SetSystemTime(d);
  1435.      {$ENDIF}
  1436.      result:=DosError;
  1437. END;
  1438.  
  1439. FUNCTION CompareFileTimes(First,Second:STRING):BYTE;
  1440. VAR f1,f2:FILE;
  1441.     result:BYTE;
  1442.     year1,month1,day1,Hours1,Minutes1,Secs1:WORD;
  1443.     year2,month2,day2,Hours2,Minutes2,Secs2:WORD;
  1444.     b:BOOLEAN;
  1445. Label l;
  1446. BEGIN
  1447.      b:=RaiseIOError;
  1448.      result:=F_ERROR;
  1449.      assign(f1,first);
  1450.      {$i-}
  1451.      reset(f1,1);
  1452.      {$i+}
  1453.      IF IoResult<>0 THEN goto l;
  1454.      GetFTime2(f1,year1,month1,day1,Hours1,Minutes1,Secs1);
  1455.      IF DosError<>0 THEN
  1456.      BEGIN
  1457.           {$i-}
  1458.           Close(f1);
  1459.           {$i+}
  1460.           IF IoResult<>0 THEN
  1461.           BEGIN
  1462.                RaiseIOError:=b;
  1463.                CompareFileTimes:=result;
  1464.                exit;
  1465.           END;
  1466.           goto l;
  1467.      END;
  1468.      {$i-}
  1469.      Close(f1);
  1470.      {$i+}
  1471.      IF IoResult<>0 THEN
  1472.      BEGIN
  1473.           RaiseIOError:=b;
  1474.           CompareFileTimes:=result;
  1475.           exit;
  1476.      END;
  1477.  
  1478.      assign(f2,second);
  1479.      {$i-}
  1480.      reset(f2,1);
  1481.      {$i+}
  1482.      IF IOResult<>0 THEN
  1483.      BEGIN
  1484.           RaiseIOError:=b;
  1485.           CompareFileTimes:=result;
  1486.           exit;
  1487.      END;
  1488.      GetFTime2(f2,year2,month2,day2,Hours2,Minutes2,Secs2);
  1489.      IF DosError<>0 THEN
  1490.      BEGIN
  1491.           {$i-}
  1492.           Close(f2);
  1493.           {$i+}
  1494.           IF IoResult<>0 THEN
  1495.           BEGIN
  1496.                RaiseIOError:=b;
  1497.                CompareFileTimes:=result;
  1498.                exit;
  1499.           END;
  1500.           goto l;
  1501.      END;
  1502.      {$i-}
  1503.      Close(f2);
  1504.      {$i+}
  1505.      IF IoResult<>0 THEN
  1506.      BEGIN
  1507.           RaiseIOError:=b;
  1508.           CompareFileTimes:=result;
  1509.           exit;
  1510.      END;
  1511.  
  1512.      IF year1=year2 THEN
  1513.      BEGIN
  1514.           IF month1=month2 THEN
  1515.           BEGIN
  1516.                IF Day1=Day2 THEN
  1517.                BEGIN
  1518.                     IF Hours1=Hours2 THEN
  1519.                     BEGIN
  1520.                          IF Minutes1=Minutes2 THEN
  1521.                          BEGIN
  1522.                               IF Secs1=Secs2 THEN result:=F_EQUAL
  1523.                               ELSE
  1524.                               BEGIN
  1525.                                    IF Secs1>Secs2 THEN Result:=F_FIRST_GREATER
  1526.                                    ELSE Result:=F_SECOND_GREATER;
  1527.                               END;
  1528.                          END
  1529.                          ELSE
  1530.                          BEGIN
  1531.                               IF Minutes1>Minutes2 THEN Result:=F_FIRST_GREATER
  1532.                               ELSE Result:=F_SECOND_GREATER;
  1533.                          END;
  1534.                     END
  1535.                     ELSE
  1536.                     BEGIN
  1537.                          IF Hours1>Hours2 THEN Result:=F_FIRST_GREATER
  1538.                          ELSE Result:=F_SECOND_GREATER;
  1539.                     END;
  1540.                END
  1541.                ELSE
  1542.                BEGIN
  1543.                     IF day1>day2 THEN Result:=F_FIRST_GREATER
  1544.                     ELSE Result:=F_SECOND_GREATER;
  1545.                END;
  1546.           END
  1547.           ELSE
  1548.           BEGIN
  1549.                IF month1>month2 THEN Result:=F_FIRST_GREATER
  1550.                ELSE Result:=F_SECOND_GREATER;
  1551.           END;
  1552.      END
  1553.      ELSE
  1554.      BEGIN
  1555.           IF year1>year2 THEN Result:=F_FIRST_GREATER
  1556.           ELSE Result:=F_SECOND_GREATER;
  1557.      END;
  1558.  
  1559. l:
  1560.      CompareFileTimes:=Result;
  1561.      RaiseIOError:=b;
  1562. END;
  1563.  
  1564. PROCEDURE Flush (VAR F:FILE);
  1565. BEGIN
  1566. END;
  1567.  
  1568. BEGIN
  1569. END.
  1570.