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 OS2}
12 {$IFDEF VirtualPascal}
13 os2base, os2def, Strings,
14 {$ENDIF}
15 {$IFDEF SPEED}
16 BseDOS, BseDev,
17 {$ENDIF}
18 {$IfDef FPC}
19 os2def, doscalls,
20 {$EndIf}
21 {$EndIf}
22 {$IfDef UNIX}
23 linux,
24 {$EndIf}
25 GeneralP;
26
27 { $I FILEMODE.INC}
28 {--- begin FILEMODE.INC ---}
29 {$IfDef SPEED}
30 Uses
31 BseDOS;
32
33 Const
34 fmReadOnly = Open_Access_ReadOnly;
35 fmReadWrite = Open_Access_ReadWrite;
36 fmDenyNone = Open_Share_DenyNone;
37
38 {$Else}
39
40 Const
41 fmReadOnly = 0; {FileMode constants}
42 fmWriteOnly = 1;
43 fmReadWrite = 2;
44 fmDenyAll = 16;
45 fmDenyWrite = 32;
46 fmDenyRead = 48;
47 fmDenyNone = 64;
48 fmNoInherit = 128;
49
50 {$EndIf}
51 {--- end FILEMODE.INC ---}
52
53
54 Const
55 Tries: Word = 150;
56 TryDelay: Word = 100;
57
58
59 Type FindRec = Record
60 SR: SearchRec;
61 Dir: DirStr;
62 Name: NameStr;
63 Ext: ExtStr;
64 DError: Word;
65 End;
66
67
68 Type FindObj = Object
69 FI: ^FindRec;
70 Procedure Init; {Initialize}
71 Procedure Done; {Done}
72 Procedure FFirst(FN: String); {Find first}
73 Procedure FNext;
Foundnull74 Function Found: Boolean; {File was found}
GetNamenull75 Function GetName: String; {Get Filename}
GetFullPathnull76 Function GetFullPath: String; {Get filename with path}
GetDatenull77 Function GetDate: LongInt; {Get file date}
GetSizenull78 Function GetSize: LongInt; {Get file size}
79 End;
80
81
82 Type TFileArray = Array[1..$fff0] of Char;
83
84 Type TFileRec = Record
85 MsgBuffer: ^TFileArray;
86 BufferPtr: Word;
87 {$IFDEF VirtualPascal}
88 BufferChars: LongInt;
89 {$ELSE}
90 BufferChars: Word;
91 {$ENDIF}
92 BufferStart: LongInt;
93 BufferFile: File;
94 CurrentStr: String;
95 StringFound: Boolean;
96 Error: Word;
97 BufferSize: Word;
98 End;
99
100
101 Type TFile = Object
102 TF: ^TFileRec;
103 Procedure Init;
104 Procedure Done;
GetStringnull105 Function GetString:String; {Get string from file}
GetUStringnull106 Function GetUString: String; {Get LF delimited string}
OpenTextFilenull107 Function OpenTextFile(FilePath: String): Boolean; {Open file}
CloseTextFilenull108 Function CloseTextFile: Boolean; {Close file}
GetCharnull109 Function GetChar: Char; {Internal use}
110 Procedure BufferRead; {Internal use}
StringFoundnull111 Function StringFound: Boolean; {Was a string found}
SeekTextFilenull112 Function SeekTextFile(SeekPos: LongInt): Boolean; {Seek to position}
GetTextPosnull113 Function GetTextPos: LongInt; {Get text file position}
Restartnull114 Function Restart: Boolean; {Reset to start of file}
115 Procedure SetBufferSize(BSize: Word); {Set buffer size}
116 End;
117
118
119
120 var
121 MKFileError: Word;
122
Existnull123 function Exist (fname : string; attr : word) : boolean;
FileExistnull124 Function FileExist(FName: String): Boolean;
SizeFilenull125 Function SizeFile(FName: String): LongInt;
DateFilenull126 Function DateFile(FName: String): LongInt;
FindPathnull127 Function FindPath(FileName: String): String;
LongLonull128 Function LongLo(InNum: LongInt): Word;
LongHinull129 Function LongHi(InNum: LongInt): Word;
LockFilenull130 Function LockFile(Var F; LockStart: LongInt; LockLength: LongInt): Word;
UnLockFilenull131 Function UnLockFile(Var F; LockStart: LongInt; LockLength: LongInt): Word;
shAssignnull132 Function shAssign(Var F: File; FName: String): Boolean;
shLocknull133 Function shLock(Var F; LockStart,LockLength: LongInt): Word;
134 Procedure FlushFile(Var F); {Dupe file handle, close dupe handle}
shResetnull135 Function shReset(Var F: File; RecSize: Word): Boolean;
136 {$IFNDEF VIRTUALPASCAL}
shReadnull137 Function shRead(Var F: File; Var Rec; ReadSize: Word; Var NumRead: Word): Boolean;
shWritenull138 Function shWrite(Var F: File; Var Rec; ReadSize: Word): Boolean;
139 {$ELSE}
shReadnull140 Function shRead(Var F: File; Var Rec; ReadSize: Word; Var NumRead: LongInt): Boolean;
shWritenull141 Function shWrite(Var F: File; Var Rec; ReadSize: LongInt): Boolean;
142
143 {$ENDIF}
shOpenFilenull144 Function shOpenFile(Var F: File; PathName: String): Boolean;
shMakeFilenull145 Function shMakeFile(Var F: File; PathName: String): Boolean;
146 Procedure shCloseFile(Var F: File);
shSeekFilenull147 Function shSeekFile(Var F: File; FPos: LongInt): Boolean;
shFindFilenull148 Function shFindFile(Pathname: String; Var Name: String; Var Size, Time: LongInt): Boolean;
149 Procedure shSetFTime(Var F: File; Time: LongInt);
GetCurrentPathnull150 Function GetCurrentPath: String;
151 Procedure CleanDir(FileDir: String);
IsDevicenull152 Function IsDevice(FilePath: String): Boolean;
LoadFilePosnull153 Function LoadFilePos(FN: String; Var Rec; FS: Word; FPos: LongInt): Word;
LoadFilenull154 Function LoadFile(FN: String; Var Rec; FS: Word): Word;
SaveFilePosnull155 Function SaveFilePos(FN: String; Var Rec; FS: Word; FPos: LongInt): Word;
SaveFilenull156 Function SaveFile(FN: String; Var Rec; FS: Word): Word;
ExtendFilenull157 Function ExtendFile(FN: String; ToSize: LongInt): Word;
CreateTempDirnull158 Function CreateTempDir(FN: String): String;
GetTempNamenull159 Function GetTempName(FN: String): String;
GetTextPosnull160 Function GetTextPos(Var F: Text): LongInt;
FindOnPathnull161 Function FindOnPath(FN: String; Var OutName: String): Boolean;
CopyFilenull162 Function CopyFile(FN1: String; FN2: String): Boolean;
EraseFilenull163 Function EraseFile(FN: String): Boolean;
MakePathnull164 Function MakePath(FP: String): Boolean;
165
166
167 Implementation
168
169
170 Procedure FindObj.Init;
171 Begin
172 New(FI);
173 FI^.DError := 1;
174 End;
175
176
177 Procedure FindObj.Done;
178 Begin
179 Dispose(FI);
180 End;
181
182
183 Procedure FindObj.FFirst(FN: String);
184 Begin
185 FN := FExpand(FN);
186 FSplit(FN, FI^.Dir, FI^.Name, FI^.Ext);
187 FindFirst(FN, Archive + ReadOnly, FI^.SR);
188 FI^.DError := dos.DosError;
189 End;
190
191
FindObj.GetNamenull192 Function FindObj.GetName: String;
193 Begin
194 If Found Then
195 Begin
196 GetName := FI^.SR.Name
197 End
198 Else
199 GetName := '';
200 End;
201
202
FindObj.GetFullPathnull203 Function FindObj.GetFullPath: String;
204 Begin
205 GetFullPath := FI^.Dir + GetName;
206 End;
207
208
FindObj.GetSizenull209 Function FindObj.GetSize: LongInt;
210 Begin
211 If Found Then
212 GetSize := FI^.SR.Size
213 Else
214 GetSize := 0;
215 End;
216
217
FindObj.GetDatenull218 Function FindObj.GetDate: LongInt;
219 Begin
220 If Found Then
221 GetDate := FI^.SR.Time
222 Else
223 GetDate := 0;
224 End;
225
226
227 Procedure FindObj.FNext;
228 Begin
229 FindNext(FI^.SR);
230 FI^.DError := dos.DosError;
231 End;
232
233
FindObj.Foundnull234 Function FindObj.Found: Boolean;
235 Begin
236 Found := (FI^.DError = 0);
237 End;
238
239
shAssignnull240 Function shAssign(Var F: File; FName: String): Boolean;
241 Begin
242 Assign(F, FName);
243 MKFileError := IoResult;
244 shAssign := (MKFileError = 0);
245 End;
246
247
248 {$IFNDEF VIRTUALPASCAL}
shReadnull249 Function shRead(Var F: File; Var Rec; ReadSize: Word; Var NumRead: Word): Boolean;
250 {$ELSE}
shReadnull251 Function shRead(Var F: File; Var Rec; ReadSize: Word; Var NumRead: LongInt): Boolean;
252 {$ENDIF}
253 Var
254 Count: Word;
255 Code: Word;
256 {$IfDef SPEED}
257 nr: LongWord;
258 {$EndIf}
259
260 Begin
261 if ioresult<>0 then;
262 Count := Tries;
263 Code := 5;
264 While ((Count > 0) and (Code = 5)) Do Begin
265 {$IfDef SPEED}
266 BlockRead(F,Rec,ReadSize,NR);
267 NumRead := NR;
268 {$Else}
269 BlockRead(F,Rec,ReadSize,NumRead);
270 {$EndIf}
271 Code := IoResult;
272 Dec(Count);
273 End;
274 MKFileError := Code;
275 ShRead := (Code = 0);
276 End;
277
278 {$IFNDEF VIRTUALPASCAL}
shWritenull279 Function shWrite(Var F: File; Var Rec; ReadSize: Word): Boolean;
280 {$ELSE}
shWritenull281 Function shWrite(Var F: File; Var Rec; ReadSize: LongInt): Boolean;
282 {$ENDIF}
283 Var
284 Count: Word;
285 Code: Word;
286
287 Begin
288 Count := Tries;
289 Code := 5;
290 While ((Count > 0) and (Code = 5)) Do
291 Begin
292 BlockWrite(F,Rec,ReadSize);
293 Code := IoResult;
294 Dec(Count);
295 End;
296 MKFileError := Code;
297 shWrite := (Code = 0);
298 End;
299
300
301 Procedure CleanDir(FileDir: String);
302 Var
303 SR: SearchRec;
304 F: File;
305
306 Begin
307 FindFirst(FileDir + '*.*', ReadOnly + Archive, SR);
308 While dos.DosError = 0 Do
309 Begin
310 If Not shAssign(F, FileDir + SR.Name) Then;
311 Erase(F);
312 If IoResult <> 0 Then;
313 FindNext(SR);
314 End;
315 End;
316
317
318
GetCurrentPathnull319 Function GetCurrentPath: String;
320 Var
321 CName: NameStr;
322 Path: DirStr;
323 CExt: ExtStr;
324
325 Begin
326 FSplit(FExpand('*.*'),Path,CName,CExt);
327 GetCurrentPath := Path;
328 End;
329
330
shLocknull331 Function shLock(Var F; LockStart,LockLength: LongInt): Word;
332 Var
333 Count: Word;
334 Code: Word;
335 i: Word;
336
337 Begin
338 Count := Tries;
339 Code := $21;
340 While ((Count > 0) and (Code = $21)) Do
341 Begin
342 Code := LockFile(F,LockStart,LockLength);
343 Dec(Count);
344 If Code = $21 Then
345 Delay(TryDelay);
346 End;
347 If Code = 1 Then
348 Code := 0;
349 shLock := Code;
350 End;
351
352
353
shResetnull354 Function shReset(Var F: File; RecSize: Word): Boolean;
355 Var
356 Count: Word;
357 Code: Word;
358
359 Begin
360 Count := Tries;
361 Code := 5;
362 While ((Count > 0) and (Code = 5)) Do
363 Begin
364 {$I-} Reset(F,RecSize);
365 Code := IoResult;
366 Dec(Count);
367 End;
368 MKFileError := Code;
369 ShReset := (Code = 0);
370 End;
371
372 {$IFDEF OS2}
373 {$IFDEF SPEED}
374 procedure FlushFile(Var F);
375 var handle,
376 newhandle : LongInt {HFILE};
377 rc : APIRET;
378 begin
379 handle := FileRec(F).handle;
380 newhandle := HFile(-1);
381 if DosDupHandle(handle, newHandle) = 0 then
382 rc := DosClose(newHandle);
383 end;
384 {$ELSE}
385 procedure FlushFile(Var F);
386 begin
387 Flush(text(F));
388 end;
389 {$ENDIF}
390 {$ELSE}
391 {$IFDEF FPC}
392 procedure FlushFile(Var F);
393 begin
394 Flush(text(F));
395 end;
396 {$ELSE}
397 Procedure FlushFile(Var F); {Dupe file handle, close dupe handle}
398 Var
399 Handle: Word Absolute F;
400 {$IFDEF BASMINT}
401 Tmp: Word;
402 {$ELSE}
403 Regs: Registers;
404 {$ENDIF}
405
406 Begin
407 {$IFDEF BASMINT}
408 Tmp := Handle;
409 Asm
410 Mov ah, $45;
411 Mov bx, Tmp;
412 Int $21;
413 Jc @JFlush;
414 Mov bx, ax;
415 Mov ah, $3e;
416 Int $21;
417 @JFlush:
418 End;
419 {$ELSE}
420 Regs.ah := $45;
421 Regs.bx := Handle;
422 MsDos(Regs);
423 If (Regs.Flags and 1) = 0 Then {carry}
424 Begin
425 Regs.bx := Regs.ax;
426 Regs.Ah := $3e;
427 MsDos(Regs);
428 End;
429 {$ENDIF}
430 End;
431 {$EndIf}
432 {$ENDIF}
433
434 {$IFDEF OS2}
LockFilenull435 function LockFile(Var F; LockStart: LongInt; LockLength: LongInt): Word;
436
437 var
438 lock, unlock : FileLock;
439
440 begin
441 with lock do
442 begin
443 {$IFDEF SPEED}
444 lOffset := LockStart;
445 lRange := LockLength;
446 {$ELSE}
447 Offset := LockStart;
448 Range := LockLength;
449 {$ENDIF}
450 end;
451 with unlock do
452 begin
453 {$IFDEF SPEED}
454 lOffset := 0;
455 lRange := 0;
456 {$ELSE}
457 Offset := 0;
458 Range := 0;
459 {$ENDIF}
460 end;
461 LockFile := DosSetFileLocks(FileRec(F).Handle, unlock, lock, 1000, 0);
462 end;
463 {$ELSE}
464 {$IfDef UNIX}
LockFilenull465 Function LockFile(Var F; LockStart: LongInt; LockLength: LongInt): Word;
466 Begin
467 FLock(file(f), Lock_Ex);
468 LockFile := linuxError;
469 End;
470 {$Else}
471
LockFilenull472 Function LockFile(Var F; LockStart: LongInt; LockLength: LongInt): Word;
473 Var
474 Handle: Word Absolute F;
475 Tmp: Word;
476 StrtHi: Word;
477 StrtLo: Word;
478 LgHi: Word;
479 LgLo: Word;
480 {$IFNDEF BASMINT}
481 Regs: Registers;
482 {$ENDIF}
483
484 Begin
485 Tmp := Handle;
486 StrtHi := LongHi(LockStart);
487 StrtLo := LongLo(LockStart);
488 LgHi := LongHi(LockLength);
489 LgLo := LongLo(LockLength);
490 {$IFDEF BASMINT}
491 Asm
492 Mov ah, $5c;
493 Mov al, $00;
494 Mov bx, Tmp;
495 Mov cx, StrtHi;
496 Mov dx, StrtLo;
497 Mov si, LgHi; {00h = success }
498 Mov di, LgLo; {01h = share not loaded }
499 Int $21; {06h = invalid handle }
500 Jc @JLock {21h = lock violation }
501 Mov ax, $00; {24h = share buffer full }
502 @JLock:
503 Mov Tmp, ax;
504 End;
505 {$ELSE}
506 Regs.ah := $5c;
507 Regs.al := $00;
508 Regs.bx := Tmp;
509 Regs.cx := StrtHi;
510 Regs.dx := StrtLo;
511 Regs.si := LgHi;
512 Regs.di := LgLo;
513 MsDos(Regs);
514 If (Regs.Flags and 1) = 0 Then
515 Begin
516 Regs.ax := 0;
517 End;
518 Tmp := Regs.ax;
519 {$ENDIF}
520 If Tmp = 1 Then
521 Tmp := 0;
522 LockFile := Tmp;
523 End;
524 {$EndIf}
525 {$ENDIF}
526
527 {$IFDEF OS2}
UnLockFilenull528 function UnLockFile(Var F; LockStart: LongInt; LockLength: LongInt): Word;
529
530 var
531 lock, unlock : FileLock;
532
533 begin
534 with unlock do
535 begin
536 {$IFDEF SPEED}
537 lOffset := LockStart;
538 lRange := LockLength;
539 {$ELSE}
540 Offset := LockStart;
541 Range := LockLength;
542 {$ENDIF}
543 end;
544 with lock do
545 begin
546 {$IFDEF SPEED}
547 lOffset := 0;
548 lRange := 0;
549 {$ELSE}
550 Offset := 0;
551 Range := 0;
552 {$ENDIF}
553 end;
554 UnLockFile := DosSetFileLocks(FileRec(F).Handle, unlock, lock, 1000, 0);
555 end;
556
557 {$ELSE}
558 {$IfDef UNIX}
UnLockFilenull559 Function UnLockFile(Var F; LockStart: LongInt; LockLength: LongInt): Word;
560 Begin
561 FLock(file(f), Lock_Un);
562 UnLockFile := linuxError;
563 End;
564 {$Else}
565
UnLockFilenull566 Function UnLockFile(Var F; LockStart: LongInt; LockLength: LongInt): Word;
567 Var
568 Handle: Word Absolute F;
569 Tmp: Word;
570 StrtHi: Word;
571 StrtLo: Word;
572 LgHi: Word;
573 LgLo: Word;
574 {$IFNDEF BASMINT}
575 Regs: Registers;
576 {$ENDIF}
577
578 Begin
579 Tmp := Handle;
580 StrtHi := LongHi(LockStart);
581 StrtLo := LongLo(LockStart);
582 LgHi := LongHi(LockLength);
583 LgLo := LongLo(LockLength);
584 {$IFDEF BASMINT}
585 Asm
586 Mov ah, $5c;
587 Mov al, $01;
588 Mov bx, Tmp;
589 Mov cx, StrtHi;
590 Mov dx, StrtLo;
591 Mov si, LgHi; {00h = success }
592 Mov di, LgLo; {01h = share not loaded }
593 Int $21; {06h = invalid handle }
594 Jc @JLock {21h = lock violation }
595 Mov ax, $00; {24h = share buffer full }
596 @JLock:
597 Mov Tmp, ax;
598 End;
599 {$ELSE}
600 Regs.ah := $5c;
601 Regs.al := $01;
602 Regs.bx := Tmp;
603 Regs.cx := StrtHi;
604 Regs.dx := StrtLo;
605 Regs.si := LgHi;
606 Regs.di := LgLo;
607 MsDos(Regs);
608 If (Regs.Flags and 1) = 0 Then
609 Begin
610 Regs.ax := 0;
611 End;
612 Tmp := Regs.ax;
613 {$ENDIF}
614 If Tmp = 1 Then
615 Tmp := 0;
616 UnLockFile := Tmp;
617 End;
618 {$EndIf}
619 {$ENDIF}
620
621
LongLonull622 Function LongLo(InNum: LongInt): Word;
623 Begin
624 LongLo := InNum and $FFFF;
625 End;
626
627
LongHinull628 Function LongHi(InNum: LongInt): Word;
629 Begin
630 LongHi := InNum Shr 16;
631 End;
632
633
SizeFilenull634 Function SizeFile(FName: String): LongInt;
635 Var
636 SR: SearchRec;
637
638 Begin
639 FindFirst(FName, AnyFile, SR);
640 If dos.DosError = 0 Then
641 SizeFile := SR.Size
642 Else
643 SizeFile := -1;
644 End;
645
646
DateFilenull647 Function DateFile(FName: String): LongInt;
648 Var
649 SR: SearchRec;
650
651 Begin
652 FindFirst(FName, AnyFile, SR);
653 If dos.DosError = 0 Then
654 DateFile := SR.Time
655 Else
656 DateFile := 0;
657 End;
658
659
existnull660 function exist (fname : string; attr : word) : boolean;
661 var
662 sr : SearchRec;
663 begin
664 FindFirst (fname, attr, sr);
665 exist := (dos.DosError = 0);
666 {$IFDEF OS2}
667 FindClose(sr);
668 {$ENDIF}
669 end;
670
FileExistnull671 function FileExist(FName: String): Boolean;
672 var
673 SR: SearchRec;
674 begin
675 FindFirst(FName, ReadOnly + Hidden + Archive + directory, SR);
676 FileExist:=(dos.DosError = 0);
677 {$IFDEF OS2}
678 FindClose(SR);
679 {$ENDIF}
680 end;
681
682
FindPathnull683 Function FindPath(FileName: String):String;
684 Begin
685 FindPath := FileName;
686 If FileExist(FileName) Then
687 FindPath := FExpand(FileName)
688 Else
689 FindPath := FExpand(FSearch(FileName,DOS.GetEnv('PATH')));
690 End;
691
692
693 Procedure TFile.BufferRead;
694 Begin
695 TF^.BufferStart := FilePos(TF^.BufferFile);
696 if Not shRead (TF^.BufferFile,TF^.MsgBuffer^ , TF^.BufferSize, TF^.BufferChars) Then
697 TF^.BufferChars := 0;
698 TF^.BufferPtr := 1;
699 End;
700
701
TFile.GetCharnull702 Function TFile.GetChar: Char;
703 Begin
704 If TF^.BufferPtr > TF^.BufferChars Then
705 BufferRead;
706 If TF^.BufferChars > 0 Then
707 GetChar := TF^.MsgBuffer^[TF^.BufferPtr]
708 Else
709 GetChar := #0;
710 Inc(TF^.BufferPtr);
711 If TF^.BufferPtr > TF^.BufferChars Then
712 BufferRead;
713 End;
714
715
TFile.GetStringnull716 Function TFile.GetString: String;
717
718 Var
719 TempStr: String;
720 GDone: Boolean;
721 Ch: Char;
722
723 Begin
724 TempStr := '';
725 GDone := False;
726 TF^.StringFound := False;
727 While Not GDone Do
728 Begin
729 Ch := GetChar;
730 Case Ch Of
731 #0: If TF^.BufferChars = 0 Then
732 GDone := True
733 Else
734 Begin
735 Inc(byte(TempStr[0]));
736 TempStr[Ord(TempStr[0])] := Ch;
737 TF^.StringFound := True;
738 If Length(TempStr) = 255 Then
739 GDone := True;
740 End;
741 #10:;
742 #26:;
743 #13: Begin
744 GDone := True;
745 TF^.StringFound := True;
746 End;
747 Else
748 Begin
749 Inc(byte(TempStr[0]));
750 TempStr[Ord(TempStr[0])] := Ch;
751 TF^.StringFound := True;
752 If Length(TempStr) = 255 Then
753 GDone := True;
754 End;
755 End;
756 End;
757 GetString := TempStr;
758 End;
759
760
TFile.GetUStringnull761 Function TFile.GetUString: String;
762
763 Var
764 TempStr: String;
765 GDone: Boolean;
766 Ch: Char;
767
768 Begin
769 TempStr := '';
770 GDone := False;
771 TF^.StringFound := False;
772 While Not GDone Do
773 Begin
774 Ch := GetChar;
775 Case Ch Of
776 #0: If TF^.BufferChars = 0 Then
777 GDone := True
778 Else
779 Begin
780 Inc(byte(TempStr[0]));
781 TempStr[Ord(TempStr[0])] := Ch;
782 TF^.StringFound := True;
783 If Length(TempStr) = 255 Then
784 GDone := True;
785 End;
786 #13:;
787 #26:;
788 #10: Begin
789 GDone := True;
790 TF^.StringFound := True;
791 End;
792 Else
793 Begin
794 Inc(byte(TempStr[0]));
795 TempStr[Ord(TempStr[0])] := Ch;
796 TF^.StringFound := True;
797 If Length(TempStr) = 255 Then
798 GDone := True;
799 End;
800 End;
801 End;
802 GetUString := TempStr;
803 End;
804
805
TFile.OpenTextFilenull806 Function TFile.OpenTextFile(FilePath: String): Boolean;
807 Begin
808 If Not shAssign(TF^.BufferFile, FilePath) Then;
809 FileMode := fmReadOnly + fmDenyNone;
810 If Not shReset(TF^.BufferFile,1) Then
811 OpenTextFile := False
812 Else
813 Begin
814 BufferRead;
815 If TF^.BufferChars > 0 Then
816 TF^.StringFound := True
817 Else
818 TF^.StringFound := False;
819 OpenTextFile := True;
820 End;
821 End;
822
823
TFile.SeekTextFilenull824 Function TFile.SeekTextFile(SeekPos: LongInt): Boolean;
825 Begin
826 TF^.Error := 0;
827 If ((SeekPos < TF^.BufferStart) Or (SeekPos > TF^.BufferStart + TF^.BufferChars)) Then
828 Begin
829 Seek(TF^.BufferFile, SeekPos);
830 TF^.Error := IoResult;
831 BufferRead;
832 End
833 Else
834 Begin
835 TF^.BufferPtr := SeekPos + 1 - TF^.BufferStart;
836 End;
837 SeekTextFile := (TF^.Error = 0);
838 End;
839
840
TFile.GetTextPosnull841 Function TFile.GetTextPos: LongInt; {Get text file position}
842 Begin
843 GetTextPos := TF^.BufferStart + TF^.BufferPtr - 1;
844 End;
845
846
TFile.Restartnull847 Function TFile.Restart: Boolean;
848 Begin
849 Restart := SeekTextFile(0);
850 End;
851
852
TFile.CloseTextFilenull853 Function TFile.CloseTextFile: Boolean;
854 Begin
855 Close(TF^.BufferFile);
856 CloseTextFile := (IoResult = 0);
857 End;
858
859
860 Procedure TFile.SetBufferSize(BSize: Word);
861 Begin
862 FreeMem(TF^.MsgBuffer, TF^.BufferSize);
863 TF^.BufferSize := BSize;
864 GetMem(TF^.MsgBuffer, TF^.BufferSize);
865 TF^.BufferChars := 0;
866 TF^.BufferStart := 0;
867 If SeekTextFile(GetTextPos) Then;
868 End;
869
870
871 Procedure TFile.Init;
872 Begin
873 New(TF);
874 TF^.BufferSize := 2048;
875 GetMem(TF^.MsgBuffer, TF^.BufferSize);
876 End;
877
878
879 Procedure TFile.Done;
880 Begin
881 Close(TF^.BufferFile);
882 If IoResult <> 0 Then;
883 FreeMem(TF^.MsgBuffer, TF^.BufferSize);
884 Dispose(TF);
885 End;
886
887
TFile.StringFoundnull888 Function TFile.StringFound: Boolean;
889 Begin
890 StringFound := TF^.StringFound;
891 End;
892
893
shOpenFilenull894 Function shOpenFile(Var F: File; PathName: String): Boolean;
895 Begin
896 Assign(f,pathname);
897 FileMode := fmReadWrite + fmDenyNone;
898 shOpenFile := shReset(f,1);
899 End;
900
901
shMakeFilenull902 Function shMakeFile(Var F: File; PathName: String): Boolean;
903 Begin
904 Assign(f,pathname);
905 {$I-} ReWrite(f,1);
906 shMakeFile := (IOresult = 0);
907 END;
908
909
910 Procedure shCloseFile(Var F: File);
911 Begin
912 Close(F);
913 If (IOresult <> 0) Then;
914 End;
915
916
shSeekFilenull917 Function shSeekFile(Var F: File; FPos: LongInt): Boolean;
918 Begin
919 Seek(F,FPos);
920 shSeekFile := (IOresult = 0);
921 End;
922
923
shFindFilenull924 Function shFindFile(Pathname: String; Var Name: String; Var Size, Time: LongInt): Boolean;
925 Var
926 SR: SearchRec;
927
928 Begin
929 FindFirst(PathName, Archive, SR);
930 If (dos.DosError = 0) Then
931 Begin
932 shFindFile := True;
933 Name := Sr.Name;
934 Size := Sr.Size;
935 Time := Sr.Time;
936 End
937 Else
938 Begin
939 shFindFile := False;
940 End;
941 End;
942
943
944 Procedure shSetFTime(Var F: File; Time: LongInt);
945 Begin
946 SetFTime(F, Time);
947 If (IOresult <> 0) Then;
948 End;
949
950 {$IFDEF OS2}
IsDevicenull951 function IsDevice(FilePath: String): Boolean;
952 begin
953 runerror(211);
954 end;
955 {$ELSE}
956 {$IFDEF FPC}
IsDevicenull957 function IsDevice(FilePath: String): Boolean;
958 Var
959 info: Stat;
960
961 begin
962 FStat(FilePath, info);
963 IsDevice := not S_ISREG(info.mode);
964 end;
965
966 {$ELSE}
IsDevicenull967 Function IsDevice(FilePath: String): Boolean;
968 Var
969 F: File;
970 Handle: Word Absolute F;
971 Tmp: Word;
972 {$IFNDEF BASMINT}
973 Regs: Registers;
974 {$ENDIF}
975
976 Begin
977 Assign(F, FilePath);
978 {$I-} Reset(F);
979 If IoResult <> 0 Then
980 IsDevice := False
981 Else
982 Begin
983 Tmp := Handle;
984 {$IFDEF BASMINT}
985 Asm
986 Mov ah, $44;
987 Mov al, $00;
988 Mov bx, Tmp;
989 Int $21;
990 Or dx, $80;
991 Je @JDev;
992 Mov ax, $01;
993 @JDev:
994 Mov ax, $00;
995 Mov @Result, al;
996 End;
997 {$ELSE}
998 Regs.ah := $44;
999 Regs.al := $00;
1000 Regs.bx := Tmp;
1001 MsDos(Regs);
1002 IsDevice := (Regs.Dx and $80) <> 0;
1003 {$ENDIF}
1004 End;
1005 Close(F);
1006 If IoResult <> 0 Then;
1007 End;
1008 {$EndIf}
1009 {$ENDIF}
1010
1011
LoadFilenull1012 Function LoadFile(FN: String; Var Rec; FS: Word): Word;
1013 Begin
1014 LoadFile := LoadFilePos(FN, Rec, FS, 0);
1015 End;
1016
1017
LoadFilePosnull1018 Function LoadFilePos(FN: String; Var Rec; FS: Word; FPos: LongInt): Word;
1019 Var
1020 F: File;
1021 Error: Word;
1022 {$IFDEF VirtualPascal}
1023 NumRead: LongInt;
1024 {$ELSE}
1025 NumRead: Word;
1026 {$ENDIF}
1027 Begin
1028 Error := 0;
1029 If Not FileExist(FN) Then
1030 Error := 8888;
1031 If Error = 0 Then
1032 Begin
1033 If Not shAssign(F, FN) Then
1034 Error := MKFileError;
1035 End;
1036 FileMode := fmReadOnly + fmDenyNone;
1037 If Not shReset(F,1) Then
1038 Error := MKFileError;
1039 If Error = 0 Then
1040 Begin
1041 Seek(F, FPos);
1042 Error := IoResult;
1043 End;
1044 If Error = 0 Then
1045 If Not shRead(F, Rec, FS, NumRead) Then
1046 Error := MKFileError;
1047 If Error = 0 Then
1048 Begin
1049 Close(F);
1050 Error := IoResult;
1051 End;
1052 LoadFilePos := Error;
1053 End;
1054
1055
SaveFilenull1056 Function SaveFile(FN: String; Var Rec; FS: Word): Word;
1057 Begin
1058 SaveFile := SaveFilePos(FN, Rec, FS, 0);
1059 End;
1060
1061
1062
SaveFilePosnull1063 Function SaveFilePos(FN: String; Var Rec; FS: Word; FPos: LongInt): Word;
1064 Var
1065 F: File;
1066 Error: Word;
1067
1068 Begin
1069 Error := 0;
1070 If Not shAssign(F, FN) Then
1071 Error := MKFileError;
1072 FileMode := fmReadWrite + fmDenyNone;
1073 If FileExist(FN) Then
1074 Begin
1075 If Not shReset(F,1) Then
1076 Error := MKFileError;
1077 End
1078 Else
1079 Begin
1080 {$I-} ReWrite(F,1);
1081 Error := IoResult;
1082 End;
1083 If Error = 0 Then
1084 Begin
1085 Seek(F, FPos);
1086 Error := IoResult;
1087 End;
1088 If Error = 0 Then
1089 If FS > 0 Then
1090 Begin
1091 If Not shWrite(F, Rec, FS) Then
1092 Error := MKFileError;
1093 End;
1094 If Error = 0 Then
1095 Begin
1096 Close(F);
1097 Error := IoResult;
1098 End;
1099 SaveFilePos := Error;
1100 End;
1101
1102
ExtendFilenull1103 Function ExtendFile(FN: String; ToSize: LongInt): Word;
1104 {Pads file with nulls to specified size}
1105 Type
1106 FillType = Array[1..8000] of Byte;
1107
1108 Var
1109 F: File;
1110 Error: Word;
1111 FillRec: ^FillType;
1112
1113 Begin
1114 Error := 0;
1115 New(FillRec);
1116 If FillRec = Nil Then
1117 Error := 10;
1118 If Error = 0 Then
1119 Begin
1120 FillChar(FillRec^, SizeOf(FillRec^), 0);
1121 If Not shAssign(F, FN) Then
1122 Error := MKFileError;
1123 FileMode := fmReadWrite + fmDenyNone;
1124 If FileExist(FN) Then
1125 Begin
1126 If Not shReset(F,1) Then
1127 Error := MKFileError;
1128 End
1129 Else
1130 Begin
1131 {$I-} ReWrite(F,1);
1132 Error := IoResult;
1133 End;
1134 End;
1135 If Error = 0 Then
1136 Begin
1137 Seek(F, FileSize(F));
1138 Error := IoResult;
1139 End;
1140 If Error = 0 Then
1141 Begin
1142 While ((FileSize(F) < (ToSize - SizeOf(FillRec^))) and (Error = 0)) Do
1143 Begin
1144 If Not shWrite(F, FillRec^, SizeOf(FillRec^)) Then
1145 Error := MKFileError;
1146 End;
1147 End;
1148 If ((Error = 0) and (FileSize(F) < ToSize)) Then
1149 Begin
1150 If Not shWrite(F, FillRec^, ToSize - FileSize(F)) Then
1151 Error := MKFileError;
1152 End;
1153 If Error = 0 Then
1154 Begin
1155 Close(F);
1156 Error := IoResult;
1157 End;
1158 Dispose(FillRec);
1159 ExtendFile := Error;
1160 End;
1161
1162 {$IFDEF OS2}
CreateTempDirnull1163 function CreateTempDir(FN: String): String;
1164
1165 begin
1166 runerror(211);
1167 end;
1168 {$ELSE}
1169 {$IfDef FPC}
CreateTempDirnull1170 function CreateTempDir(FN: String): String;
1171
1172 begin
1173 end;
1174 {$Else}
CreateTempDirnull1175 Function CreateTempDir(FN: String): String;
1176 Var
1177 TOfs: Word;
1178 TSeg: Word;
1179 FH: Word;
1180 i: Word;
1181 TmpStr: String;
1182
1183 Begin
1184 TSeg := Seg(TmpStr[1]);
1185 TOfs := Ofs(TmpStr[1]);
1186 If ((Length(FN) > 0) and (FN[Length(FN)] <> DirSep)) Then
1187 TmpStr := FN + DirSep
1188 Else
1189 TmpStr := FN;
1190 For i := 1 to 16 Do
1191 TmpStr[Length(TmpStr) + i] := #0;
1192 i := 0;
1193 Asm
1194 Mov bx, TSeg;
1195 Mov ax, TOfs;
1196 Push ds;
1197 Mov ds, bx;
1198 Mov dx, ax;
1199 Mov ah, $5a;
1200 Mov ch, $00;
1201 ; {Mov dx, TSeg;}
1202 ; {Mov ds, dx;}
1203 ; {Mov dx, TOfs;}
1204 Mov cl, $00;
1205 Int $21; {Create tmp file}
1206 Mov FH, ax;
1207 Mov ax, 1;
1208 jc @JErr
1209 Mov bx, FH;
1210 Mov ah, $3e;
1211 jmp @J3;
1212 Int $21; {Close tmp file}
1213 @J3:
1214 Mov ax, 2;
1215 jc @JErr;
1216 Mov ah, $41
1217 Mov dx, TSeg;
1218 Mov ds, dx;
1219 Mov dx, TOfs;
1220 Int $21; {Erase tmp file}
1221 Mov ax, 3;
1222 jc @JErr;
1223 Mov ah, $39;
1224 Mov dx, TSeg;
1225 Mov ds, dx;
1226 Mov dx, TOfs;
1227 Int $21; {Create directory}
1228 Mov ax, 4;
1229 jc @JErr;
1230 Jmp @JEnd;
1231 @JErr:
1232 Mov i, ax;
1233 @JEnd:
1234 Pop ds;
1235 End;
1236 TmpStr[0] := #255;
1237 TmpStr[0] := Chr(Pos(#0, TmpStr) - 1);
1238 If i = 0 Then
1239 CreateTempDir := TmpStr
1240 Else
1241 CreateTempDir := '';
1242 End;
1243 {$EndIf}
1244 {$ENDIF}
1245
1246 {$IFDEF OS2}
1247 {$IFDEF SPEED}
GetTempNamenull1248 function GetTempName(FN: String): String;
1249
1250 var
1251 TmpStr,
1252 tmp : string;
1253 nr : LongInt;
1254
1255 begin
1256 If ((Length(FN) > 0) and (FN[Length(FN)] <> DirSep)) Then
1257 TmpStr := FN + DirSep
1258 Else
1259 TmpStr := FN;
1260 nr := 0;
1261 repeat
1262 inc(nr);
1263 str(nr, tmp);
1264 until (nr = 1000) or not (fileexist(tmpstr+tmp));
1265 if nr <> 1000 then GetTempName := tmpstr+tmp else gettempname := '';
1266 end;
1267 {$ELSE}
GetTempNamenull1268 function GetTempName(FN: String): String;
1269
1270 var
1271 TmpStr,
1272 tmp : string;
1273 nr : LongInt;
1274
1275 begin
1276 If ((Length(FN) > 0) and (FN[Length(FN)] <> DirSep)) Then
1277 TmpStr := FN + DirSep
1278 Else
1279 TmpStr := FN;
1280 nr := 0;
1281 repeat
1282 inc(nr);
1283 str(nr, tmp);
1284 until (nr = 1000) or not (fileexist(tmpstr+tmp));
1285 if nr <> 1000 then GetTempName := tmpstr+tmp else gettempname := '';
1286 end;
1287 {$ENDIF}
1288
1289 {$ELSE}
1290 {$IfDef FPC}
GetTempNamenull1291 function GetTempName(FN: String): String;
1292
1293 var
1294 TmpStr,
1295 tmp : string;
1296 nr : LongInt;
1297
1298 begin
1299 If ((Length(FN) > 0) and (FN[Length(FN)] <> DirSep)) Then
1300 TmpStr := FN + DirSep
1301 Else
1302 TmpStr := FN;
1303 nr := 0;
1304 repeat
1305 inc(nr);
1306 str(nr, tmp);
1307 until (nr = 1000) or not (fileexist(tmpstr+tmp));
1308 if nr <> 1000 then GetTempName := tmpstr+tmp else gettempname := '';
1309 end;
1310 {$Else}
1311
GetTempNamenull1312 Function GetTempName(FN: String): String;
1313 Var
1314 TOfs: Word;
1315 TSeg: Word;
1316 FH: Word;
1317 i: Word;
1318 TmpStr: String;
1319
1320 Begin
1321 TSeg := Seg(TmpStr[1]);
1322 TOfs := Ofs(TmpStr[1]);
1323 If ((Length(FN) > 0) and (FN[Length(FN)] <> DirSep)) Then
1324 TmpStr := FN + DirSep
1325 Else
1326 TmpStr := FN;
1327 For i := 1 to 16 Do
1328 TmpStr[Length(TmpStr) + i] := #0;
1329 i := 0;
1330 Asm
1331 Push ds;
1332 Mov ah, $5a;
1333 Mov ch, $00;
1334 Mov dx, TSeg;
1335 Mov ds, dx;
1336 Mov dx, TOfs;
1337 Mov cl, $00;
1338 Int $21; {Create tmp file}
1339 Mov FH, ax;
1340 Mov ax, 1;
1341 jc @JErr
1342 Mov bx, FH;
1343 Mov ah, $3e;
1344 {jmp @J3; this was originally in my code, appears to be an error}
1345 Int $21; {Close tmp file}
1346 @J3:
1347 Mov ax, 2;
1348 jc @JErr;
1349 Mov ah, $41
1350 Mov dx, TSeg;
1351 Mov ds, dx;
1352 Mov dx, TOfs;
1353 Int $21; {Erase tmp file}
1354 Mov ax, 3;
1355 jc @JErr;
1356 jmp @JEnd
1357 @JErr:
1358 Mov i, ax;
1359 @JEnd:
1360 Pop ds;
1361 End;
1362 TmpStr[0] := #255;
1363 TmpStr[0] := Chr(Pos(#0, TmpStr) - 1);
1364 If i = 0 Then
1365 GetTempName := TmpStr
1366 Else
1367 GetTempName := '';
1368 End;
1369 {$EndIf}
1370 {$ENDIF}
1371
1372 {$IFDEF OS2}
gettextposnull1373 function gettextpos(var f:text): LongInt;
1374 begin
1375 runerror(211);
1376 end;
1377 {$ELSE}
1378 {$IfDef FPC}
gettextposnull1379 function gettextpos(var f:text): LongInt;
1380 begin
1381 end;
1382 {$Else}
GetTextPosnull1383 Function GetTextPos(Var F: Text): LongInt;
1384 Type WordRec = Record
1385 LongLo: Word;
1386 LongHi: Word;
1387 End;
1388
1389 Var
1390 TR: TextRec Absolute F;
1391 Tmp: LongInt;
1392 Handle: Word;
1393 {$IFNDEF BASMINT}
1394 Regs: Registers;
1395 {$ENDIF}
1396
1397 Begin
1398 Handle := TR.Handle;
1399 {$IFDEF BASMINT}
1400 Asm
1401 Mov ah, $42;
1402 Mov al, $01;
1403 Mov bx, Handle;
1404 Mov cx, 0;
1405 Mov dx, 0;
1406 Int $21;
1407 Jnc @TP2;
1408 Mov ax, $ffff;
1409 Mov dx, $ffff;
1410 @TP2:
1411 Mov WordRec(Tmp).LongLo, ax;
1412 Mov WordRec(Tmp).LongHi, dx;
1413 End;
1414 {$ELSE}
1415 Regs.ah := $42;
1416 Regs.al := $01;
1417 Regs.bx := Handle;
1418 Regs.cx := 0;
1419 Regs.dx := 0;
1420 MsDos(Regs);
1421 If (Regs.Flags and 1) <> 0 Then
1422 Begin
1423 Regs.ax := $ffff;
1424 Regs.dx := $ffff;
1425 End;
1426 WordRec(Tmp).LongLo := Regs.Ax;
1427 WordRec(Tmp).LongHi := Regs.Dx;
1428 {$ENDIF}
1429 If Tmp >= 0 Then
1430 Inc(Tmp, TR.BufPos);
1431 GetTextPos := Tmp;
1432 End;
1433 {$EndIf}
1434 {$ENDIF}
1435
1436
FindOnPathnull1437 Function FindOnPath(FN: String; Var OutName: String): Boolean;
1438 Var
1439 TmpStr: String;
1440
1441 Begin
1442 If FileExist(FN) Then
1443 Begin
1444 OutName := FExpand(FN);
1445 FindOnPath := True;
1446 End
1447 Else
1448 Begin
1449 TmpStr := FSearch(FN, DOS.GetEnv('Path'));
1450 If FileExist(TmpStr) Then
1451 Begin
1452 OutName := TmpStr;
1453 FindOnPath := True;
1454 End
1455 Else
1456 Begin
1457 OutName := FN;
1458 FindOnPath := False;
1459 End;
1460 End;
1461 End;
1462
1463
CopyFilenull1464 Function CopyFile(FN1: String; FN2: String): Boolean;
1465 Type
1466 TmpBufType = Array[1..8192] of Byte;
1467
1468 Var
1469 F1: File;
1470 F2: File;
1471 {$IFDEF VirtualPascal}
1472 NumRead: LongInt;
1473 {$ELSE}
1474 {$IfDef SPEED}
1475 NumRead: LongWord;
1476 {$Else}
1477 NumRead: Word;
1478 {$EndIf}
1479 {$ENDIF}
1480 Buf: ^TmpBufType;
1481 Error: Word;
1482
1483 Begin
1484 New(Buf);
1485 Error := 0;
1486 Assign(F1, FN1);
1487 FileMode := fmReadOnly + fmDenyNone;
1488 {$I-} Reset(F1, 1);
1489 Error := IoResult;
1490 If Error = 0 Then
1491 Begin
1492 Assign(F2, FN2);
1493 FileMode := fmReadWrite + fmDenyNone;
1494 {$I-} ReWrite(F2, 1);
1495 Error := IoResult;
1496 End;
1497 If Error = 0 Then
1498 Begin
1499 BlockRead(F1, Buf^, SizeOf(Buf^), NumRead);
1500 Error := IoResult;
1501 While ((NumRead <> 0) and (Error = 0)) Do
1502 Begin
1503 BlockWrite(F2, Buf^, NumRead);
1504 Error := IoResult;
1505 If Error = 0 Then
1506 Begin
1507 BlockRead(F1, Buf^, SizeOf(Buf^), NumRead);
1508 Error := IoResult;
1509 End;
1510 End;
1511 End;
1512 If Error = 0 Then
1513 Begin
1514 Close(F1);
1515 Error := IoResult;
1516 End;
1517 If Error = 0 Then
1518 Begin
1519 Close(F2);
1520 Error := IoResult;
1521 End;
1522 Dispose(Buf);
1523 CopyFile := (Error = 0);
1524 End;
1525
1526
EraseFilenull1527 Function EraseFile(FN: String): Boolean;
1528 Var
1529 F: File;
1530
1531 Begin
1532 Assign(F, FN);
1533 Erase(F);
1534 EraseFile := (IoResult = 0);
1535 End;
1536
1537
MakePathnull1538 Function MakePath(FP: String): Boolean;
1539 Var
1540 i: Word;
1541
1542 Begin
1543 If FP[Length(FP)] <> DirSep Then
1544 FP := FP + DirSep;
1545 If Not FileExist(FP + 'Nul') Then
1546 Begin
1547 i := 2;
1548 While (i <= Length(FP)) Do
1549 Begin
1550 If FP[i] = DirSep Then
1551 Begin
1552 If FP[i-1] <> ':' Then
1553 Begin
1554 MkDir(Copy(FP, 1, i - 1));
1555 If IoResult <> 0 Then;
1556 End;
1557 End;
1558 Inc(i);
1559 End;
1560 End;
1561 MakePath := FileExist(FP + 'Nul');
1562 End;
1563
1564
1565 End.
1566