home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / sibdemo3.zip / SOURCE.DAT / SOURCE / RTL / DOS.PAS < prev    next >
Pascal/Delphi Source File  |  1998-05-19  |  46KB  |  1,729 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,PMWin,BseTib;
  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. ThreadVar
  132.          DosError:LongInt;   {DOS unit error status}
  133.  
  134. CONST
  135.     ExecViaSession:BOOLEAN=TRUE; {Set to TRUE if you want to
  136.                                   use Exec on another session.
  137.                                   Then you cannot get the result
  138.                                   code but you can wait via
  139.                                   DosExitCode for the session to
  140.                                   terminate}
  141.     AsynchEXEC:BOOLEAN=TRUE;      {Standard: asynchronous EXEC}
  142.     LastExecResult:LONGWORD=0;
  143.  
  144. {Time/Date functions}
  145. FUNCTION GetDate(VAR Year,Month,Day,DayOfWeek: Word):LONGINT;
  146. FUNCTION SetDate(Year,Month,Day: Word):LONGINT;
  147. FUNCTION GetTime(VAR Hour,Minute,Second,Sec100: Word):LONGINT;
  148. FUNCTION SetTime(Hour,Minute,Second,Sec100: Word):LONGINT;
  149. FUNCTION GetFAttr(VAR F:FILE; VAR Attr: LongWord):LONGINT;
  150. FUNCTION SetFAttr(VAR F:FILE; Attr: LongWord):LONGINT;
  151. FUNCTION GetFTime(VAR F:FILE;VAR Time:LONGINT):LONGINT;
  152. FUNCTION SetFTime(VAR F:FILE;Time:LONGINT):LONGINT;
  153. FUNCTION GetFTime2(VAR F:FILE; VAR year,month,day,hours,minutes,secs:Word):LONGINT;
  154. FUNCTION SetFTime2(VAR F:FILE; year,month,day,hours,minutes,secs:Word):LONGINT;
  155. PROCEDURE PackTime(VAR T: DateTime; VAR Time: Longint);
  156. PROCEDURE UnpackTime(Time: Longint; VAR DT: DateTime);
  157.  
  158. {File find functions}
  159. FUNCTION FindFirst(Path: PathStr; Attr: LongWord; var F: SearchRec):LONGINT;
  160. FUNCTION FindNext(var F: SearchRec):LONGINT;
  161. PROCEDURE FindClose(var F: SearchRec);
  162. FUNCTION FSearch(Path: PathStr; DirList: String): PathStr;
  163.  
  164. {Common functions}
  165. FUNCTION  DosVersion:LongWord;
  166. FUNCTION GetVerify(var Verify: Boolean):LONGINT;
  167. FUNCTION SetVerify(Verify: Boolean):LONGINT;
  168. FUNCTION  GetEnv(CONST env:STRING):STRING;
  169. FUNCTION EnvStr(Index:LONGINT):STRING;
  170. FUNCTION EnvCount:LONGINT;
  171. PROCEDURE SwapVectors; {ignored}
  172.  
  173. {Disk functions}
  174. FUNCTION  DiskFree(Drive: Byte): LongWord;
  175. FUNCTION  DiskSize(Drive: Byte): LongWord;
  176. FUNCTION  FExpand(Path: PathStr): PathStr;
  177. FUNCTION  FSplit(CONST Path: PathStr;VAR Dir: DirStr;
  178.                  VAR Name: NameStr;VAR Ext: ExtStr):LONGINT;
  179. FUNCTION  CompareFileTimes(First,Second:STRING):BYTE;
  180.  
  181. {Process functions}
  182. FUNCTION Exec(CONST Path: PathStr; CmdLine: STRING):LONGWORD;
  183. FUNCTION DosExitCode(SessID:LONGWORD):LONGWORD;
  184. FUNCTION ProcessActive(pid:LONGWORD):BOOLEAN;
  185. FUNCTION KillProcess(pid:LONGWORD):LONGINT;
  186.  
  187. {Thread functions}
  188. FUNCTION StartThread(ThreadAddr:POINTER;StackSize:LONGWORD;
  189.                       Params:POINTER;VAR Tid:LONGWORD):LONGINT;
  190. FUNCTION SuspendThread(Tid:LONGWORD):LONGINT;
  191. FUNCTION ResumeThread(Tid:LONGWORD):LONGINT;
  192. FUNCTION KillThread(Tid:LONGWORD):LONGINT;
  193. PROCEDURE Flush (VAR F:FILE);
  194.  
  195. PROCEDURE Delay(ms:LONGWORD);
  196.  
  197. IMPLEMENTATION
  198.  
  199. VAR
  200.    TempCmdLine:STRING;
  201.  
  202. PROCEDURE Delay(ms:LONGWORD);
  203. BEGIN
  204.      {$IFDEF OS2}
  205.      DosSleep(ms);
  206.      {$ENDIF}
  207.      {$IFDEF Win95}
  208.      Sleep(ms);
  209.      {$ENDIF}
  210. END;
  211.  
  212. PROCEDURE SwapVectors;
  213. BEGIN
  214.      {This function is ignored}
  215.      DosError:=0;
  216. END;
  217.  
  218. FUNCTION FExpand(Path:PathStr):PathStr;
  219. VAR  i,p,t:BYTE;
  220.      s:STRING;
  221. LABEL l,l2;
  222. BEGIN
  223.      t := pos(';',Path);
  224.      IF t <> 0 THEN
  225.      BEGIN
  226.           s := Path;
  227.           delete(s,1,t);
  228.           Path[0] := chr(t);
  229.           Path := Path + FExpand(s);
  230.      END;
  231.  
  232.      GetDir(0,s);
  233.      IF length(s)=3 THEN IF s[2]=':' THEN IF s[3] IN ['\','/'] THEN dec(s[0]);
  234.  
  235.      IF pos('\',Path) = 1 THEN Path := copy(s,1,2) + Path;
  236.      IF (Length(Path) >= 2) AND (Path[2] = ':') THEN
  237.      BEGIN
  238.           s := copy(Path,1,2);
  239.           delete(Path,1,2);
  240.      END;
  241.      IF not (Path[1] IN ['\','/']) THEN Path := '\'+ Path;
  242.  
  243.      REPEAT
  244.            IF ((pos('\..',Path) = 1)OR(pos('/..',Path) = 1)) THEN
  245.            BEGIN
  246.                 IF (Length(Path) >= 4) AND (not (Path[4] IN ['\','/'])) THEN goto l2;
  247.                 delete(Path,1,3);
  248.                 FOR i := Length(s) DOWNTO 3 DO
  249.                 BEGIN
  250.                      IF s[i] = ':' THEN break;
  251.                      dec(s[0]);
  252.                      IF s[i] IN ['\','/'] THEN break;
  253.                 END;
  254.            END
  255.            ELSE
  256.            IF ((pos('\.',Path) = 1)OR(pos('/.',Path) =1)) THEN
  257.            BEGIN
  258.                 IF (Length(Path) >= 3) AND (not (Path[3] IN ['\','/'])) THEN goto l2;
  259.                 delete(Path,1,2);
  260.            END
  261.            ELSE
  262.            IF ((pos('\',Path) = 1)OR(pos('/',Path) = 1)) THEN
  263.            BEGIN
  264. l2:
  265.                 delete(Path,1,1);
  266.                 s := s + '\';
  267.            END
  268.            ELSE
  269.            BEGIN
  270. l:
  271.                 p := pos('\',Path);
  272.                 IF p=0 THEN p := pos('/',Path);
  273.                 IF p > 0 THEN
  274.                 BEGIN
  275.                      s := s + copy(Path,1,p-1);
  276.                      delete(Path,1,p-1);
  277.                 END
  278.                 ELSE
  279.                 BEGIN
  280.                      s := s + Path;
  281.                      Path := '';
  282.                 END;
  283.            END;
  284.      UNTIL Path = '';
  285.      IF Length(s) = 2 THEN s := s +'\';
  286.  
  287.      Result := s;
  288. END;
  289.  
  290. FUNCTION KillThread(Tid:LONGWORD):LONGINT;
  291. BEGIN
  292.      {$IFDEF OS2}
  293.      DosError:=DosKillThread(Tid);
  294.      {$ENDIF}
  295.      {$IFDEF Win95}
  296.      DosError:=BYTE(CloseHandle(Tid)=FALSE);
  297.      {$ENDIF}
  298.      result:=DosError;
  299. END;
  300.  
  301. FUNCTION SuspendThread(Tid:LONGWORD):LONGINT;
  302. BEGIN
  303.      {$IFDEF OS2}
  304.      DosError:=DosSuspendThread(Tid);
  305.      {$ENDIF}
  306.      {$IFDEF Win95}
  307.      DosError:=BYTE(WinBase.SuspendThread(Tid)=$FFFFFFFF);
  308.      {$ENDIF}
  309.      result:=DosError;
  310. END;
  311.  
  312. FUNCTION ResumeThread(Tid:LONGWORD):LONGINT;
  313. BEGIN
  314.      {$IFDEF OS2}
  315.      DosError:=DosResumeThread(Tid);
  316.      {$ENDIF}
  317.      {$IFDEF Win95}
  318.      DosError:=BYTE(WinBase.ResumeThread(Tid)=$FFFFFFFF);
  319.      {$ENDIF}
  320.      result:=DosError;
  321. END;
  322.  
  323. FUNCTION StartThread(ThreadAddr:POINTER;StackSize:LONGWORD;
  324.                       Params:POINTER;VAR Tid:LONGWORD):LONGINT;
  325. {$IFDEF WIN95}
  326. VAR id:LONGWORD;
  327. {$ENDIF}
  328. BEGIN
  329.      {$IFDEF OS2}
  330.      DosError:=DosCreateThread(Tid,ThreadAddr,Params,
  331.                                STACK_SPARSE,StackSize);
  332.      {$ENDIF}
  333.      {$IFDEF Win95}
  334.      Tid:=WinBase.CreateThread(NIL,StackSize,ThreadAddr,Params,0,id);
  335.      IF Tid=0 THEN DosError:=1
  336.      ELSE DosError:=0;
  337.      {$ENDIF}
  338.      result:=DosError;
  339. END;
  340.  
  341.  
  342. FUNCTION KillProcess(pid:LONGWORD):LONGINT;
  343. BEGIN
  344.      {$IFDEF OS2}
  345.      DosError:=DosKillProcess(0,pid);
  346.      {$ENDIF}
  347.      {$IFDEF Win95}
  348.      DosError:=BYTE(TerminateProcess(pid,0)=FALSE);
  349.      {$ENDIF}
  350.      result:=DosError;
  351. END;
  352.  
  353. FUNCTION ProcessActive(pid:LONGWORD):BOOLEAN;
  354. VAR r,rpid:LONGWORD;
  355.     {$IFDEF OS2}
  356.     res:Execresultcode;
  357.     {$ENDIF}
  358. BEGIN
  359.      {$IFDEF OS2}
  360.      r:=DosWaitChild(DCWA_PROCESS,DCWW_NOWAIT,res,rpid,pid);
  361.      DosError:=r;
  362.      IF r=129 {child not complete} THEN ProcessActive:=TRUE
  363.      ELSE ProcessActive:=FALSE; {Child complete or illegal pid}
  364.      {$ENDIF}
  365.      {$IFDEF Win95}
  366.      DosError:=1;  //not supported
  367.      {$ENDIF}
  368. END;
  369.  
  370. FUNCTION FSplit(CONST Path: PathStr;
  371.                  VAR Dir:DirStr;VAR Name:NameStr;VAR Ext:ExtStr):LONGINT;
  372. Var  i    : Integer ;
  373.      Trv  : Boolean ;
  374. Begin
  375.      Trv:=False ;
  376.      For i:=Length(Path) DownTo 1 Do
  377.      If (Path[i] IN ['\','/']) Or (Path[i]=':') Then
  378.      Begin
  379.           Trv:=True ;
  380.           Dir:=Copy(Path, 1, i) ;       { or i-1 if Path[i]='\' ? }
  381.           IF Dir[length(Dir)]='/' THEN Dir[length(Dir)]:='\';
  382.           Name:=Copy(Path, i+1, 255) ;
  383.           Break ;
  384.      End ;
  385.      If Not Trv Then
  386.      Begin
  387.           Dir:='' ;
  388.           Name:=Path ;
  389.      End ;
  390.  
  391.      Trv:=False ;
  392.      For i:=Length(Name) DownTo 1 Do
  393.      If Name[i]='.' Then
  394.      Begin
  395.           Trv:=True ;
  396.           Ext:=Copy(Name, i, 255) ;
  397.           Name:=Copy(Name, 1, i-1) ;
  398.           Break ;
  399.      End ;
  400.      If Not Trv Then Ext:='' ;
  401.      result:=0;
  402. End;
  403.  
  404.  
  405. FUNCTION FSearch(Path: PathStr; DirList: String): PathStr;
  406. var
  407.    r,c,c1:CSTRING;
  408.    {$IFDEF Win95}
  409.    p:PChar;
  410.    {$ENDIF}
  411. BEGIN
  412.      c:=DirList;
  413.      c1:=Path;
  414.      {$IFDEF OS2}
  415.      DosError:=DosSearchPath(0,c,c1,r,255);
  416.      {$ENDIF}
  417.      {$IFDEF Win95}
  418.      DosError:=BYTE(SearchPath(c,c1,NIL,255,r,p)=0);
  419.      {$ENDIF}
  420.      IF DosError<>0 THEN r:='';
  421.      FSearch:=r;
  422. END;
  423.  
  424. FUNCTION PackTimeIntern(hour,minute,twosec:Word):Word;
  425. VAR time:Word;
  426. BEGIN
  427.      ASM
  428.         MOV BL,Hour
  429.         SHL BL,3          //multiply with 8
  430.         MOV AL,minute
  431.         SHR AL,3          //divide by 8
  432.         ADD AL,BL
  433.         SHL AX,8          //Shift
  434.         MOV time,AX
  435.  
  436.         MOV BL,minute
  437.         AND BL,7
  438.         SHL BL,5          //multiply with 2 and shift
  439.         ADD BL,TwoSec
  440.         MOV time,BL
  441.      END;
  442.      DosError:=0;
  443.      PackTimeIntern:=Time;
  444. END;
  445.  
  446. FUNCTION PackdateIntern(year,month,day:Word):Word;
  447. VAR Date:Word;
  448. BEGIN
  449.      ASM
  450.         MOV AL,month
  451.         MOV BL,0
  452.         CMP AL,7
  453.         JNA !mo1
  454.         MOV BL,1
  455.         SUB AL,8
  456. !mo1:
  457.         MOV CX,year
  458.         SUB CX,1980
  459.         SHL CX,1          //multiply with 2
  460.         MOVZX BX,BL
  461.         ADD CX,BX
  462.         SHL CX,8         //Shift
  463.         MOV Date,CX
  464.  
  465.         SHL AL,5         //multiply month with 2 and shift
  466.         ADD AL,Day
  467.         MOV Date,AL
  468.      END;
  469.      DosError:=0;
  470.      PackDateIntern:=Date;
  471. END;
  472.  
  473. PROCEDURE PackTime(var T: DateTime; var Time: Longint);
  474. VAR year,month,day,hour,min,sec:WORD;
  475. BEGIN
  476.      year:=T.year;
  477.      month:=T.month;
  478.      day:=T.day;
  479.      hour:=T.hour;
  480.      min:=T.min;
  481.      sec:=T.sec;
  482.      ASM
  483.         MOV AX,year
  484.         SUB AX,1980
  485.         MOV CL,9
  486.         SHL AX,CL
  487.         XCHG AX,DX
  488.         MOV AX,month
  489.         MOV CL,5
  490.         SHL AX,CL
  491.         ADD DX,AX
  492.         MOV AX,day
  493.         ADD DX,AX
  494.         MOV AX,hour
  495.         MOV CL,11
  496.         SHL AX,CL
  497.         XCHG AX,BX
  498.         MOV AX,min
  499.         MOV CL,5
  500.         SHL AX,CL
  501.         ADD BX,AX
  502.         MOV AX,sec
  503.         SHR AX,1
  504.         ADD AX,BX
  505.         MOV EDI,Time
  506.         CLD
  507.         STOSW
  508.         XCHG AX,DX
  509.         STOSW
  510.      END;
  511. END;
  512.  
  513. PROCEDURE UnPackTimeIntern(pack:Word;var hour,minute,twosec:Word);
  514. VAR h,min,sec:WORD;
  515. BEGIN
  516.     ASM
  517.        MOV DX,pack
  518.  
  519.        MOV AL,DH    //Hour/Minute
  520.        AND AL,248   //Mask Hour
  521.        SHR AL,3     //divide by 8
  522.        MOVZX AX,AL
  523.        MOV h,AX
  524.  
  525.        MOV AL,DH    //Hour/Minute
  526.        AND AL,7     //Mask Minute
  527.        SHL AL,3     //multiply with 8
  528.        MOV BL,AL
  529.  
  530.        MOV AL,DL    //Minute/sec
  531.        AND AL,224   //Mask minute
  532.        SHR AL,5     //divide by 2 and shift
  533.        ADD AL,BL
  534.        MOVZX AX,AL
  535.        MOV min,AX
  536.  
  537.        MOV AL,DL    //Minute/sec
  538.        AND AL,31    //Mask twoseconds
  539.        MOVZX AX,AL
  540.        MOV sec,AX
  541.      END;
  542.      DosError:=0;
  543.      Hour:=h;
  544.      minute:=min;
  545.      twosec:=sec;
  546. END;
  547.  
  548. PROCEDURE UnPackDateIntern(pack:Word;var year,month,day:Word);
  549. VAR y,m,dy:Word;
  550. BEGIN
  551.      ASM
  552.         MOV DX,pack
  553.  
  554.         MOV AL,DH    //Year/Month
  555.         AND AL,254   //Clear Bit 1
  556.         SHR AL,1     //Divide by 2
  557.         MOVZX AX,AL
  558.         ADD AX,1980
  559.         MOV y,AX     //Year
  560.         MOV BL,0
  561.         MOV AL,DH    //Year/Month
  562.         AND AL,1     //Mask HSB month
  563.         CMP AL,1
  564.         JNE !ml7
  565.         MOV BL,8
  566. !ml7:
  567.         MOV AL,DL    //month/Day
  568.         AND AL,224   //mask month (upper 3 bits)
  569.         SHR AL,5     //divide by 2 and shift
  570.         ADD AL,BL
  571.         MOVZX AX,AL
  572.         MOV m,AX     //Month
  573.  
  574.         MOV AL,DL    //Month/day
  575.         AND AL,31    //Mask day
  576.         MOVZX AX,AL
  577.         MOV dy,AX    //day
  578.      END;
  579.      DosError:=0;
  580.      year:=y;
  581.      month:=m;
  582.      day:=dy;
  583. END;
  584.  
  585. PROCEDURE UnpackTime(Time: Longint; var DT: DateTime);
  586. VAR
  587.     y,m,dy,h,mi,s:WORD;
  588. BEGIN
  589.      ASM
  590.         MOV AX,Time+2
  591.         MOV CL,9
  592.         SHR AX,CL
  593.         ADD AX,1980
  594.         MOV y,AX
  595.         MOV AX,Time+2
  596.         MOV CL,5
  597.         SHR AX,CL
  598.         AND AX,15
  599.         MOV m,AX
  600.         MOV AX,Time+2
  601.         AND AX,31
  602.         MOV dy,AX
  603.         MOV AX,Time
  604.         MOV CL,11
  605.         SHR AX,CL
  606.         MOV h,AX
  607.         MOV AX,Time
  608.         MOV CL,5
  609.         SHR AX,CL
  610.         AND AX,63
  611.         MOV mi,AX
  612.         MOV AX,Time
  613.         AND AX,31
  614.         SHL AX,1
  615.         MOV s,AX
  616.      END;
  617.      DosError:=0;
  618.      DT.year:=y;
  619.      DT.month:=m;
  620.      DT.day:=dy;
  621.      DT.hour:=h;
  622.      DT.min:=mi;
  623.      DT.sec:=s;
  624.      DT.hundredths:=0;
  625. END;
  626.  
  627. FUNCTION FindFirst(Path: PathStr; Attr: LongWord; var F: SearchRec):LONGINT;
  628. VAR
  629.     count,tt:LONGWORD;
  630.     c:CSTRING;
  631.     {$IFDEF WIN32}
  632.     Actual:FILETIME;
  633.     date,time:Word;
  634.     {$ENDIF}
  635. BEGIN
  636.      c:=Path;
  637.      DosError:=0;
  638.      {$IFDEF OS2}
  639.      F.HDir:=-1;  {HDIR_CREATE}
  640.      count:=1;
  641.      DosError:=DosFindFirst(c,F.Hdir,Attr,F.SearchRecIntern,
  642.                             sizeof(FILEFINDBUF3),count,FIL_STANDARD);
  643.      IF ((DosError<>0)or(Count=0)) THEN
  644.      BEGIN
  645.           IF DosError=0 THEN DosError:=18;
  646.           FindClose(F);
  647.           result:=DosError;
  648.           exit;
  649.      END;
  650.      tt:=F.SearchRecIntern.fdateLastWrite;
  651.      f.Time:=(tt SHL 16)+F.SearchRecIntern.ftimeLastWrite;
  652.      f.Size:=F.SearchRecIntern.cbFile;
  653.      f.Attr:=F.SearchRecIntern.AttrFile;
  654.      f.Name:=F.SearchRecIntern.achName;
  655.      {$ENDIF}
  656.      {$IFDEF Win95}
  657.      F.InternalAttr:=Attr;
  658.      F.HDir:=FindFirstFile(c,F.SearchRecIntern);
  659.      IF F.HDir=INVALID_HANDLE_VALUE THEN
  660.      BEGIN
  661.           DosError:=18;
  662.           result:=DosError;
  663.           exit;
  664.      END;
  665.      WHILE F.SearchRecIntern.dwFileAttributes AND F.InternalAttr=0 DO
  666.      BEGIN
  667.           IF FindNextFile(F.HDir,F.SearchRecIntern)=FALSE THEN
  668.           BEGIN
  669.                WinBase.FindClose(F.HDir);
  670.                DosError:=18;
  671.                result:=DosError;
  672.                exit;
  673.           END;
  674.      END;
  675.  
  676.      FileTimeToLocalFileTime(F.SearchRecIntern.ftLastWriteTime,Actual);
  677.      FileTimeToDosDateTime(Actual,date,time);
  678.      f.Time:=(date Shl 16) Or Time;
  679.      f.Size:=F.SearchRecIntern.nFileSizeLow;
  680.      f.Attr:=F.SearchRecIntern.dwFileAttributes;
  681.      f.Name:=CSTRING(F.SearchRecIntern.cFileName);
  682.      {$ENDIF}
  683.      result:=DosError;
  684. END;
  685.  
  686. FUNCTION FindNext(var F: SearchRec):LONGINT;
  687. VAR
  688.     Count,tt:LONGWORD;
  689.     {$IFDEF WIN32}
  690.     Actual:FILETIME;
  691.     date,time:Word;
  692.     {$ENDIF}
  693. BEGIN
  694.      DosError:=0;
  695.      {$IFDEF OS2}
  696.      Count:=1;
  697.      DosError:=DosFindNext(F.Hdir,F.SearchRecIntern,
  698.                            sizeof(FILEFINDBUF3),count);
  699.      IF ((DosError<>0)or(Count=0)) THEN
  700.      BEGIN
  701.           IF DosError=0 THEN DosError:=18;
  702.           FindClose(F);
  703.           result:=DosError;
  704.           exit;
  705.      END;
  706.      tt:=F.SearchRecIntern.fdateLastWrite;
  707.      f.Time:=(tt SHL 16)+F.SearchRecIntern.ftimeLastWrite;
  708.      f.Size:=F.SearchRecIntern.cbFile;
  709.      f.Attr:=F.SearchRecIntern.AttrFile;
  710.      f.Name:=F.SearchRecIntern.achName;
  711.      {$ENDIF}
  712.      {$IFDEF Win95}
  713.      IF FindNextFile(F.HDir,F.SearchRecIntern)=FALSE THEN
  714.      BEGIN
  715.           WinBase.FindClose(F.HDir);
  716.           DosError:=18;
  717.           result:=DosError;
  718.           exit;
  719.      END;
  720.      WHILE F.SearchRecIntern.dwFileAttributes AND F.InternalAttr=0 DO
  721.      BEGIN
  722.           IF FindNextFile(F.HDir,F.SearchRecIntern)=FALSE THEN
  723.           BEGIN
  724.                WinBase.FindClose(F.HDir);
  725.                DosError:=18;
  726.                result:=DosError;
  727.                exit;
  728.           END;
  729.      END;
  730.      FileTimeToLocalFileTime(F.SearchRecIntern.ftLastWriteTime,Actual);
  731.      FileTimeToDosDateTime(Actual,date,time);
  732.      f.Time:=(date Shl 16) Or Time;
  733.      f.Size:=F.SearchRecIntern.nFileSizeLow;
  734.      f.Attr:=F.SearchRecIntern.dwFileAttributes;
  735.      f.Name:=CSTRING(F.SearchRecIntern.cFileName);
  736.      {$ENDIF}
  737.      result:=DosError;
  738. END;
  739.  
  740. PROCEDURE FindClose(var F: SearchRec);
  741. BEGIN
  742.      {$IFDEF OS2}
  743.      DosFindClose(F.HDir);
  744.      {$ENDIF}
  745.      {$IFDEF Win95}
  746.      WinBase.FindClose(F.HDir);
  747.      {$ENDIF}
  748.      F.HDir:=0;
  749. END;
  750.  
  751. FUNCTION DosExitCode(SessId:LONGWORD):LONGWORD;
  752. VAR
  753.    rc:LONGWORD;
  754.    {$IFDEF OS2}
  755.    Status:STATUSDATA;
  756.    return:ExecResultCode;
  757.    {$ENDIF}
  758. BEGIN
  759.      {$IFDEF OS2}
  760.      IF ExecViaSession THEN
  761.      BEGIN
  762.           Status.length:=6;
  763.           Status.SelectInd:=0;
  764.           Status.BondInd:=0;
  765.           rc:=DosSelectSession(SessID);
  766.           While rc<>371 DO rc:=DosSetSession(SessID,Status);
  767.           Result:=0;
  768.      END
  769.      ELSE
  770.      BEGIN
  771.           IF LastExecResult=0 THEN
  772.           BEGIN
  773.                DosWaitChild(DCWA_PROCESS,DCWW_WAIT,return,SessId,SessId);
  774.                LastExecResult:=return.CodeResult;
  775.                Result:=return.CodeResult;
  776.           END
  777.           ELSE Result:=LastExecResult;
  778.      END;
  779.      {$ENDIF}
  780.      {$IFDEF Win95}
  781.      Repeat
  782.          GetExitCodeProcess(SessId,Result);
  783.          If Result<>STILL_ACTIVE Then
  784.          Begin
  785.               Result:=0;
  786.               break;
  787.          End;
  788.  
  789.          //Delay 50ms
  790.          ASM
  791.             PUSHL 50
  792.             CALLDLL Kernel32,'Sleep'
  793.          END;
  794.      Until False;
  795.      {$ENDIF}
  796. END;
  797.  
  798.  
  799. FUNCTION Exec(CONST Path: PathStr; CmdLine: STRING):LONGWORD;
  800. type tdata = record
  801.              d1: word;
  802.              d2: word
  803.            end;
  804. VAR
  805.     {$IFDEF OS2}
  806.     aStartData:STARTDATA;
  807.     ObjectBuffer:STRING;
  808.     SessID:LONGWORD;
  809.     SessPID:PID;
  810.     eresult:ExecResultCode;
  811.  
  812.     tib:PTIB;
  813.     pib:PPIB;
  814.     QueueHandle:HQUEUE;
  815.     PIDS: STRING;
  816.     QUE_NAME:CSTRING;
  817.  
  818.     Request:REQUESTDATA;         /* Request-identification data */
  819.     DataLength:ULONG;            /* Length of element received */
  820.     DataAddress:POINTER;         /* Address of element received */
  821.     ElementCode:ULONG;           /* Request a particular element */
  822.     NoWait:BOOL;                 /* No wait if queue is empty */
  823.     ElemPriority:BYTE;           /* Priority of element received */
  824.  
  825.     SEM_NAME:CSTRING;
  826.     SemHandle:HEV;               /* Semaphore handle */
  827.     flAttr:ULONG;                /* Creation attributes */
  828.     fState:BOOLEAN;              /* Initial state of semaphore */
  829.     ulPostCt:LONGWORD;           /* Current post count for the semaphore */
  830.  
  831.     Queue: QMSG;                  { Message-Queue }
  832.     ahab: hab;
  833.  
  834.     rc:APIRET;                   /* Return code */
  835.     rdata: ^tdata;
  836.     {$ENDIF}
  837.     {$IFDEF Win95}
  838.     aStartData:StartupInfo;
  839.     aProcessInfo:PROCESS_INFORMATION;
  840.     {$ENDIF}
  841.     c,c1:CSTRING;
  842. BEGIN
  843.      Result := 0; //session id
  844.      c:=Path;
  845.      c1:=CmdLine;
  846.      {$IFDEF OS2}
  847.      IF ExecViaSession THEN
  848.      BEGIN
  849.           IF NOT AsynchExec THEN
  850.           BEGIN
  851.             DosGetInfoBlocks(tib,pib);
  852.             IF pib=NIL THEN raise EProcessTerm.Create('Can''t retrieve process-id')
  853.             ELSE str(pib^.pib_ulpid,PIDS);
  854.             QUE_NAME:='\QUEUES\TERMQ\'+PIDS+#0;
  855.             rc := DosCreateQueue(QueueHandle,QUE_FIFO OR QUE_CONVERT_ADDRESS,QUE_NAME);
  856.             if rc<>0 THEN raise EProcessTerm.Create('Can''t create exec termination-Queue');
  857.             aStartData.TermQ:=@QUE_NAME;
  858.           END
  859.           ELSE aStartData.TermQ:=NIL;
  860.  
  861.           aStartData.Length:=sizeof(STARTDATA);
  862.           aStartData.Related:=SSF_RELATED_CHILD;
  863.           aStartData.FgBg:=SSF_FGBG_BACK;
  864.           aStartData.TraceOpt:=SSF_TRACEOPT_NONE;
  865.           aStartData.PgmTitle:=@c;
  866.           aStartData.PgmName:=@c;
  867.           aStartData.PgmInputs:=@c1;
  868.           aStartData.Environment:=NIL;
  869.           aStartData.InheritOpt:=SSF_INHERTOPT_SHELL;
  870.           aStartData.SessionType:=SSF_TYPE_DEFAULT;
  871.           aStartData.IconFile:=NIL;
  872.           aStartData.PgmHandle:=0;
  873.           aStartData.PgmControl:=SSF_CONTROL_VISIBLE;
  874.           aStartData.InitXPos:=0;
  875.           aStartData.InitYPos:=0;
  876.           aStartData.InitXSize:=0;
  877.           aStartData.InitYSize:=0;
  878.           aStartData.Reserved:=0;
  879.           aStartData.ObjectBuffer:=@ObjectBuffer;
  880.           aStartData.ObjectBuffLen:=256;
  881.           DosError:=DosStartSession(aStartData,SessId,SessPid);
  882.  
  883.           IF DosError<>0 THEN
  884.           BEGIN
  885.             IF NOT AsynchExec THEN
  886.             BEGIN
  887.                 rc := DosCloseQueue(QueueHandle);
  888.                 if rc<>0 THEN raise EProcessTerm.Create('Can''t close exec termination-Queue');
  889.             END;
  890.             exit;
  891.           END;
  892.  
  893.           DosSelectSession(SessID);
  894.           IF NOT AsynchExec THEN
  895.           BEGIN
  896.             IF ApplicationType<>1 THEN
  897.             BEGIN
  898.               Request.pid := pib^.pib_ulpid;
  899.               ElementCode := 0;
  900.               NoWait := FALSE;
  901.               SemHandle := 0;
  902.               rc := DosReadQueue(QueueHandle,Request,DataLength,DataAddress,ElementCode,NoWait,ElemPriority,SemHandle);
  903.               if rc<>0 THEN raise EProcessTerm.Create('Can''t read termination-Queue');
  904.               rdata:=DataAddress;
  905.               Exec:=rdata^.d2;
  906.               rc := DosFreeMem(DataAddress);
  907.               if rc<>0 THEN raise EProcessTerm.Create('Can''t free QueueData');
  908.               rc := DosCloseQueue(QueueHandle);
  909.               if rc<>0 THEN raise EProcessTerm.Create('Can''t close termination-Queue');
  910.             END
  911.             ELSE
  912.             BEGIN
  913.               SEM_NAME:='\SEM32\TERMQ\'+PIDS+#0;
  914.               flAttr := 0;
  915.               fState := FALSE;
  916.               rc := DosCreateEventSem(SEM_NAME,SemHandle,flAttr,fState);
  917.               if rc<>0 THEN raise EProcessTerm.Create('Can''t create event-semaphore');
  918.               Request.pid := pib^.pib_ulpid;
  919.               ElementCode := 0;
  920.               NoWait := TRUE;
  921.               ahab :=  AppHandle; //WinQueryAnchorBlock(1);
  922.               ulPostCt:=0;
  923.               rc := DosReadQueue(QueueHandle,Request,DataLength,DataAddress,ElementCode,NoWait,ElemPriority,SemHandle);
  924.               IF (rc<>0)AND(rc<>342) THEN raise EProcessTerm.Create('Can''t read termination-Queue');
  925.               WHILE WinGetMsg(ahab,Queue,0,0,0) DO
  926.               BEGIN
  927.                 rc := DosQueryEventSem(SemHandle, ulPostCt);
  928.                 IF rc<>0 THEN raise EProcessTerm.Create('Can''t query event-semaphore');
  929.                 IF ulPostCt>0 THEN BREAK;
  930.                 WinDispatchMsg(ahab,Queue);
  931.               END;
  932.  
  933.               rc := DosCloseEventSem(SemHandle);
  934.               IF rc<>0 THEN raise EProcessTerm.Create('Can''t close event-semaphore');
  935.               rc := DosReadQueue(QueueHandle,Request,DataLength,DataAddress,ElementCode,NoWait,ElemPriority,SemHandle);
  936.               IF rc<>0 THEN raise EProcessTerm.Create('Can''t read termination-Queue');
  937.               rdata:=DataAddress;
  938.               Exec:=rdata^.d2;
  939.               rc := DosFreeMem(DataAddress);
  940.               IF rc<>0 THEN raise EProcessTerm.Create('Can''t free QueueData');
  941.               rc := DosCloseQueue(QueueHandle);
  942.               IF rc<>0 THEN raise EProcessTerm.Create('Can''t close termination-Queue');
  943.             END;
  944.           END
  945.           ELSE Exec:=SessID;
  946.      END
  947.      ELSE
  948.      BEGIN
  949.           LastExecResult:=0;
  950.           IF AsynchEXEC THEN DosExecPgm(@ObjectBuffer,256,2,c1,
  951.                                         NIL,eresult,c)
  952.           ELSE
  953.           BEGIN
  954.                c1:=#0+c1;
  955.                DosExecPgm(@ObjectBuffer,256,0,c1,
  956.                           NIL,eresult,c);
  957.                LastExecresult:=eresult.CodeResult;
  958.           END;
  959.           Exec:=LastExecResult;
  960.      END;
  961.      {$ENDIF}
  962.      {$IFDEF Win95}
  963.      DosError:=0;
  964.      FillChar(aStartData,sizeof(aStartData),0);
  965.      aStartData.cb:=sizeof(aStartData);
  966.      C1:=C +' '+C1;
  967.      IF not CreateProcess(C,C1,NIL,NIL,FALSE,CREATE_NEW_CONSOLE OR
  968.                           NORMAL_PRIORITY_CLASS,NIL,NIL,
  969.                           aStartData,aProcessInfo) THEN
  970.      BEGIN
  971.           DosError:=1;
  972.           exit;
  973.      END;
  974.      Exec:=aProcessInfo.hProcess;
  975.      {$ENDIF}
  976. END;
  977.  
  978.  
  979.  
  980. FUNCTION GetFAttr(VAR F:FILE; var Attr: LongWord):LONGINT;
  981. VAR
  982.     {$IFDEF OS2}
  983.     s:FILESTATUS3;
  984.     size:LONGWORD;
  985.     savemode:ULONG;
  986.     {$ENDIF}
  987.     {$IFDEF Win95}
  988.     Name:CSTRING;
  989.     {$ENDIF}
  990.     ff:^FileRec;
  991.     b:BOOLEAN;
  992. BEGIN
  993.      b:=RaiseIoError;
  994.      ff:=@f;
  995.      DosError:=0;
  996.      {$IFDEF OS2}
  997.      savemode:=FileMode;
  998.      filemode:=fmInput;
  999.      {$i-}
  1000.      reset(f);
  1001.      {$i+}
  1002.      IF InOutRes<>0 THEN
  1003.      BEGIN
  1004.           RaiseIOError:=b;
  1005.           DosError:=InOutRes;
  1006.           result:=DosError;
  1007.           filemode := savemode;
  1008.           exit;
  1009.      END;
  1010.      size:=sizeof(FILESTATUS3);
  1011.      DosError:=DosQueryFileInfo(ff^.Handle,FIL_STANDARD,s,size);
  1012.      IF DosError=0 THEN
  1013.      BEGIN
  1014.           Attr:=s.attrFile;
  1015.      END
  1016.      ELSE Attr:=0; {invalid}
  1017.      {$i-}
  1018.      close(f);
  1019.      {$i+}
  1020.      IF InOutRes<>0 THEN
  1021.      BEGIN
  1022.           RaiseIOError:=b;
  1023.           DosError:=InOutRes;
  1024.           result:=DosError;
  1025.           filemode := savemode;
  1026.           exit;
  1027.      END;
  1028.      filemode:=SaveMode;
  1029.      {$ENDIF}
  1030.      {$IFDEF Win95}
  1031.      name:=ff^.Name;
  1032.      Attr:=GetFileAttributes(Name);
  1033.      IF Attr=$ffffffff THEN DosError:=GetLastError
  1034.      ELSE DosError:=0;
  1035.      {$ENDIF}
  1036.      RaiseIOError:=b;
  1037.      result:=DosError;
  1038. END;
  1039.  
  1040. FUNCTION SetFAttr(VAR F:FILE; Attr: LongWord):LONGINT;
  1041. VAR
  1042.     {$IFDEF OS2}
  1043.     s:FILESTATUS3;
  1044.     size:LONGWORD;
  1045.     {$ENDIF}
  1046.     Name:CSTRING;
  1047.     ff:^FileRec;
  1048.     b:BOOLEAN;
  1049. BEGIN
  1050.      b:=RaiseIOError;
  1051.      ff:=@f;
  1052.      if ff^.Flags<>$6666 then
  1053.      BEGIN
  1054.        RaiseIOError:=b;
  1055.        DosError:=3;
  1056.        result:=DosError;
  1057.        exit;
  1058.      END;
  1059.      DosError:=0;
  1060.      Name:=ff^.Name;
  1061.      {$IFDEF OS2}
  1062.      size:=sizeof(FILESTATUS3);
  1063.      DosError:=DosQueryPathInfo(Name,FIL_STANDARD,s,size);
  1064.      IF DosError=0 THEN
  1065.      BEGIN
  1066.           s.attrFile:=Attr;
  1067.           DosError:=DosSetPathInfo(Name,FIL_STANDARD,s,size,DSPI_WRTTHRU);
  1068.      END;
  1069.      {$ENDIF}
  1070.      {$IFDEF Win95}
  1071.      IF not SetFileAttributes(Name,Attr) THEN DosError:=GetLastError
  1072.      ELSE DosError:=0;
  1073.      {$ENDIF}
  1074.      RaiseIOError:=b;
  1075.      result:=DosError;
  1076. END;
  1077.  
  1078.  
  1079. FUNCTION GetFTime2(VAR F:FILE; VAR year,month,day,Hours,Minutes,Secs:WORD):LONGINT;
  1080. VAR
  1081.     {$IFDEF OS2}
  1082.     s:FILESTATUS3;
  1083.     size:LONGWORD;
  1084.     {$ENDIF}
  1085.     {$IFDEF Win95}
  1086.     LastAccess,Creation,LastWrite,Actual:FILETIME;
  1087.     {$ENDIF}
  1088.     date,time:WORD;
  1089.     ff:^FileRec;
  1090. BEGIN
  1091.      ff:=@f;
  1092.      DosError:=0;
  1093.      {$IFDEF OS2}
  1094.      size:=sizeof(FILESTATUS3);
  1095.      DosError:=DosQueryFileInfo(ff^.Handle,1,s,size);
  1096.      IF DosError=0 THEN
  1097.      BEGIN
  1098.           date:=s.fdateLastWrite;
  1099.           time:=s.ftimelastwrite;
  1100.  
  1101.           UnpackDateIntern(Date,year,month,day);
  1102.           UnpackTimeIntern(Time,hours,minutes,Secs);
  1103.           Secs:=Secs*2;
  1104.      END
  1105.      ELSE
  1106.      BEGIN
  1107.           day:=0;
  1108.           month:=0;
  1109.           year:=0;
  1110.           Hours:=0;
  1111.           Minutes:=0;
  1112.           Secs:=0;
  1113.      END;
  1114.      {$ENDIF}
  1115.      {$IFDEF Win95}
  1116.      DosError:=0;
  1117.      IF not GetFileTime(ff^.Handle,Creation,LastAccess,LastWrite) THEN
  1118.      BEGIN
  1119.           day:=0;
  1120.           month:=0;
  1121.           year:=0;
  1122.           Hours:=0;
  1123.           Minutes:=0;
  1124.           Secs:=0;
  1125.           DosError:=GetLastError;
  1126.           exit;
  1127.      END;
  1128.  
  1129.      FileTimeToLocalFileTime(LastWrite,Actual);
  1130.      FileTimeToDosDateTime(Actual,date,time);
  1131.  
  1132.      UnpackDateIntern(Date,year,month,day);
  1133.      UnpackTimeIntern(Time,hours,minutes,Secs);
  1134.      Secs:=Secs*2;
  1135.      {$ENDIF}
  1136.      result:=DosError;
  1137. END;
  1138.  
  1139.  
  1140. FUNCTION SetFTime2(VAR F:FILE; year,month,day,Hours,Minutes,Secs:Word):LONGINT;
  1141. VAR
  1142.     {$IFDEF OS2}
  1143.     s:FILESTATUS3;
  1144.     size:LONGWORD;
  1145.     time,date:Word;
  1146.     TwoSecs:WORD;
  1147.     {$ENDIF}
  1148.     {$IFDEF Win95}
  1149.     LastAccess,Creation,LastWrite:FILETIME;
  1150.     time,date:Word;
  1151.     TwoSecs:WORD;
  1152.     dt:DateTime;
  1153.     {$ENDIF}
  1154.     ff:^FileRec;
  1155. label l;
  1156. BEGIN
  1157.      ff:=@f;
  1158.      DosError:=0;
  1159.      {$IFDEF OS2}
  1160.      TwoSecs:=Secs DIV 2;
  1161.      IF ((Month>12)or(Month=0)) THEN
  1162.      BEGIN
  1163. l:
  1164.           DosError:=1;
  1165.           result:=DosError;
  1166.           exit;
  1167.      END;
  1168.      IF ((Day>32)or(day=0)) THEN goto l;
  1169.      IF Hours>24 THEN goto l;
  1170.      IF Minutes>60 THEN goto l;
  1171.      IF TwoSecs>30 THEN goto l;
  1172.      size:=sizeof(FILESTATUS3);
  1173.      DosError:=DosQueryFileInfo(ff^.Handle,1,s,size);
  1174.      IF DosError=0 THEN
  1175.      BEGIN
  1176.           Date:=PackDateIntern(year,month,day);
  1177.           Time:=PackTimeIntern(Hours,Minutes,TwoSecs);
  1178.  
  1179.           s.fdatelastwrite:=date;
  1180.           s.ftimeLastWrite:=time;
  1181.           DosError:=DosSetFileInfo(ff^.Handle,1,s,size);
  1182.      END;
  1183.      {$ENDIF}
  1184.      {$IFDEF Win95}
  1185.      DosError:=0;
  1186.      IF not GetFileTime(ff^.Handle,Creation,LastAccess,LastWrite) THEN
  1187.      BEGIN
  1188.           DosError:=GetLastError;
  1189.           result:=DosError;
  1190.           exit;
  1191.      END;
  1192.  
  1193.      TwoSecs:=Secs DIV 2;
  1194.      IF ((Month>12)or(Month=0)) THEN
  1195.      BEGIN
  1196. l:
  1197.           DosError:=1;
  1198.           result:=DosError;
  1199.           exit;
  1200.      END;
  1201.      IF ((Day>32)or(day=0)) THEN goto l;
  1202.      IF Hours>24 THEN goto l;
  1203.      IF Minutes>60 THEN goto l;
  1204.      IF TwoSecs>30 THEN goto l;
  1205.  
  1206.      Date:=PackDateIntern(year,month,day);
  1207.      Time:=PackTimeIntern(Hours,Minutes,TwoSecs);
  1208.  
  1209.      DosDateTimeToFileTime(date,time,Creation);
  1210.  
  1211.      IF not SetFileTime(ff^.Handle,Creation,LastAccess,LastWrite) THEN
  1212.      BEGIN
  1213.           DosError:=GetlastError;
  1214.           result:=DosError;
  1215.           exit;
  1216.      END;
  1217.      {$ENDIF}
  1218.      result:=DosError;
  1219. END;
  1220.  
  1221. FUNCTION GetFTime(VAR f:FILE;VAR Time:LONGINT):LONGINT;
  1222. VAR
  1223.    DT:DateTime;
  1224.    m,d,h,i,s:WORD;
  1225. BEGIN
  1226.      result:=GetFTime2(f,DT.year,m,d,h,i,s);
  1227.      DT.month:=m;
  1228.      DT.day:=d;
  1229.      DT.hour:=h;
  1230.      DT.min:=i;
  1231.      DT.sec:=s;
  1232.      PackTime(DT,Time);
  1233. END;
  1234.  
  1235. FUNCTION SetFTime(VAR f:FILE;Time:LONGINT):LONGINT;
  1236. VAR
  1237.    DT:DateTime;
  1238. BEGIN
  1239.      UnpackTime(time,DT);
  1240.      {DT.sec:=DT.sec DIV 2;}
  1241.      result:=SetFTime2(f,DT.year,DT.month,DT.day,DT.hour,DT.min,DT.sec);
  1242. END;
  1243.  
  1244. FUNCTION DiskFree(Drive: Byte): LongWord;
  1245. VAR
  1246.     {$IFDEF OS2}
  1247.     a:FSALLOCATE;
  1248.     {$ENDIF}
  1249.     {$IFDEF Win95}
  1250.     c:CSTRING;
  1251.     {$ENDIF}
  1252.     s,d:LONGWORD;
  1253.     {$IFDEF Win95}
  1254.     sec,freesec,clust,freeclust:LONGWORD;
  1255.     {$ENDIF}
  1256. BEGIN
  1257.      {$IFDEF OS2}
  1258.      s:=sizeof(FSALLOCATE);
  1259.      d:=Drive;
  1260.      DosError:=DosQueryFSInfo(d,1,a,s);
  1261.      IF DosError=0 THEN s:=a.cSectorUnit*a.cUnitAvail*a.cbSector
  1262.      ELSE s:=0;
  1263.      {$ENDIF}
  1264.      {$IFDEF Win95}
  1265.      DosError:=0;
  1266.      IF Drive=0 THEN
  1267.      BEGIN
  1268.           IF not GetDiskFreeSpace(NIL,s,sec,freeclust,clust) THEN
  1269.           BEGIN
  1270.                DosError:=GetLastError;
  1271.                result:=0;
  1272.                exit;
  1273.           END;
  1274.      END
  1275.      ELSE
  1276.      BEGIN
  1277.           c:=chr(ord('A')+(Drive-1))+':\';
  1278.           IF not GetDiskFreeSpace(c,s,sec,freeclust,clust) THEN
  1279.           BEGIN
  1280.                DosError:=GetLastError;
  1281.                result:=0;
  1282.                exit;
  1283.           END;
  1284.      END;
  1285.      s:=s*sec*freeclust;
  1286.      {$ENDIF}
  1287.      DiskFree:=s;
  1288. END;
  1289.  
  1290. FUNCTION DiskSize(Drive: Byte): LongWord;
  1291. VAR
  1292.     {$IFDEF OS2}
  1293.     a:FSALLOCATE;
  1294.     {$ENDIF}
  1295.     s,d:LONGWORD;
  1296.     {$IFDEF WIN95}
  1297.     sec,freesec,clust,freeclust:LONGWORD;
  1298.     c:CSTRING;
  1299.     {$ENDIF}
  1300. BEGIN
  1301.      {$IFDEF OS2}
  1302.      s:=sizeof(FSALLOCATE);
  1303.      d:=Drive;
  1304.      DosErrorAPI(0); /* Action flag for disable */
  1305.      DosError:=DosQueryFSInfo(d,1,a,s);
  1306.      DosErrorAPI(1); /* Action flag for enable */
  1307.      IF DosError=0 THEN s:=a.cSectorUnit*a.cUnit*a.cbSector
  1308.      ELSE s:=$FFFFFFFF;
  1309.      {$ENDIF}
  1310.      {$IFDEF Win95}
  1311.      DosError:=0;
  1312.      IF Drive=0 THEN
  1313.      BEGIN
  1314.           IF not GetDiskFreeSpace(NIL,s,sec,freeclust,clust) THEN
  1315.           BEGIN
  1316.                DosError:=GetLastError;
  1317.                result:=$FFFFFFFF;
  1318.                exit;
  1319.           END;
  1320.      END
  1321.      ELSE
  1322.      BEGIN
  1323.           c:=chr(ord('A')+(Drive-1))+':\';
  1324.           IF not GetDiskFreeSpace(c,s,sec,freeclust,clust) THEN
  1325.           BEGIN
  1326.                DosError:=GetLastError;
  1327.                result:=$FFFFFFFF;
  1328.                exit;
  1329.           END;
  1330.      END;
  1331.      s:=s*sec*clust;
  1332.      {$ENDIF}
  1333.      DiskSize:=s;
  1334. END;
  1335.  
  1336. FUNCTION EnvStr(Index:LONGINT):String;
  1337. VAR
  1338.   P:^CSTRING;
  1339.   Count: Integer;
  1340. BEGIN
  1341.   ASM
  1342.      MOV EAX,SYSTEM.EnvStart
  1343.      MOV P,EAX
  1344.   END;
  1345.   result:= '';
  1346.   IF ((Index>0)AND(P<>NIL)) THEN
  1347.   BEGIN
  1348.        Count := 1;
  1349.        WHILE ((Count<Index)AND(P^[0]<>#0)) DO
  1350.        BEGIN
  1351.             WHILE P^[1]<>#0 DO inc(P);
  1352.             inc(P);
  1353.             inc(P);
  1354.             Inc(Count);
  1355.        END;
  1356.        EnvStr := P^;
  1357.   END;
  1358. END;
  1359.  
  1360. FUNCTION EnvCount:LONGINT;
  1361. VAR
  1362.   P:^CSTRING;
  1363. BEGIN
  1364.   ASM
  1365.      MOV EAX,SYSTEM.EnvStart
  1366.      MOV P,EAX
  1367.   END;
  1368.   result:=0;
  1369.   IF P<>NIL THEN
  1370.   BEGIN
  1371.        WHILE P^[0]<>#0 DO
  1372.        BEGIN
  1373.             WHILE P^[1]<>#0 DO inc(P);
  1374.             inc(P);
  1375.             inc(P);
  1376.             Inc(Result);
  1377.        END;
  1378.   END;
  1379. END;
  1380.  
  1381.  
  1382. FUNCTION GetEnv(CONST Env:String):String;
  1383. VAR
  1384.    e:PChar;
  1385.    c:CSTRING;
  1386.    {$IFDEF Win95}
  1387.    c1:CSTRING;
  1388.    res:LONGWORD;
  1389.    {$ENDIF}
  1390. BEGIN
  1391.      c:=Env;
  1392.      {$IFDEF OS2}
  1393.      DosError:=DosScanEnv(c,e);
  1394.      {$ENDIF}
  1395.      {$IFDEF Win95}
  1396.      res:=GetEnvironmentVariable(c,c1,255);
  1397.      IF res=0 THEN DosError:=GetLastError
  1398.      ELSE e:=@c1;
  1399.      {$ENDIF}
  1400.      IF DosError<>0 THEN GetEnv:=''
  1401.      ELSE GetEnv:=e^;
  1402. END;
  1403.  
  1404. FUNCTION GetVerify(VAR Verify: Boolean):LONGINT;
  1405. VAR
  1406.    v:LONGWORD;
  1407. BEGIN
  1408.      {$IFDEF OS2}
  1409.      DosError:=DosQueryVerify(v);
  1410.      Verify:=v<>0;
  1411.      {$ENDIF}
  1412.      {$IFDEF Win95}
  1413.      DosError:=1;   //not supported
  1414.      {$ENDIF}
  1415.      result:=DosError;
  1416. END;
  1417.  
  1418. FUNCTION SetVerify(Verify: Boolean):LONGINT;
  1419. VAR
  1420.    v:LONGWORD;
  1421. BEGIN
  1422.      {$IFDEF OS2}
  1423.      v:=BYTE(Verify);
  1424.      DosError:=DosSetVerify(v);
  1425.      {$ENDIF}
  1426.      {$IFDEF Win95}
  1427.      DosError:=1;   //not supported
  1428.      {$ENDIF}
  1429.      result:=DosError;
  1430. END;
  1431.  
  1432. FUNCTION DosVersion:LongWord;
  1433. VAR
  1434.    MinorVersion,MajorVersion:LONGWORD;
  1435. BEGIN
  1436.      {$IFDEF OS2}
  1437.      DosQuerySysInfo(QSV_VERSION_MAJOR,QSV_VERSION_MAJOR,MajorVersion,4);
  1438.      DosQuerySysInfo(QSV_VERSION_MINOR,QSV_VERSION_MINOR,MinorVersion,4);
  1439.      DosVersion:=MajorVersion OR MINORVERSION SHL 8;
  1440.      {$ENDIF}
  1441.      {$IFDEF Win95}
  1442.      result:=GetVersion;
  1443.      {$ENDIF}
  1444. END;
  1445.  
  1446. FUNCTION GetDate(var Year,Month,Day,DayOfWeek: Word):LONGINT;
  1447. {$IFDEF OS2}
  1448. VAR d:DateTime;
  1449. {$ENDIF}
  1450. {$IFDEF Win95}
  1451. VAR d:SYSTEMTIME;
  1452. {$ENDIF}
  1453. BEGIN
  1454.      {$IFDEF OS2}
  1455.      DosGetDateTime(d);
  1456.      DosError:=0;
  1457.      Year:=d.year;
  1458.      Month:=d.month;
  1459.      Day:=d.Day;
  1460.      DayofWeek:=d.Weekday;
  1461.      {$ENDIF}
  1462.      {$IFDEF Win95}
  1463.      DosError:=0;
  1464.      GetLocalTime(d);
  1465.      Year:=d.wYear;
  1466.      Month:=d.wMonth;
  1467.      Day:=d.wDay;
  1468.      DayofWeek:=d.wDayOfWeek;
  1469.      {$ENDIF}
  1470.      result:=DosError;
  1471. END;
  1472.  
  1473. FUNCTION SetDate(Year,Month,Day: Word):LONGINT;
  1474. {$IFDEF OS2}
  1475. VAR d:DateTime;
  1476. {$ENDIF}
  1477. {$IFDEF Win95}
  1478. VAR d:SYSTEMTIME;
  1479. {$ENDIF}
  1480. BEGIN
  1481.      {$IFDEF OS2}
  1482.      DosGetDateTime(d);
  1483.      DosError:=0;
  1484.      d.year:=Year;
  1485.      d.month:=Month;
  1486.      d.day:=day;
  1487.      d.Weekday:=0;
  1488.      DosSetDateTime(d);
  1489.      {$ENDIF}
  1490.      {$IFDEF Win95}
  1491.      DosError:=0;
  1492.      GetLocalTime(d);
  1493.      d.wYear:=Year;
  1494.      d.wMonth:=Month;
  1495.      d.wDay:=Day;
  1496.      d.wDayOfWeek:=0;
  1497.      SetLocalTime(d);
  1498.      {$ENDIF}
  1499.      result:=DosError;
  1500. END;
  1501.  
  1502. FUNCTION GetTime(var Hour,Minute,Second,Sec100: Word):LONGINT;
  1503. {$IFDEF OS2}
  1504. VAR d:DateTime;
  1505. {$ENDIF}
  1506. {$IFDEF Win95}
  1507. VAR d:SYSTEMTIME;
  1508. {$ENDIF}
  1509. BEGIN
  1510.      {$IFDEF OS2}
  1511.      DosGetDateTime(d);
  1512.      DosError:=0;
  1513.      Hour:=d.hour;
  1514.      Minute:=d.min;
  1515.      Second:=d.Sec;
  1516.      Sec100:=d.Hundredths;
  1517.      {$ENDIF}
  1518.      {$IFDEF Win95}
  1519.      DosError:=0;
  1520.      GetLocalTime(d);
  1521.      Hour:=d.wHour;
  1522.      Minute:=d.wMinute;
  1523.      Second:=d.wSecond;
  1524.      Sec100:=d.wMilliseconds Div 10;
  1525.      {$ENDIF}
  1526.      result:=DosError;
  1527. END;
  1528.  
  1529. FUNCTION SetTime(Hour,Minute,Second,Sec100: Word):LONGINT;
  1530. {$IFDEF OS2}
  1531. VAR d:DateTime;
  1532. {$ENDIF}
  1533. {$IFDEF Win95}
  1534. VAR d:SYSTEMTIME;
  1535. {$ENDIF}
  1536. BEGIN
  1537.      {$IFDEF OS2}
  1538.      DosGetDateTime(d);
  1539.      DosError:=0;
  1540.      d.Hour:=Hour;
  1541.      d.Min:=Minute;
  1542.      d.Sec:=Second;
  1543.      d.Hundredths:=Sec100;
  1544.      DosSetDateTime(d);
  1545.      {$ENDIF}
  1546.      {$IFDEF Win95}
  1547.      DosError:=0;
  1548.      GetLocalTime(d);
  1549.      d.wHour:=Hour;
  1550.      d.wMinute:=Minute;
  1551.      d.wSecond:=Second;
  1552.      d.wMilliseconds:=sec100*10;
  1553.      SetLocalTime(d);
  1554.      {$ENDIF}
  1555.      result:=DosError;
  1556. END;
  1557.  
  1558. FUNCTION CompareFileTimes(First,Second:STRING):BYTE;
  1559. VAR f1,f2:FILE;
  1560.     result:BYTE;
  1561.     year1,month1,day1,Hours1,Minutes1,Secs1:WORD;
  1562.     year2,month2,day2,Hours2,Minutes2,Secs2:WORD;
  1563.     b:BOOLEAN;
  1564. Label l;
  1565. BEGIN
  1566.      b:=RaiseIOError;
  1567.      result:=F_ERROR;
  1568.      assign(f1,first);
  1569.      {$i-}
  1570.      reset(f1,1);
  1571.      {$i+}
  1572.      IF InOutRes<>0 THEN goto l;
  1573.      GetFTime2(f1,year1,month1,day1,Hours1,Minutes1,Secs1);
  1574.      IF DosError<>0 THEN
  1575.      BEGIN
  1576.           {$i-}
  1577.           Close(f1);
  1578.           {$i+}
  1579.           IF InOutRes<>0 THEN
  1580.           BEGIN
  1581.                RaiseIOError:=b;
  1582.                CompareFileTimes:=result;
  1583.                exit;
  1584.           END;
  1585.           goto l;
  1586.      END;
  1587.      {$i-}
  1588.      Close(f1);
  1589.      {$i+}
  1590.      IF InOutRes<>0 THEN
  1591.      BEGIN
  1592.           RaiseIOError:=b;
  1593.           CompareFileTimes:=result;
  1594.           exit;
  1595.      END;
  1596.  
  1597.      assign(f2,second);
  1598.      {$i-}
  1599.      reset(f2,1);
  1600.      {$i+}
  1601.      IF InOutRes<>0 THEN
  1602.      BEGIN
  1603.           RaiseIOError:=b;
  1604.           CompareFileTimes:=result;
  1605.           exit;
  1606.      END;
  1607.      GetFTime2(f2,year2,month2,day2,Hours2,Minutes2,Secs2);
  1608.      IF DosError<>0 THEN
  1609.      BEGIN
  1610.           {$i-}
  1611.           Close(f2);
  1612.           {$i+}
  1613.           IF InOutRes<>0 THEN
  1614.           BEGIN
  1615.                RaiseIOError:=b;
  1616.                CompareFileTimes:=result;
  1617.                exit;
  1618.           END;
  1619.           goto l;
  1620.      END;
  1621.      {$i-}
  1622.      Close(f2);
  1623.      {$i+}
  1624.      IF InOutRes<>0 THEN
  1625.      BEGIN
  1626.           RaiseIOError:=b;
  1627.           CompareFileTimes:=result;
  1628.           exit;
  1629.      END;
  1630.  
  1631.      IF year1=year2 THEN
  1632.      BEGIN
  1633.           IF month1=month2 THEN
  1634.           BEGIN
  1635.                IF Day1=Day2 THEN
  1636.                BEGIN
  1637.                     IF Hours1=Hours2 THEN
  1638.                     BEGIN
  1639.                          IF Minutes1=Minutes2 THEN
  1640.                          BEGIN
  1641.                               IF Secs1=Secs2 THEN result:=F_EQUAL
  1642.                               ELSE
  1643.                               BEGIN
  1644.                                    IF Secs1>Secs2 THEN Result:=F_FIRST_GREATER
  1645.                                    ELSE Result:=F_SECOND_GREATER;
  1646.                               END;
  1647.                          END
  1648.                          ELSE
  1649.                          BEGIN
  1650.                               IF Minutes1>Minutes2 THEN Result:=F_FIRST_GREATER
  1651.                               ELSE Result:=F_SECOND_GREATER;
  1652.                          END;
  1653.                     END
  1654.                     ELSE
  1655.                     BEGIN
  1656.                          IF Hours1>Hours2 THEN Result:=F_FIRST_GREATER
  1657.                          ELSE Result:=F_SECOND_GREATER;
  1658.                     END;
  1659.                END
  1660.                ELSE
  1661.                BEGIN
  1662.                     IF day1>day2 THEN Result:=F_FIRST_GREATER
  1663.                     ELSE Result:=F_SECOND_GREATER;
  1664.                END;
  1665.           END
  1666.           ELSE
  1667.           BEGIN
  1668.                IF month1>month2 THEN Result:=F_FIRST_GREATER
  1669.                ELSE Result:=F_SECOND_GREATER;
  1670.           END;
  1671.      END
  1672.      ELSE
  1673.      BEGIN
  1674.           IF year1>year2 THEN Result:=F_FIRST_GREATER
  1675.           ELSE Result:=F_SECOND_GREATER;
  1676.      END;
  1677.  
  1678. l:
  1679.      CompareFileTimes:=Result;
  1680.      RaiseIOError:=b;
  1681. END;
  1682.  
  1683. PROCEDURE Flush (VAR F:FILE);
  1684. VAR ff:^FileRec;
  1685.     Temp:LONGWORD;
  1686.     e:EInOutError;
  1687.     Adr:LongWord;
  1688. BEGIN
  1689.      ASM
  1690.         MOV EAX,[EBP+4]
  1691.         SUB EAX,5
  1692.         MOV Adr,EAX
  1693.      END;
  1694.      ff:=@F;
  1695.      IF ff^.Buffer<>NIL THEN
  1696.      BEGIN
  1697.           IF ff^.changed THEN
  1698.           BEGIN
  1699.                ff^.changed:=FALSE;
  1700.                ASM
  1701.                   //FileBlockIO(F,ff^.block,WriteMode,Temp);
  1702.                   PUSH DWORD PTR F
  1703.                   MOV EAX,ff
  1704.                   PUSH DWORD PTR [EAX].FileRec.Block
  1705.                   PUSHL 2
  1706.                   LEA EAX,Temp
  1707.                   PUSH EAX
  1708.                   CALLN32 SYSTEM.FileBlockIO
  1709.                END;
  1710.                IF InOutRes<>0 THEN
  1711.                BEGIN
  1712.                     IF RaiseIOError THEN
  1713.                     BEGIN
  1714.                          e.Create('Input/Output error (EInOutError)');
  1715.                          e.ErrorCode:=InOutRes;
  1716.                          e.CameFromRTL:=TRUE;
  1717.                          e.RTLExcptAddr:=POINTER(Adr);
  1718.                          RAISE e;
  1719.                     END
  1720.                     ELSE exit;
  1721.                END;
  1722.           END;
  1723.      END;
  1724. END;
  1725.  
  1726. BEGIN
  1727. END.
  1728.  
  1729.