1 { $O+,F+,I-,S-,R-,V-}
2 Unit MKFile;
3
4 {$IfDef FPC}
5 {$PackRecords 1}
6 {$EndIf}
7
8 Interface
9
10 Uses Dos,
11 {$IFDEF VirtualPascal}
12 os2base, os2def, Strings,
13 {$ENDIF}
14 {$IFDEF SPEED}
15 BseDOS, BseDev,
16 {$ENDIF}
17 {$IfDef UNIX}
18 Linux,
19 {$EndIf}
20 GeneralP;
21
22 { $I FILEMODE.INC}
23 {--- begin FILEMODE.INC ---}
24 {$IfDef SPEED}
25 Uses
26 BseDOS;
27
28 Const
29 fmReadOnly = Open_Access_ReadOnly;
30 fmReadWrite = Open_Access_ReadWrite;
31 fmDenyNone = Open_Share_DenyNone;
32
33 {$Else}
34
35 Const
36 fmReadOnly = 0; {FileMode constants}
37 fmWriteOnly = 1;
38 fmReadWrite = 2;
39 fmDenyAll = 16;
40 fmDenyWrite = 32;
41 fmDenyRead = 48;
42 fmDenyNone = 64;
43 fmNoInherit = 128;
44
45 {$EndIf}
46 {--- end FILEMODE.INC ---}
47
48
49 Const
50 Tries: Word = 150;
51 TryDelay: Word = 100;
52
53
54 Type FindRec = Record
55 SR: SearchRec;
56 Dir: DirStr;
57 Name: NameStr;
58 Ext: ExtStr;
59 DError: Word;
60 End;
61
62
63 Type FindObj = Object
64 FI: ^FindRec;
65 Procedure Init; {Initialize}
66 Procedure Done; {Done}
67 Procedure FFirst(FN: String); {Find first}
68 Procedure FNext;
Foundnull69 Function Found: Boolean; {File was found}
GetNamenull70 Function GetName: String; {Get Filename}
GetFullPathnull71 Function GetFullPath: String; {Get filename with path}
GetDatenull72 Function GetDate: LongInt; {Get file date}
GetSizenull73 Function GetSize: LongInt; {Get file size}
74 End;
75
76
77 Type TFileArray = Array[1..$fff0] of Char;
78
79 Type TFileRec = Record
80 MsgBuffer: ^TFileArray;
81 BufferPtr: Word;
82 {$IFDEF VirtualPascal}
83 BufferChars: LongInt;
84 {$ELSE}
85 BufferChars: Word;
86 {$ENDIF}
87 BufferStart: LongInt;
88 BufferFile: File;
89 CurrentStr: String;
90 StringFound: Boolean;
91 Error: Word;
92 BufferSize: Word;
93 End;
94
95
96 Type TFile = Object
97 TF: ^TFileRec;
98 Procedure Init;
99 Procedure Done;
GetStringnull100 Function GetString:String; {Get string from file}
GetUStringnull101 Function GetUString: String; {Get LF delimited string}
OpenTextFilenull102 Function OpenTextFile(FilePath: String): Boolean; {Open file}
CloseTextFilenull103 Function CloseTextFile: Boolean; {Close file}
GetCharnull104 Function GetChar: Char; {Internal use}
105 Procedure BufferRead; {Internal use}
StringFoundnull106 Function StringFound: Boolean; {Was a string found}
SeekTextFilenull107 Function SeekTextFile(SeekPos: LongInt): Boolean; {Seek to position}
GetTextPosnull108 Function GetTextPos: LongInt; {Get text file position}
Restartnull109 Function Restart: Boolean; {Reset to start of file}
110 Procedure SetBufferSize(BSize: Word); {Set buffer size}
111 End;
112
113
114
115 var
116 MKFileError: Word;
117
Existnull118 function Exist (fname : string; attr : word) : boolean;
FileExistnull119 Function FileExist(FName: String): Boolean;
SizeFilenull120 Function SizeFile(FName: String): LongInt;
DateFilenull121 Function DateFile(FName: String): LongInt;
FindPathnull122 Function FindPath(FileName: String): String;
LongLonull123 Function LongLo(InNum: LongInt): Word;
LongHinull124 Function LongHi(InNum: LongInt): Word;
LockFilenull125 Function LockFile(Var F; LockStart: LongInt; LockLength: LongInt): Word;
UnLockFilenull126 Function UnLockFile(Var F; LockStart: LongInt; LockLength: LongInt): Word;
shAssignnull127 Function shAssign(Var F: File; FName: String): Boolean;
shLocknull128 Function shLock(Var F; LockStart,LockLength: LongInt): Word;
129 Procedure FlushFile(Var F); {Dupe file handle, close dupe handle}
shResetnull130 Function shReset(Var F: File; RecSize: Word): Boolean;
131 {$IFNDEF VIRTUALPASCAL}
shReadnull132 Function shRead(Var F: File; Var Rec; ReadSize: Word; Var NumRead: Word): Boolean;
shWritenull133 Function shWrite(Var F: File; Var Rec; ReadSize: Word): Boolean;
134 {$ELSE}
shReadnull135 Function shRead(Var F: File; Var Rec; ReadSize: Word; Var NumRead: LongInt): Boolean;
shWritenull136 Function shWrite(Var F: File; Var Rec; ReadSize: LongInt): Boolean;
137
138 {$ENDIF}
shOpenFilenull139 Function shOpenFile(Var F: File; PathName: String): Boolean;
shMakeFilenull140 Function shMakeFile(Var F: File; PathName: String): Boolean;
141 Procedure shCloseFile(Var F: File);
shSeekFilenull142 Function shSeekFile(Var F: File; FPos: LongInt): Boolean;
shFindFilenull143 Function shFindFile(Pathname: String; Var Name: String; Var Size, Time: LongInt): Boolean;
144 Procedure shSetFTime(Var F: File; Time: LongInt);
GetCurrentPathnull145 Function GetCurrentPath: String;
146 Procedure CleanDir(FileDir: String);
IsDevicenull147 Function IsDevice(FilePath: String): Boolean;
LoadFilePosnull148 Function LoadFilePos(FN: String; Var Rec; FS: Word; FPos: LongInt): Word;
LoadFilenull149 Function LoadFile(FN: String; Var Rec; FS: Word): Word;
SaveFilePosnull150 Function SaveFilePos(FN: String; Var Rec; FS: Word; FPos: LongInt): Word;
SaveFilenull151 Function SaveFile(FN: String; Var Rec; FS: Word): Word;
ExtendFilenull152 Function ExtendFile(FN: String; ToSize: LongInt): Word;
CreateTempDirnull153 Function CreateTempDir(FN: String): String;
GetTempNamenull154 Function GetTempName(FN: String): String;
GetTextPosnull155 Function GetTextPos(Var F: Text): LongInt;
FindOnPathnull156 Function FindOnPath(FN: String; Var OutName: String): Boolean;
CopyFilenull157 Function CopyFile(FN1: String; FN2: String): Boolean;
EraseFilenull158 Function EraseFile(FN: String): Boolean;
MakePathnull159 Function MakePath(FP: String): Boolean;
160
161
162 Implementation
163
164 {$IfNDef FPC}
165 Uses Crt;
166 {$EndIf}
167
168
169 Procedure FindObj.Init;
170 Begin
171 New(FI);
172 FI^.DError := 1;
173 End;
174
175
176 Procedure FindObj.Done;
177 Begin
178 Dispose(FI);
179 End;
180
181
182 Procedure FindObj.FFirst(FN: String);
183 Begin
184 FN := FExpand(FN);
185 FSplit(FN, FI^.Dir, FI^.Name, FI^.Ext);
186 FindFirst(FN, Archive + ReadOnly, FI^.SR);
187 FI^.DError := dos.DosError;
188 End;
189
190
FindObj.GetNamenull191 Function FindObj.GetName: String;
192 Begin
193 If Found Then
194 Begin
195 GetName := FI^.SR.Name
196 End
197 Else
198 GetName := '';
199 End;
200
201
FindObj.GetFullPathnull202 Function FindObj.GetFullPath: String;
203 Begin
204 GetFullPath := FI^.Dir + GetName;
205 End;
206
207
FindObj.GetSizenull208 Function FindObj.GetSize: LongInt;
209 Begin
210 If Found Then
211 GetSize := FI^.SR.Size
212 Else
213 GetSize := 0;
214 End;
215
216
FindObj.GetDatenull217 Function FindObj.GetDate: LongInt;
218 Begin
219 If Found Then
220 GetDate := FI^.SR.Time
221 Else
222 GetDate := 0;
223 End;
224
225
226 Procedure FindObj.FNext;
227 Begin
228 FindNext(FI^.SR);
229 FI^.DError := dos.DosError;
230 End;
231
232
FindObj.Foundnull233 Function FindObj.Found: Boolean;
234 Begin
235 Found := (FI^.DError = 0);
236 End;
237
238
shAssignnull239 Function shAssign(Var F: File; FName: String): Boolean;
240 Begin
241 Assign(F, FName);
242 MKFileError := IoResult;
243 shAssign := (MKFileError = 0);
244 End;
245
246
247 {$IFNDEF VIRTUALPASCAL}
shReadnull248 Function shRead(Var F: File; Var Rec; ReadSize: Word; Var NumRead: Word): Boolean;
249 {$ELSE}
shReadnull250 Function shRead(Var F: File; Var Rec; ReadSize: Word; Var NumRead: LongInt): Boolean;
251 {$ENDIF}
252 Var
253 Count: Word;
254 Code: Word;
255 {$IfDef SPEED}
256 nr: LongWord;
257 {$EndIf}
258
259 Begin
260 if ioresult<>0 then;
261 Count := Tries;
262 Code := 5;
263 While ((Count > 0) and (Code = 5)) Do Begin
264 {$IfDef SPEED}
265 BlockRead(F,Rec,ReadSize,NR);
266 NumRead := NR;
267 {$Else}
268 BlockRead(F,Rec,ReadSize,NumRead);
269 {$EndIf}
270 Code := IoResult;
271 Dec(Count);
272 End;
273 MKFileError := Code;
274 ShRead := (Code = 0);
275 End;
276
277 {$IFNDEF VIRTUALPASCAL}
shWritenull278 Function shWrite(Var F: File; Var Rec; ReadSize: Word): Boolean;
279 {$ELSE}
shWritenull280 Function shWrite(Var F: File; Var Rec; ReadSize: LongInt): Boolean;
281 {$ENDIF}
282 Var
283 Count: Word;
284 Code: Word;
285
286 Begin
287 Count := Tries;
288 Code := 5;
289 While ((Count > 0) and (Code = 5)) Do
290 Begin
291 BlockWrite(F,Rec,ReadSize);
292 Code := IoResult;
293 Dec(Count);
294 End;
295 MKFileError := Code;
296 shWrite := (Code = 0);
297 End;
298
299
300 Procedure CleanDir(FileDir: String);
301 Var
302 SR: SearchRec;
303 F: File;
304
305 Begin
306 FindFirst(FileDir + '*.*', ReadOnly + Archive, SR);
307 While dos.DosError = 0 Do
308 Begin
309 If Not shAssign(F, FileDir + SR.Name) Then;
310 Erase(F);
311 If IoResult <> 0 Then;
312 FindNext(SR);
313 End;
314 End;
315
316
317
GetCurrentPathnull318 Function GetCurrentPath: String;
319 Var
320 CName: NameStr;
321 Path: DirStr;
322 CExt: ExtStr;
323
324 Begin
325 FSplit(FExpand('*.*'),Path,CName,CExt);
326 GetCurrentPath := Path;
327 End;
328
329
shLocknull330 Function shLock(Var F; LockStart,LockLength: LongInt): Word;
331 Var
332 Count: Word;
333 Code: Word;
334 i: Word;
335
336 Begin
337 Count := Tries;
338 Code := $21;
339 While ((Count > 0) and (Code = $21)) Do
340 Begin
341 Code := LockFile(F,LockStart,LockLength);
342 Dec(Count);
343 If Code = $21 Then
344 Delay(TryDelay);
345 End;
346 If Code = 1 Then
347 Code := 0;
348 shLock := Code;
349 End;
350
351
352
shResetnull353 Function shReset(Var F: File; RecSize: Word): Boolean;
354 Var
355 Count: Word;
356 Code: Word;
357
358 Begin
359 Count := Tries;
360 Code := 5;
361 While ((Count > 0) and (Code = 5)) Do
362 Begin
363 {$I-} Reset(F,RecSize);
364 Code := IoResult;
365 Dec(Count);
366 End;
367 MKFileError := Code;
368 ShReset := (Code = 0);
369 End;
370
371 {$IFDEF OS2}
372 procedure FlushFile(Var F);
373 var handle,
374 newhandle : LongInt {HFILE};
375 rc : APIRET;
376 begin
377 handle := FileRec(F).handle;
378 newhandle := HFile(-1);
379 if DosDupHandle(handle, newHandle) = 0 then
380 rc := DosClose(newHandle);
381 end;
382 {$ELSE}
383 {$IFDEF FPC}
384 procedure FlushFile(Var F);
385 begin
386 Flush(text(F));
387 end;
388 {$ELSE}
389 Procedure FlushFile(Var F); {Dupe file handle, close dupe handle}
390 Var
391 Handle: Word Absolute F;
392 {$IFDEF BASMINT}
393 Tmp: Word;
394 {$ELSE}
395 Regs: Registers;
396 {$ENDIF}
397
398 Begin
399 {$IFDEF BASMINT}
400 Tmp := Handle;
401 Asm
402 Mov ah, $45;
403 Mov bx, Tmp;
404 Int $21;
405 Jc @JFlush;
406 Mov bx, ax;
407 Mov ah, $3e;
408 Int $21;
409 @JFlush:
410 End;
411 {$ELSE}
412 Regs.ah := $45;
413 Regs.bx := Handle;
414 MsDos(Regs);
415 If (Regs.Flags and 1) = 0 Then {carry}
416 Begin
417 Regs.bx := Regs.ax;
418 Regs.Ah := $3e;
419 MsDos(Regs);
420 End;
421 {$ENDIF}
422 End;
423 {$EndIf}
424 {$ENDIF}
425
426 {$IFDEF OS2}
LockFilenull427 function LockFile(Var F; LockStart: LongInt; LockLength: LongInt): Word;
428
429 var
430 lock, unlock : FileLock;
431
432 begin
433 with lock do
434 begin
435 lOffset := LockStart;
436 lRange := LockLength;
437 end;
438 with unlock do
439 begin
440 lOffset := 0;
441 lRange := 0;
442 end;
443 LockFile := DosSetFileLocks(FileRec(F).Handle, unlock, lock, 1000, 0);
444 end;
445 {$ELSE}
446 {$IfDef UNIX}
LockFilenull447 Function LockFile(Var F; LockStart: LongInt; LockLength: LongInt): Word;
448 Begin
449 FLock(file(f), Lock_Ex);
450 LockFile := LinuxError;
451 End;
452 {$Else}
453
LockFilenull454 Function LockFile(Var F; LockStart: LongInt; LockLength: LongInt): Word;
455 Var
456 Handle: Word Absolute F;
457 Tmp: Word;
458 StrtHi: Word;
459 StrtLo: Word;
460 LgHi: Word;
461 LgLo: Word;
462 {$IFNDEF BASMINT}
463 Regs: Registers;
464 {$ENDIF}
465
466 Begin
467 Tmp := Handle;
468 StrtHi := LongHi(LockStart);
469 StrtLo := LongLo(LockStart);
470 LgHi := LongHi(LockLength);
471 LgLo := LongLo(LockLength);
472 {$IFDEF BASMINT}
473 Asm
474 Mov ah, $5c;
475 Mov al, $00;
476 Mov bx, Tmp;
477 Mov cx, StrtHi;
478 Mov dx, StrtLo;
479 Mov si, LgHi; {00h = success }
480 Mov di, LgLo; {01h = share not loaded }
481 Int $21; {06h = invalid handle }
482 Jc @JLock {21h = lock violation }
483 Mov ax, $00; {24h = share buffer full }
484 @JLock:
485 Mov Tmp, ax;
486 End;
487 {$ELSE}
488 Regs.ah := $5c;
489 Regs.al := $00;
490 Regs.bx := Tmp;
491 Regs.cx := StrtHi;
492 Regs.dx := StrtLo;
493 Regs.si := LgHi;
494 Regs.di := LgLo;
495 MsDos(Regs);
496 If (Regs.Flags and 1) = 0 Then
497 Begin
498 Regs.ax := 0;
499 End;
500 Tmp := Regs.ax;
501 {$ENDIF}
502 If Tmp = 1 Then
503 Tmp := 0;
504 LockFile := Tmp;
505 End;
506 {$EndIf}
507 {$ENDIF}
508
509 {$IFDEF OS2}
UnLockFilenull510 function UnLockFile(Var F; LockStart: LongInt; LockLength: LongInt): Word;
511
512 var
513 lock, unlock : FileLock;
514
515 begin
516 with unlock do
517 begin
518 lOffset := LockStart;
519 lRange := LockLength;
520 end;
521 with lock do
522 begin
523 lOffset := 0;
524 lRange := 0;
525 end;
526 UnLockFile := DosSetFileLocks(FileRec(F).Handle, unlock, lock, 1000, 0);
527 end;
528
529 {$ELSE}
530 {$IfDef UNIX}
UnLockFilenull531 Function UnLockFile(Var F; LockStart: LongInt; LockLength: LongInt): Word;
532 Begin
533 FLock(file(f), Lock_Un);
534 UnLockFile := LinuxError;
535 End;
536 {$Else}
537
UnLockFilenull538 Function UnLockFile(Var F; LockStart: LongInt; LockLength: LongInt): Word;
539 Var
540 Handle: Word Absolute F;
541 Tmp: Word;
542 StrtHi: Word;
543 StrtLo: Word;
544 LgHi: Word;
545 LgLo: Word;
546 {$IFNDEF BASMINT}
547 Regs: Registers;
548 {$ENDIF}
549
550 Begin
551 Tmp := Handle;
552 StrtHi := LongHi(LockStart);
553 StrtLo := LongLo(LockStart);
554 LgHi := LongHi(LockLength);
555 LgLo := LongLo(LockLength);
556 {$IFDEF BASMINT}
557 Asm
558 Mov ah, $5c;
559 Mov al, $01;
560 Mov bx, Tmp;
561 Mov cx, StrtHi;
562 Mov dx, StrtLo;
563 Mov si, LgHi; {00h = success }
564 Mov di, LgLo; {01h = share not loaded }
565 Int $21; {06h = invalid handle }
566 Jc @JLock {21h = lock violation }
567 Mov ax, $00; {24h = share buffer full }
568 @JLock:
569 Mov Tmp, ax;
570 End;
571 {$ELSE}
572 Regs.ah := $5c;
573 Regs.al := $01;
574 Regs.bx := Tmp;
575 Regs.cx := StrtHi;
576 Regs.dx := StrtLo;
577 Regs.si := LgHi;
578 Regs.di := LgLo;
579 MsDos(Regs);
580 If (Regs.Flags and 1) = 0 Then
581 Begin
582 Regs.ax := 0;
583 End;
584 Tmp := Regs.ax;
585 {$ENDIF}
586 If Tmp = 1 Then
587 Tmp := 0;
588 UnLockFile := Tmp;
589 End;
590 {$EndIf}
591 {$ENDIF}
592
593
LongLonull594 Function LongLo(InNum: LongInt): Word;
595 Begin
596 LongLo := InNum and $FFFF;
597 End;
598
599
LongHinull600 Function LongHi(InNum: LongInt): Word;
601 Begin
602 LongHi := InNum Shr 16;
603 End;
604
605
SizeFilenull606 Function SizeFile(FName: String): LongInt;
607 Var
608 SR: SearchRec;
609
610 Begin
611 FindFirst(FName, AnyFile, SR);
612 If dos.DosError = 0 Then
613 SizeFile := SR.Size
614 Else
615 SizeFile := -1;
616 End;
617
618
DateFilenull619 Function DateFile(FName: String): LongInt;
620 Var
621 SR: SearchRec;
622
623 Begin
624 FindFirst(FName, AnyFile, SR);
625 If dos.DosError = 0 Then
626 DateFile := SR.Time
627 Else
628 DateFile := 0;
629 End;
630
631
existnull632 function exist (fname : string; attr : word) : boolean;
633 var
634 sr : SearchRec;
635 begin
636 FindFirst (fname, attr, sr);
637 exist := (dos.DosError = 0);
638 {$IFDEF OS2}
639 FindClose(sr);
640 {$ENDIF}
641 end;
642
FileExistnull643 function FileExist(FName: String): Boolean;
644 var
645 SR: SearchRec;
646 begin
647 FindFirst(FName, ReadOnly + Hidden + Archive + directory, SR);
648 FileExist:=(dos.DosError = 0);
649 {$IFDEF OS2}
650 FindClose(SR);
651 {$ENDIF}
652 end;
653
654
FindPathnull655 Function FindPath(FileName: String):String;
656 Begin
657 FindPath := FileName;
658 If FileExist(FileName) Then
659 FindPath := FExpand(FileName)
660 Else
661 FindPath := FExpand(FSearch(FileName,DOS.GetEnv('PATH')));
662 End;
663
664
665 Procedure TFile.BufferRead;
666 Begin
667 TF^.BufferStart := FilePos(TF^.BufferFile);
668 if Not shRead (TF^.BufferFile,TF^.MsgBuffer^ , TF^.BufferSize, TF^.BufferChars) Then
669 TF^.BufferChars := 0;
670 TF^.BufferPtr := 1;
671 End;
672
673
TFile.GetCharnull674 Function TFile.GetChar: Char;
675 Begin
676 If TF^.BufferPtr > TF^.BufferChars Then
677 BufferRead;
678 If TF^.BufferChars > 0 Then
679 GetChar := TF^.MsgBuffer^[TF^.BufferPtr]
680 Else
681 GetChar := #0;
682 Inc(TF^.BufferPtr);
683 If TF^.BufferPtr > TF^.BufferChars Then
684 BufferRead;
685 End;
686
687
TFile.GetStringnull688 Function TFile.GetString: String;
689
690 Var
691 TempStr: String;
692 GDone: Boolean;
693 Ch: Char;
694
695 Begin
696 TempStr := '';
697 GDone := False;
698 TF^.StringFound := False;
699 While Not GDone Do
700 Begin
701 Ch := GetChar;
702 Case Ch Of
703 #0: If TF^.BufferChars = 0 Then
704 GDone := True
705 Else
706 Begin
707 Inc(byte(TempStr[0]));
708 TempStr[Ord(TempStr[0])] := Ch;
709 TF^.StringFound := True;
710 If Length(TempStr) = 255 Then
711 GDone := True;
712 End;
713 #10:;
714 #26:;
715 #13: Begin
716 GDone := True;
717 TF^.StringFound := True;
718 End;
719 Else
720 Begin
721 Inc(byte(TempStr[0]));
722 TempStr[Ord(TempStr[0])] := Ch;
723 TF^.StringFound := True;
724 If Length(TempStr) = 255 Then
725 GDone := True;
726 End;
727 End;
728 End;
729 GetString := TempStr;
730 End;
731
732
TFile.GetUStringnull733 Function TFile.GetUString: String;
734
735 Var
736 TempStr: String;
737 GDone: Boolean;
738 Ch: Char;
739
740 Begin
741 TempStr := '';
742 GDone := False;
743 TF^.StringFound := False;
744 While Not GDone Do
745 Begin
746 Ch := GetChar;
747 Case Ch Of
748 #0: If TF^.BufferChars = 0 Then
749 GDone := True
750 Else
751 Begin
752 Inc(byte(TempStr[0]));
753 TempStr[Ord(TempStr[0])] := Ch;
754 TF^.StringFound := True;
755 If Length(TempStr) = 255 Then
756 GDone := True;
757 End;
758 #13:;
759 #26:;
760 #10: Begin
761 GDone := True;
762 TF^.StringFound := True;
763 End;
764 Else
765 Begin
766 Inc(byte(TempStr[0]));
767 TempStr[Ord(TempStr[0])] := Ch;
768 TF^.StringFound := True;
769 If Length(TempStr) = 255 Then
770 GDone := True;
771 End;
772 End;
773 End;
774 GetUString := TempStr;
775 End;
776
777
TFile.OpenTextFilenull778 Function TFile.OpenTextFile(FilePath: String): Boolean;
779 Begin
780 If Not shAssign(TF^.BufferFile, FilePath) Then;
781 FileMode := fmReadOnly + fmDenyNone;
782 If Not shReset(TF^.BufferFile,1) Then
783 OpenTextFile := False
784 Else
785 Begin
786 BufferRead;
787 If TF^.BufferChars > 0 Then
788 TF^.StringFound := True
789 Else
790 TF^.StringFound := False;
791 OpenTextFile := True;
792 End;
793 End;
794
795
TFile.SeekTextFilenull796 Function TFile.SeekTextFile(SeekPos: LongInt): Boolean;
797 Begin
798 TF^.Error := 0;
799 If ((SeekPos < TF^.BufferStart) Or (SeekPos > TF^.BufferStart + TF^.BufferChars)) Then
800 Begin
801 Seek(TF^.BufferFile, SeekPos);
802 TF^.Error := IoResult;
803 BufferRead;
804 End
805 Else
806 Begin
807 TF^.BufferPtr := SeekPos + 1 - TF^.BufferStart;
808 End;
809 SeekTextFile := (TF^.Error = 0);
810 End;
811
812
TFile.GetTextPosnull813 Function TFile.GetTextPos: LongInt; {Get text file position}
814 Begin
815 GetTextPos := TF^.BufferStart + TF^.BufferPtr - 1;
816 End;
817
818
TFile.Restartnull819 Function TFile.Restart: Boolean;
820 Begin
821 Restart := SeekTextFile(0);
822 End;
823
824
TFile.CloseTextFilenull825 Function TFile.CloseTextFile: Boolean;
826 Begin
827 Close(TF^.BufferFile);
828 CloseTextFile := (IoResult = 0);
829 End;
830
831
832 Procedure TFile.SetBufferSize(BSize: Word);
833 Begin
834 FreeMem(TF^.MsgBuffer, TF^.BufferSize);
835 TF^.BufferSize := BSize;
836 GetMem(TF^.MsgBuffer, TF^.BufferSize);
837 TF^.BufferChars := 0;
838 TF^.BufferStart := 0;
839 If SeekTextFile(GetTextPos) Then;
840 End;
841
842
843 Procedure TFile.Init;
844 Begin
845 New(TF);
846 TF^.BufferSize := 2048;
847 GetMem(TF^.MsgBuffer, TF^.BufferSize);
848 End;
849
850
851 Procedure TFile.Done;
852 Begin
853 Close(TF^.BufferFile);
854 If IoResult <> 0 Then;
855 FreeMem(TF^.MsgBuffer, TF^.BufferSize);
856 Dispose(TF);
857 End;
858
859
TFile.StringFoundnull860 Function TFile.StringFound: Boolean;
861 Begin
862 StringFound := TF^.StringFound;
863 End;
864
865
shOpenFilenull866 Function shOpenFile(Var F: File; PathName: String): Boolean;
867 Begin
868 Assign(f,pathname);
869 FileMode := fmReadWrite + fmDenyNone;
870 shOpenFile := shReset(f,1);
871 End;
872
873
shMakeFilenull874 Function shMakeFile(Var F: File; PathName: String): Boolean;
875 Begin
876 Assign(f,pathname);
877 {$I-} ReWrite(f,1);
878 shMakeFile := (IOresult = 0);
879 END;
880
881
882 Procedure shCloseFile(Var F: File);
883 Begin
884 Close(F);
885 If (IOresult <> 0) Then;
886 End;
887
888
shSeekFilenull889 Function shSeekFile(Var F: File; FPos: LongInt): Boolean;
890 Begin
891 Seek(F,FPos);
892 shSeekFile := (IOresult = 0);
893 End;
894
895
shFindFilenull896 Function shFindFile(Pathname: String; Var Name: String; Var Size, Time: LongInt): Boolean;
897 Var
898 SR: SearchRec;
899
900 Begin
901 FindFirst(PathName, Archive, SR);
902 If (dos.DosError = 0) Then
903 Begin
904 shFindFile := True;
905 Name := Sr.Name;
906 Size := Sr.Size;
907 Time := Sr.Time;
908 End
909 Else
910 Begin
911 shFindFile := False;
912 End;
913 End;
914
915
916 Procedure shSetFTime(Var F: File; Time: LongInt);
917 Begin
918 SetFTime(F, Time);
919 If (IOresult <> 0) Then;
920 End;
921
922 {$IFDEF OS2}
IsDevicenull923 function IsDevice(FilePath: String): Boolean;
924 begin
925 runerror(211);
926 end;
927 {$ELSE}
928 {$IFDEF FPC}
IsDevicenull929 function IsDevice(FilePath: String): Boolean;
930 Var
931 info: Stat;
932
933 begin
934 FStat(FilePath, info);
935 IsDevice := not S_ISREG(info.mode);
936 end;
937
938 {$ELSE}
IsDevicenull939 Function IsDevice(FilePath: String): Boolean;
940 Var
941 F: File;
942 Handle: Word Absolute F;
943 Tmp: Word;
944 {$IFNDEF BASMINT}
945 Regs: Registers;
946 {$ENDIF}
947
948 Begin
949 Assign(F, FilePath);
950 {$I-} Reset(F);
951 If IoResult <> 0 Then
952 IsDevice := False
953 Else
954 Begin
955 Tmp := Handle;
956 {$IFDEF BASMINT}
957 Asm
958 Mov ah, $44;
959 Mov al, $00;
960 Mov bx, Tmp;
961 Int $21;
962 Or dx, $80;
963 Je @JDev;
964 Mov ax, $01;
965 @JDev:
966 Mov ax, $00;
967 Mov @Result, al;
968 End;
969 {$ELSE}
970 Regs.ah := $44;
971 Regs.al := $00;
972 Regs.bx := Tmp;
973 MsDos(Regs);
974 IsDevice := (Regs.Dx and $80) <> 0;
975 {$ENDIF}
976 End;
977 Close(F);
978 If IoResult <> 0 Then;
979 End;
980 {$EndIf}
981 {$ENDIF}
982
983
LoadFilenull984 Function LoadFile(FN: String; Var Rec; FS: Word): Word;
985 Begin
986 LoadFile := LoadFilePos(FN, Rec, FS, 0);
987 End;
988
989
LoadFilePosnull990 Function LoadFilePos(FN: String; Var Rec; FS: Word; FPos: LongInt): Word;
991 Var
992 F: File;
993 Error: Word;
994 {$IFDEF VirtualPascal}
995 NumRead: LongInt;
996 {$ELSE}
997 NumRead: Word;
998 {$ENDIF}
999 Begin
1000 Error := 0;
1001 If Not FileExist(FN) Then
1002 Error := 8888;
1003 If Error = 0 Then
1004 Begin
1005 If Not shAssign(F, FN) Then
1006 Error := MKFileError;
1007 End;
1008 FileMode := fmReadOnly + fmDenyNone;
1009 If Not shReset(F,1) Then
1010 Error := MKFileError;
1011 If Error = 0 Then
1012 Begin
1013 Seek(F, FPos);
1014 Error := IoResult;
1015 End;
1016 If Error = 0 Then
1017 If Not shRead(F, Rec, FS, NumRead) Then
1018 Error := MKFileError;
1019 If Error = 0 Then
1020 Begin
1021 Close(F);
1022 Error := IoResult;
1023 End;
1024 LoadFilePos := Error;
1025 End;
1026
1027
SaveFilenull1028 Function SaveFile(FN: String; Var Rec; FS: Word): Word;
1029 Begin
1030 SaveFile := SaveFilePos(FN, Rec, FS, 0);
1031 End;
1032
1033
1034
SaveFilePosnull1035 Function SaveFilePos(FN: String; Var Rec; FS: Word; FPos: LongInt): Word;
1036 Var
1037 F: File;
1038 Error: Word;
1039
1040 Begin
1041 Error := 0;
1042 If Not shAssign(F, FN) Then
1043 Error := MKFileError;
1044 FileMode := fmReadWrite + fmDenyNone;
1045 If FileExist(FN) Then
1046 Begin
1047 If Not shReset(F,1) Then
1048 Error := MKFileError;
1049 End
1050 Else
1051 Begin
1052 {$I-} ReWrite(F,1);
1053 Error := IoResult;
1054 End;
1055 If Error = 0 Then
1056 Begin
1057 Seek(F, FPos);
1058 Error := IoResult;
1059 End;
1060 If Error = 0 Then
1061 If FS > 0 Then
1062 Begin
1063 If Not shWrite(F, Rec, FS) Then
1064 Error := MKFileError;
1065 End;
1066 If Error = 0 Then
1067 Begin
1068 Close(F);
1069 Error := IoResult;
1070 End;
1071 SaveFilePos := Error;
1072 End;
1073
1074
ExtendFilenull1075 Function ExtendFile(FN: String; ToSize: LongInt): Word;
1076 {Pads file with nulls to specified size}
1077 Type
1078 FillType = Array[1..8000] of Byte;
1079
1080 Var
1081 F: File;
1082 Error: Word;
1083 FillRec: ^FillType;
1084
1085 Begin
1086 Error := 0;
1087 New(FillRec);
1088 If FillRec = Nil Then
1089 Error := 10;
1090 If Error = 0 Then
1091 Begin
1092 FillChar(FillRec^, SizeOf(FillRec^), 0);
1093 If Not shAssign(F, FN) Then
1094 Error := MKFileError;
1095 FileMode := fmReadWrite + fmDenyNone;
1096 If FileExist(FN) Then
1097 Begin
1098 If Not shReset(F,1) Then
1099 Error := MKFileError;
1100 End
1101 Else
1102 Begin
1103 {$I-} ReWrite(F,1);
1104 Error := IoResult;
1105 End;
1106 End;
1107 If Error = 0 Then
1108 Begin
1109 Seek(F, FileSize(F));
1110 Error := IoResult;
1111 End;
1112 If Error = 0 Then
1113 Begin
1114 While ((FileSize(F) < (ToSize - SizeOf(FillRec^))) and (Error = 0)) Do
1115 Begin
1116 If Not shWrite(F, FillRec^, SizeOf(FillRec^)) Then
1117 Error := MKFileError;
1118 End;
1119 End;
1120 If ((Error = 0) and (FileSize(F) < ToSize)) Then
1121 Begin
1122 If Not shWrite(F, FillRec^, ToSize - FileSize(F)) Then
1123 Error := MKFileError;
1124 End;
1125 If Error = 0 Then
1126 Begin
1127 Close(F);
1128 Error := IoResult;
1129 End;
1130 Dispose(FillRec);
1131 ExtendFile := Error;
1132 End;
1133
1134 {$IFDEF OS2}
CreateTempDirnull1135 function CreateTempDir(FN: String): String;
1136
1137 begin
1138 runerror(211);
1139 end;
1140 {$ELSE}
1141 {$IfDef FPC}
CreateTempDirnull1142 function CreateTempDir(FN: String): String;
1143
1144 begin
1145 end;
1146 {$Else}
CreateTempDirnull1147 Function CreateTempDir(FN: String): String;
1148 Var
1149 TOfs: Word;
1150 TSeg: Word;
1151 FH: Word;
1152 i: Word;
1153 TmpStr: String;
1154
1155 Begin
1156 TSeg := Seg(TmpStr[1]);
1157 TOfs := Ofs(TmpStr[1]);
1158 If ((Length(FN) > 0) and (FN[Length(FN)] <> DirSep)) Then
1159 TmpStr := FN + DirSep
1160 Else
1161 TmpStr := FN;
1162 For i := 1 to 16 Do
1163 TmpStr[Length(TmpStr) + i] := #0;
1164 i := 0;
1165 Asm
1166 Mov bx, TSeg;
1167 Mov ax, TOfs;
1168 Push ds;
1169 Mov ds, bx;
1170 Mov dx, ax;
1171 Mov ah, $5a;
1172 Mov ch, $00;
1173 ; {Mov dx, TSeg;}
1174 ; {Mov ds, dx;}
1175 ; {Mov dx, TOfs;}
1176 Mov cl, $00;
1177 Int $21; {Create tmp file}
1178 Mov FH, ax;
1179 Mov ax, 1;
1180 jc @JErr
1181 Mov bx, FH;
1182 Mov ah, $3e;
1183 jmp @J3;
1184 Int $21; {Close tmp file}
1185 @J3:
1186 Mov ax, 2;
1187 jc @JErr;
1188 Mov ah, $41
1189 Mov dx, TSeg;
1190 Mov ds, dx;
1191 Mov dx, TOfs;
1192 Int $21; {Erase tmp file}
1193 Mov ax, 3;
1194 jc @JErr;
1195 Mov ah, $39;
1196 Mov dx, TSeg;
1197 Mov ds, dx;
1198 Mov dx, TOfs;
1199 Int $21; {Create directory}
1200 Mov ax, 4;
1201 jc @JErr;
1202 Jmp @JEnd;
1203 @JErr:
1204 Mov i, ax;
1205 @JEnd:
1206 Pop ds;
1207 End;
1208 TmpStr[0] := #255;
1209 TmpStr[0] := Chr(Pos(#0, TmpStr) - 1);
1210 If i = 0 Then
1211 CreateTempDir := TmpStr
1212 Else
1213 CreateTempDir := '';
1214 End;
1215 {$EndIf}
1216 {$ENDIF}
1217
1218 {$IFDEF OS2}
GetTempNamenull1219 function GetTempName(FN: String): String;
1220
1221 var
1222 TmpStr,
1223 tmp : string;
1224 nr : LongInt;
1225
1226 begin
1227 If ((Length(FN) > 0) and (FN[Length(FN)] <> DirSep)) Then
1228 TmpStr := FN + DirSep
1229 Else
1230 TmpStr := FN;
1231 nr := 0;
1232 repeat
1233 inc(nr);
1234 str(nr, tmp);
1235 until (nr = 1000) or not (fileexist(tmpstr+tmp));
1236 if nr <> 1000 then GetTempName := tmpstr+tmp else gettempname := '';
1237 end;
1238
1239 {$ELSE}
1240 {$IfDef FPC}
GetTempNamenull1241 function GetTempName(FN: String): String;
1242
1243 var
1244 TmpStr,
1245 tmp : string;
1246 nr : LongInt;
1247
1248 begin
1249 If ((Length(FN) > 0) and (FN[Length(FN)] <> DirSep)) Then
1250 TmpStr := FN + DirSep
1251 Else
1252 TmpStr := FN;
1253 nr := 0;
1254 repeat
1255 inc(nr);
1256 str(nr, tmp);
1257 until (nr = 1000) or not (fileexist(tmpstr+tmp));
1258 if nr <> 1000 then GetTempName := tmpstr+tmp else gettempname := '';
1259 end;
1260 {$Else}
1261
GetTempNamenull1262 Function GetTempName(FN: String): String;
1263 Var
1264 TOfs: Word;
1265 TSeg: Word;
1266 FH: Word;
1267 i: Word;
1268 TmpStr: String;
1269
1270 Begin
1271 TSeg := Seg(TmpStr[1]);
1272 TOfs := Ofs(TmpStr[1]);
1273 If ((Length(FN) > 0) and (FN[Length(FN)] <> DirSep)) Then
1274 TmpStr := FN + DirSep
1275 Else
1276 TmpStr := FN;
1277 For i := 1 to 16 Do
1278 TmpStr[Length(TmpStr) + i] := #0;
1279 i := 0;
1280 Asm
1281 Push ds;
1282 Mov ah, $5a;
1283 Mov ch, $00;
1284 Mov dx, TSeg;
1285 Mov ds, dx;
1286 Mov dx, TOfs;
1287 Mov cl, $00;
1288 Int $21; {Create tmp file}
1289 Mov FH, ax;
1290 Mov ax, 1;
1291 jc @JErr
1292 Mov bx, FH;
1293 Mov ah, $3e;
1294 {jmp @J3; this was originally in my code, appears to be an error}
1295 Int $21; {Close tmp file}
1296 @J3:
1297 Mov ax, 2;
1298 jc @JErr;
1299 Mov ah, $41
1300 Mov dx, TSeg;
1301 Mov ds, dx;
1302 Mov dx, TOfs;
1303 Int $21; {Erase tmp file}
1304 Mov ax, 3;
1305 jc @JErr;
1306 jmp @JEnd
1307 @JErr:
1308 Mov i, ax;
1309 @JEnd:
1310 Pop ds;
1311 End;
1312 TmpStr[0] := #255;
1313 TmpStr[0] := Chr(Pos(#0, TmpStr) - 1);
1314 If i = 0 Then
1315 GetTempName := TmpStr
1316 Else
1317 GetTempName := '';
1318 End;
1319 {$EndIf}
1320 {$ENDIF}
1321
1322 {$IFDEF OS2}
gettextposnull1323 function gettextpos(var f:text): LongInt;
1324 begin
1325 runerror(211);
1326 end;
1327 {$ELSE}
1328 {$IfDef FPC}
gettextposnull1329 function gettextpos(var f:text): LongInt;
1330 begin
1331 end;
1332 {$Else}
GetTextPosnull1333 Function GetTextPos(Var F: Text): LongInt;
1334 Type WordRec = Record
1335 LongLo: Word;
1336 LongHi: Word;
1337 End;
1338
1339 Var
1340 TR: TextRec Absolute F;
1341 Tmp: LongInt;
1342 Handle: Word;
1343 {$IFNDEF BASMINT}
1344 Regs: Registers;
1345 {$ENDIF}
1346
1347 Begin
1348 Handle := TR.Handle;
1349 {$IFDEF BASMINT}
1350 Asm
1351 Mov ah, $42;
1352 Mov al, $01;
1353 Mov bx, Handle;
1354 Mov cx, 0;
1355 Mov dx, 0;
1356 Int $21;
1357 Jnc @TP2;
1358 Mov ax, $ffff;
1359 Mov dx, $ffff;
1360 @TP2:
1361 Mov WordRec(Tmp).LongLo, ax;
1362 Mov WordRec(Tmp).LongHi, dx;
1363 End;
1364 {$ELSE}
1365 Regs.ah := $42;
1366 Regs.al := $01;
1367 Regs.bx := Handle;
1368 Regs.cx := 0;
1369 Regs.dx := 0;
1370 MsDos(Regs);
1371 If (Regs.Flags and 1) <> 0 Then
1372 Begin
1373 Regs.ax := $ffff;
1374 Regs.dx := $ffff;
1375 End;
1376 WordRec(Tmp).LongLo := Regs.Ax;
1377 WordRec(Tmp).LongHi := Regs.Dx;
1378 {$ENDIF}
1379 If Tmp >= 0 Then
1380 Inc(Tmp, TR.BufPos);
1381 GetTextPos := Tmp;
1382 End;
1383 {$EndIf}
1384 {$ENDIF}
1385
1386
FindOnPathnull1387 Function FindOnPath(FN: String; Var OutName: String): Boolean;
1388 Var
1389 TmpStr: String;
1390
1391 Begin
1392 If FileExist(FN) Then
1393 Begin
1394 OutName := FExpand(FN);
1395 FindOnPath := True;
1396 End
1397 Else
1398 Begin
1399 TmpStr := FSearch(FN, DOS.GetEnv('Path'));
1400 If FileExist(TmpStr) Then
1401 Begin
1402 OutName := TmpStr;
1403 FindOnPath := True;
1404 End
1405 Else
1406 Begin
1407 OutName := FN;
1408 FindOnPath := False;
1409 End;
1410 End;
1411 End;
1412
1413
CopyFilenull1414 Function CopyFile(FN1: String; FN2: String): Boolean;
1415 Type
1416 TmpBufType = Array[1..8192] of Byte;
1417
1418 Var
1419 F1: File;
1420 F2: File;
1421 {$IFDEF VirtualPascal}
1422 NumRead: LongInt;
1423 {$ELSE}
1424 {$IfDef SPEED}
1425 NumRead: LongWord;
1426 {$Else}
1427 NumRead: Word;
1428 {$EndIf}
1429 {$ENDIF}
1430 Buf: ^TmpBufType;
1431 Error: Word;
1432
1433 Begin
1434 New(Buf);
1435 Error := 0;
1436 Assign(F1, FN1);
1437 FileMode := fmReadOnly + fmDenyNone;
1438 {$I-} Reset(F1, 1);
1439 Error := IoResult;
1440 If Error = 0 Then
1441 Begin
1442 Assign(F2, FN2);
1443 FileMode := fmReadWrite + fmDenyNone;
1444 {$I-} ReWrite(F2, 1);
1445 Error := IoResult;
1446 End;
1447 If Error = 0 Then
1448 Begin
1449 BlockRead(F1, Buf^, SizeOf(Buf^), NumRead);
1450 Error := IoResult;
1451 While ((NumRead <> 0) and (Error = 0)) Do
1452 Begin
1453 BlockWrite(F2, Buf^, NumRead);
1454 Error := IoResult;
1455 If Error = 0 Then
1456 Begin
1457 BlockRead(F1, Buf^, SizeOf(Buf^), NumRead);
1458 Error := IoResult;
1459 End;
1460 End;
1461 End;
1462 If Error = 0 Then
1463 Begin
1464 Close(F1);
1465 Error := IoResult;
1466 End;
1467 If Error = 0 Then
1468 Begin
1469 Close(F2);
1470 Error := IoResult;
1471 End;
1472 Dispose(Buf);
1473 CopyFile := (Error = 0);
1474 End;
1475
1476
EraseFilenull1477 Function EraseFile(FN: String): Boolean;
1478 Var
1479 F: File;
1480
1481 Begin
1482 Assign(F, FN);
1483 Erase(F);
1484 EraseFile := (IoResult = 0);
1485 End;
1486
1487
MakePathnull1488 Function MakePath(FP: String): Boolean;
1489 Var
1490 i: Word;
1491
1492 Begin
1493 If FP[Length(FP)] <> DirSep Then
1494 FP := FP + DirSep;
1495 If Not FileExist(FP + 'Nul') Then
1496 Begin
1497 i := 2;
1498 While (i <= Length(FP)) Do
1499 Begin
1500 If FP[i] = DirSep Then
1501 Begin
1502 If FP[i-1] <> ':' Then
1503 Begin
1504 MkDir(Copy(FP, 1, i - 1));
1505 If IoResult <> 0 Then;
1506 End;
1507 End;
1508 Inc(i);
1509 End;
1510 End;
1511 MakePath := FileExist(FP + 'Nul');
1512 End;
1513
1514
1515 End.
1516