source: trunk/Sibyl/RTL/DOS.PAS@ 201

Last change on this file since 201 was 8, checked in by RBRi, 19 years ago

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