home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / MKMSGSRC.ZIP / MKFILE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-09-19  |  19.7 KB  |  963 lines
  1. Unit MkFile;
  2. {$I MKB.Def}
  3.  
  4. Interface
  5.  
  6. {$IFDEF WINDOWS}
  7. Uses WinDos;
  8. {$ELSE}
  9. Uses Dos;
  10. {$ENDIF}
  11.  
  12. Const
  13.   fmReadOnly = 0;          {FileMode constants}
  14.   fmWriteOnly = 1;
  15.   fmReadWrite = 2;
  16.   fmDenyAll = 16;
  17.   fmDenyWrite = 32;
  18.   fmDenyRead = 48;
  19.   fmDenyNone = 64;
  20.   fmNoInherit = 128;
  21.  
  22.  
  23. Const
  24.   Tries: Word = 150;
  25.   TryDelay: Word = 100;
  26.  
  27.  
  28. {$IFDEF WINDOWS}
  29. Type
  30.   PathStr = String[128];
  31.   DirStr = String[128];
  32.   NameStr = String[13];
  33.   ExtStr = String[4];
  34. {$ENDIF}
  35.  
  36.  
  37. Type FindRec = Record
  38.   {$IFDEF WINDOWS}
  39.   SR: TSearchRec;
  40.   TStr: Array[0..180] of Char;
  41.   {$ELSE}
  42.   SR: SearchRec;
  43.   {$ENDIF}
  44.   Dir: DirStr;
  45.   Name: NameStr;
  46.   Ext: ExtStr;
  47.   DError: Word;
  48.   End;
  49.  
  50.  
  51. Type FindObj = Object
  52.   FI: ^FindRec;
  53.   Procedure Init; {Initialize}
  54.   Procedure Done; {Done}
  55.   Procedure FFirst(FN: String); {Find first}
  56.   Procedure FNext;
  57.   Function  Found: Boolean; {File was found}
  58.   Function  GetName: String; {Get Filename}
  59.   Function  GetFullPath: String; {Get filename with path}
  60.   Function  GetDate: LongInt; {Get file date}
  61.   Function  GetSize: LongInt; {Get file size}
  62.   End;
  63.  
  64.  
  65. Type TFileRec = Record
  66.   MsgBuffer: Array[1..1024] of Char;
  67.   BufferPtr: Word;
  68.   BufferChars: Word;
  69.   BufferStart: LongInt;
  70.   BufferFile: File;
  71.   StringPtr: LongInt;
  72.   CurrentStr: String;
  73.   StringFound: Boolean;
  74.   Error: Word;
  75.   End;
  76.  
  77.  
  78. Type TFile = Object
  79.   TF: ^TFileRec;
  80.   Procedure Init;
  81.   Procedure Done;
  82.   Function  GetString:String;          {Get string from file}
  83.   Function  OpenTextFile(FilePath: String): Boolean;  {Open file}
  84.   Function  CloseTextFile: Boolean;    {Close file}
  85.   Function  GetChar: Char;             {Internal use}
  86.   Procedure BufferRead;                {Internal use}
  87.   Function  StringFound: Boolean;      {Was a string found}
  88.   Function  SeekTextFile(SeekPos: LongInt): Boolean; {Seek to position}
  89.   Function  GetTextPos: LongInt;       {Get text file position}
  90.   Function  Restart: Boolean;          {Reset to start of file}
  91.   End;
  92.  
  93.  
  94.  
  95. Var
  96.   FileError: Word;
  97.  
  98.  
  99. Function  FileExist(FName: String): Boolean;
  100. Function  SizeFile(FName: String): LongInt;
  101. Function  FindPath(FileName: String): String;
  102. Function  LongLo(InNum: LongInt): Word;
  103. Function  LongHi(InNum: LongInt): Word;
  104. Function  LockFile(Var F; LockStart: LongInt; LockLength: LongInt): Word;
  105. Function  UnLockFile(Var F; LockStart: LongInt; LockLength: LongInt): Word;
  106. Function  shAssign(Var F: File; FName: String): Boolean;
  107. Function  shLock(Var F; LockStart,LockLength: LongInt): Word;
  108. Procedure FlushFile(Var F); {Dupe file handle, close dupe handle}
  109. Function  shReset(Var F: File; RecSize: Word): Boolean;
  110. Function  shRead(Var F: File; Var Rec; ReadSize: Word; Var NumRead: Word): Boolean;
  111. Function  shWrite(Var F: File; Var Rec; ReadSize: Word): Boolean;
  112. Function  shOpenFile(Var F: File; PathName: String): Boolean;
  113. Function  shMakeFile(Var F: File; PathName: String): Boolean;
  114. Procedure shCloseFile(Var F: File);
  115. Function  shSeekFile(Var F: File; FPos: LongInt): Boolean;
  116. Function  shFindFile(Pathname: String; Var Name: String; Var Size, Time: LongInt): Boolean;
  117. Procedure shSetFTime(Var F: File; Time: LongInt);
  118. Function  GetCurrentPath: String;
  119. Procedure CleanDir(FileDir: String);
  120. {$IFDEF WINDOWS}
  121. Function  GetEnv(Str: String): String;
  122. Function  FExpand(Str: String): String;
  123. Procedure FSplit(Path: String; Var Dir: String; Var Name: String; Var Ext: String);
  124. {$ENDIF}
  125. Function  IsDevice(FilePath: String): Boolean;
  126. Function  LoadFilePos(FN: String; Var Rec; FS: Word; FPos: LongInt): Word;
  127. Function  LoadFile(FN: String; Var Rec; FS: Word): Word;
  128. Function  SaveFilePos(FN: String; Var Rec; FS: Word; FPos: LongInt): Word;
  129. Function  SaveFile(FN: String; Var Rec; FS: Word): Word;
  130. Function  ExtendFile(FN: String; ToSize: LongInt): Word;
  131.  
  132.  
  133. Implementation
  134.  
  135. {$IFDEF WINDOWS}
  136. Uses Strings, MKWCrt;
  137. {$ELSE}
  138. Uses
  139.   {$IFDEF OPRO}
  140.   OpCrt;
  141.   {$ELSE}
  142.   Crt;
  143.   {$ENDIF}
  144. {$ENDIF}
  145.  
  146.  
  147.  
  148. {$IFDEF WINDOWS}
  149. Function GetEnv(Str: String): String;
  150.   Var
  151.     NStr: Array[0..128] of Char;
  152.     PStr: PChar;
  153.  
  154.   Begin
  155.   StrPCopy(NStr, Str);
  156.   PStr := GetEnvVar(NStr);
  157.   If PStr = nil Then
  158.     GetEnv := ''
  159.   Else
  160.     GetEnv := StrPas(PStr);
  161.   End;
  162. {$ENDIF}
  163.  
  164. {$IFDEF WINDOWS}
  165. Function FExpand(Str: String): String;
  166.   Var
  167.     IStr: Array[0..128] of Char;
  168.     OStr: Array[0..128] of Char;
  169.  
  170.   Begin
  171.   StrPCopy(IStr, Str);
  172.   FileExpand(OStr, IStr);
  173.   FExpand := StrPas(OStr);
  174.   End;
  175. {$ENDIF}
  176.  
  177. {$IFDEF WINDOWS}
  178. Procedure FSplit(Path: String; Var Dir: String; Var Name: String; Var Ext: String);
  179.   Var
  180.     FPath: Array[0..129] of Char;
  181.     TD: Array[0..129] of Char;
  182.     TN: Array[0..14] of Char;
  183.     TE: Array[0..5] of Char;
  184.  
  185.   Begin
  186.   StrPCopy(FPath, Path);
  187.   FileSplit(FPath, TD, TN, TE);
  188.   Dir := StrPas(TD);
  189.   Name := StrPas(TN);
  190.   Ext := StrPas(TE);
  191.   End;
  192. {$ENDIF}
  193.  
  194.  
  195. Procedure FindObj.Init;
  196.   Begin
  197.   New(FI);
  198.   FI^.DError := 1;
  199.   End;
  200.  
  201.  
  202. Procedure FindObj.Done;
  203.   Begin
  204.   Dispose(FI);
  205.   End;
  206.  
  207.  
  208. Procedure FindObj.FFirst(FN: String);
  209.   Begin
  210.   FN := FExpand(FN);
  211.   FSplit(FN, FI^.Dir, FI^.Name, FI^.Ext);
  212.   {$IFDEF WINDOWS}
  213.   StrPCopy(FI^.TStr, FN);
  214.   FindFirst(FI^.TStr, faReadOnly + faArchive, FI^.SR);
  215.   {$ELSE}
  216.   FindFirst(FN, Archive + ReadOnly, FI^.SR);
  217.   {$ENDIF}
  218.   FI^.DError := DosError;
  219.   End;
  220.  
  221.  
  222. Function  FindObj.GetName: String;
  223.   Begin
  224.   If Found Then
  225.     Begin
  226.     {$IFDEF WINDOWS}
  227.     GetName := StrPas(FI^.SR.Name)
  228.     {$ELSE}
  229.     GetName := FI^.SR.Name
  230.     {$ENDIF}
  231.     End
  232.   Else
  233.     GetName := '';
  234.   End;
  235.  
  236.  
  237. Function FindObj.GetFullPath: String;
  238.   Begin
  239.   GetFullPath := FI^.Dir + GetName;
  240.   End;
  241.  
  242.  
  243. Function  FindObj.GetSize: LongInt;
  244.   Begin
  245.   If Found Then
  246.     GetSize := FI^.SR.Size
  247.   Else
  248.     GetSize := 0;
  249.   End;
  250.  
  251.  
  252. Function  FindObj.GetDate: LongInt;
  253.   Begin
  254.   If Found Then
  255.     GetDate := FI^.SR.Time
  256.   Else
  257.     GetDate := 0;
  258.   End;
  259.  
  260.  
  261. Procedure FindObj.FNext;
  262.   Begin
  263.   FindNext(FI^.SR);
  264.   FI^.DError := DosError;
  265.   End;
  266.  
  267.  
  268. Function FindObj.Found: Boolean;
  269.   Begin
  270.   Found := (FI^.DError = 0);
  271.   End;
  272.  
  273.  
  274. Function shAssign(Var F: File; FName: String): Boolean;
  275.   Begin
  276.   Assign(F, FName);
  277.   FileError := IoResult;
  278.   shAssign := (FileError = 0);
  279.   End;
  280.  
  281.  
  282.  
  283. Function shRead(Var F: File; Var Rec; ReadSize: Word; Var NumRead: Word): Boolean;
  284.   Var
  285.     Count: Word;
  286.     Code: Word;
  287.  
  288.   Begin
  289.   Count := Tries;
  290.   Code := 5;
  291.   While ((Count > 0) and (Code = 5)) Do
  292.     Begin
  293.     BlockRead(F,Rec,ReadSize,NumRead);
  294.     Code := IoResult;
  295.     End;
  296.   FileError := Code;
  297.   ShRead := (Code = 0);
  298.   End;
  299.  
  300.  
  301. Function shWrite(Var F: File; Var Rec; ReadSize: Word): Boolean;
  302.   Var
  303.     Count: Word;
  304.     Code: Word;
  305.  
  306.   Begin
  307.   Count := Tries;
  308.   Code := 5;
  309.   While ((Count > 0) and (Code = 5)) Do
  310.     Begin
  311.     BlockWrite(F,Rec,ReadSize);
  312.     Code := IoResult;
  313.     End;
  314.   FileError := Code;
  315.   shWrite := (Code = 0);
  316.   End;
  317.  
  318.  
  319. Procedure CleanDir(FileDir: String);
  320.   Var
  321.     {$IFDEF WINDOWS}
  322.       SR: TSearchRec;
  323.       TStr: Array[0..128] of Char;
  324.     {$ELSE}
  325.       SR: SearchRec;
  326.     {$ENDIF}
  327.     F: File;
  328.  
  329.   Begin
  330.   {$IFDEF WINDOWS}
  331.   StrPCopy(TStr, FileDir);
  332.   StrCat(TStr,'*.*');
  333.   FindFirst(TStr, faReadOnly + faArchive, SR);
  334.   {$ELSE}
  335.   FindFirst(FileDir + '*.*', ReadOnly + Archive, SR);
  336.   {$ENDIF}
  337.   While DosError = 0 Do
  338.     Begin
  339.     {$IFDEF WINDOWS}
  340.     If Not shAssign(F, FileDir + StrPas(SR.Name)) Then;
  341.     {$ELSE}
  342.     If Not shAssign(F, FileDir + SR.Name) Then;
  343.     {$ENDIF}
  344.     Erase(F);
  345.     If IoResult <> 0 Then;
  346.     FindNext(SR);
  347.     End;
  348.   End;
  349.  
  350.  
  351.  
  352. {$IFDEF WINDOWS}
  353. Function GetCurrentPath: String;
  354.   Var
  355.     Path: Array[0..128] of Char;
  356.     CName: Array[0..13] of Char;
  357.     CExt: Array[0..4] of Char;
  358.     TStr: Array[0..128] of Char;
  359.  
  360.   Begin
  361.   FileExpand('*.*', TStr);
  362.   FileSplit(TStr, Path, CName, CExt);
  363.   GetCurrentPath := StrPas(Path);
  364.   End;
  365. {$ELSE}
  366. Function GetCurrentPath: String;
  367.   Var
  368.     CName: NameStr;
  369.     Path: DirStr;
  370.     CExt: ExtStr;
  371.  
  372.   Begin
  373.   FSplit(FExpand('*.*'),Path,CName,CExt);
  374.   GetCurrentPath := Path;
  375.   End;
  376. {$ENDIF}
  377.  
  378.  
  379. Function shLock(Var F; LockStart,LockLength: LongInt): Word;
  380.   Var
  381.     Count: Word;
  382.     Code: Word;
  383.  
  384.   Begin
  385.   Count := Tries;
  386.   Code := $21;
  387.   While ((Count > 0) and (Code = $21)) Do
  388.     Begin
  389.     Code := LockFile(F,LockStart,LockLength);
  390.     Dec(Count);
  391.     If Code = $21 Then
  392.       Delay(TryDelay);
  393.     End;
  394.   If Code = 1 Then
  395.     Code := 0;
  396.   shLock := Code;
  397.   End;
  398.  
  399.  
  400.  
  401. Function shReset(Var F: File; RecSize: Word): Boolean;
  402.   Var
  403.     Count: Word;
  404.     Code: Word;
  405.  
  406.   Begin
  407.   Count := Tries;
  408.   Code := 5;
  409.   While ((Count > 0) and (Code = 5)) Do
  410.     Begin
  411.     Reset(F,RecSize);
  412.     Code := IoResult;
  413.     End;
  414.   FileError := Code;
  415.   ShReset := (Code = 0);
  416.   End;
  417.  
  418.  
  419. Procedure FlushFile(Var F); {Dupe file handle, close dupe handle}
  420.   Var
  421.     {$IFDEF WINDOWS}
  422.     Regs: TRegisters;
  423.     {$ELSE}
  424.     Regs: Registers;
  425.     {$ENDIF}
  426.     Handle: Word Absolute F;
  427.  
  428.   Begin
  429.   Regs.Ah := $45;
  430.   Regs.Bx := Handle;
  431.   MsDos(Regs);
  432.   If  (Regs.Flags and 1) = 0 Then
  433.     Begin
  434.     Regs.Bx := Regs.Ax;
  435.     Regs.Ah := $3e;
  436.     MsDos(Regs);
  437.     End;
  438.   End;
  439.  
  440.  
  441. Function LockFile(Var F; LockStart: LongInt; LockLength: LongInt): Word;
  442.   Var
  443.     {$IFDEF WINDOWS}
  444.     Regs: TRegisters;
  445.     {$ELSE}
  446.     Regs: Registers;
  447.     {$ENDIF}
  448.     Handle: Word Absolute F;
  449.  
  450.   Begin
  451.   Regs.Ah := $5c;
  452.   Regs.Al := $00;
  453.   Regs.Bx := Handle;
  454.   Regs.Cx := LongHi(LockStart);
  455.   Regs.Dx := LongLo(LockStart);
  456.   Regs.Si := LongHi(LockLength);
  457.   Regs.Di := LongLo(LockLength);
  458.   MsDos(Regs);
  459.   If ((Regs.Flags and 1) = 0) Then
  460.     LockFile := 0                 {00h = success           }
  461.   Else
  462.     LockFile := Regs.Ax           {01h = share not loaded  }
  463.                                   {06h = invalid handle    }
  464.                                   {21h = lock violation    }
  465.                                   {24h = share buffer full }
  466.   End;
  467.  
  468.  
  469. Function UnLockFile(Var F; LockStart: LongInt; LockLength: LongInt): Word;
  470.   Var
  471.     {$IFDEF WINDOWS}
  472.     Regs: TRegisters;
  473.     {$ELSE}
  474.     Regs: Registers;
  475.     {$ENDIF}
  476.     Handle: Word Absolute F;
  477.     Code: Word;
  478.  
  479.   Begin
  480.   Regs.Ah := $5c;
  481.   Regs.Al := $01;
  482.   Regs.Bx := Handle;
  483.   Regs.Cx := LongHi(LockStart);
  484.   Regs.Dx := LongLo(LockStart);
  485.   Regs.Si := LongHi(LockLength);
  486.   Regs.Di := LongLo(LockLength);
  487.   MsDos(Regs);
  488.   If ((Regs.Flags and 1) = 0) Then
  489.     UnLockFile := 0               {00h = success           }
  490.   Else
  491.     Begin
  492.     Code := Regs.Ax;              {01h = share not loaded  }
  493.     If Code = 1 Then              {06h = invalid handle    }
  494.       Code := 0;                  {21h = lock violation    }
  495.     UnLockFile := Code            {24h = share buffer full }
  496.     End;
  497.   End;
  498.  
  499.  
  500. Function LongLo(InNum: LongInt): Word;
  501.   Begin
  502.   LongLo := InNum and $FFFF;
  503.   End;
  504.  
  505.  
  506. Function LongHi(InNum: LongInt): Word;
  507.   Begin
  508.   LongHi := InNum Shr 16;
  509.   End;
  510.  
  511.  
  512. Function SizeFile(FName: String): LongInt;
  513.   Var
  514.     {$IFDEF WINDOWS}
  515.     SR: TSearchRec;
  516.     TStr: Array[0..128] of Char;
  517.     {$ELSE}
  518.     SR: SearchRec;
  519.     {$ENDIF}
  520.  
  521.   Begin
  522.   {$IFDEF WINDOWS}
  523.   StrPCopy(TStr, FName);
  524.   FindFirst(TStr, faAnyFile, SR);
  525.   {$ELSE}
  526.   FindFirst(FName, AnyFile, SR);
  527.   {$ENDIF}
  528.   If DosError = 0 Then
  529.     SizeFile := SR.Size
  530.   Else
  531.     SizeFile := -1;
  532.   End;
  533.  
  534.  
  535. Function FileExist(FName: String): Boolean;
  536.   Var
  537.     {$IFDEF WINDOWS}
  538.     SR: TSearchRec;
  539.     TStr: Array[0..128] of Char;
  540.     {$ELSE}
  541.     SR: SearchRec;
  542.     {$ENDIF}
  543.  
  544.   Begin
  545.   {$IFDEF WINDOWS}
  546.   StrPCopy(TStr, FName);
  547.   FindFirst(TStr, faReadOnly + faHidden + faArchive, SR);
  548.   {$ELSE}
  549.   FindFirst(FName, ReadOnly + Hidden + Archive, SR);
  550.   {$ENDIF}
  551.   If DosError = 0 Then
  552.     FileExist := True
  553.   Else
  554.     FileExist := False;
  555.   End;
  556.  
  557.  
  558. {$IFDEF WINDOWS}
  559. Function FindPath(FileName: String): String;
  560.   Var
  561.     TStr: Array[0..128] of Char;
  562.     NStr: Array[0..14] of Char;
  563.  
  564.   Begin
  565.   If FileExist(FileName) Then
  566.     Begin
  567.     FileExpand(TStr, StrPCopy(NStr,FileName));
  568.     FindPath := StrPas(TStr);
  569.     End
  570.   Else
  571.     Begin
  572.     FileSearch(TStr, StrPCopy(NStr, FileName), GetEnvVar('Path'));
  573.     FileExpand(TStr, TStr);
  574.     FindPath := StrPas(TStr);
  575.     End;
  576.   End;
  577. {$ELSE}
  578. Function FindPath(FileName: String):String;
  579.   Begin
  580.   If FileExist(FileName) Then
  581.     FindPath := FExpand(FileName)
  582.   Else
  583.     FindPath := FExpand(FSearch(FileName,GetEnv('PATH')));
  584.   End;
  585. {$ENDIF}
  586.  
  587.  
  588. Procedure TFile.BufferRead;
  589.   Begin
  590.   TF^.BufferStart := FilePos(TF^.BufferFile);
  591.   if Not shRead (TF^.BufferFile,TF^.MsgBuffer,SizeOf(TF^.MsgBuffer),TF^.BufferChars) Then
  592.     TF^.BufferChars := 0;
  593.   TF^.BufferPtr := 1;
  594.   End;
  595.  
  596.  
  597. Function TFile.GetChar: Char;
  598.   Begin
  599.   If TF^.BufferChars > 0 Then
  600.     GetChar := TF^.MsgBuffer[TF^.BufferPtr]
  601.   Else
  602.     GetChar := #0;
  603.   Inc(TF^.BufferPtr);
  604.   If TF^.BufferPtr > TF^.BufferChars Then
  605.     BufferRead;
  606.   End;
  607.  
  608.  
  609. Function TFile.GetString: String;
  610.  
  611.   Var
  612.     TempStr: String;
  613.     GDone: Boolean;
  614.     Ch: Char;
  615.  
  616.   Begin
  617.     If TF^.MsgBuffer[TF^.BufferPtr] = #10 Then
  618.       Ch := GetChar;
  619.     TF^.StringPtr := TF^.BufferPtr + TF^.BufferStart - 1;
  620.     TempStr := '';
  621.     GDone := False;
  622.     TF^.StringFound := False;
  623.     While Not GDone Do
  624.       Begin
  625.       Ch := GetChar;
  626.       Case Ch Of
  627.         #0:  If TF^.BufferChars = 0 Then
  628.                GDone := True
  629.              Else
  630.                Begin
  631.                Inc(TempStr[0]);
  632.                TempStr[Ord(TempStr[0])] := Ch;
  633.                TF^.StringFound := True;
  634.                If Length(TempStr) = 255 Then
  635.                  GDone := True;
  636.                End;
  637.         #10:;
  638.         #26:;
  639.         #13: Begin
  640.              GDone := True;
  641.              TF^.StringFound := True;
  642.              End;
  643.         Else
  644.           Begin
  645.             Inc(TempStr[0]);
  646.             TempStr[Ord(TempStr[0])] := Ch;
  647.             TF^.StringFound := True;
  648.             If Length(TempStr) = 255 Then
  649.               GDone := True;
  650.           End;
  651.         End;
  652.       End;
  653.     GetString := TempStr;
  654.   End;
  655.  
  656.  
  657. Function TFile.OpenTextFile(FilePath: String): Boolean;
  658.   Begin
  659.   If Not shAssign(TF^.BufferFile, FilePath) Then;
  660.   FileMode := fmReadOnly + fmDenyNone;
  661.   If Not shReset(TF^.BufferFile,1) Then
  662.     OpenTextFile := False
  663.   Else
  664.     Begin
  665.     BufferRead;
  666.     If TF^.BufferChars > 0 Then
  667.       TF^.StringFound := True
  668.     Else
  669.       TF^.StringFound := False;
  670.     OpenTextFile := True;
  671.     End;
  672.   End;
  673.  
  674.  
  675. Function TFile.SeekTextFile(SeekPos: LongInt): Boolean;
  676.   Begin
  677.   TF^.Error := 0;
  678.   Seek(TF^.BufferFile, SeekPos);
  679.   TF^.Error := IoResult;
  680.   BufferRead;
  681.   SeekTextFile := (TF^.Error = 0);
  682.   End;
  683.  
  684.  
  685. Function TFile.GetTextPos: LongInt;       {Get text file position}
  686.   Begin
  687.   GetTextPos := TF^.BufferStart + TF^.BufferPtr - 1;
  688.   End;
  689.  
  690.  
  691. Function TFile.Restart: Boolean;
  692.   Begin
  693.   Restart := SeekTextFile(0);
  694.   End;
  695.  
  696.  
  697. Function TFile.CloseTextFile: Boolean;
  698.   Begin
  699.   Close(TF^.BufferFile);
  700.   CloseTextFile := (IoResult = 0);
  701.   End;
  702.  
  703.  
  704. Procedure TFile.Init;
  705.   Begin
  706.   New(TF);
  707.   End;
  708.  
  709.  
  710. Procedure TFile.Done;
  711.   Begin
  712.   Close(TF^.BufferFile);
  713.   If IoResult <> 0 Then;
  714.   Dispose(TF);
  715.   End;
  716.  
  717.  
  718. Function TFile.StringFound: Boolean;
  719.   Begin
  720.   StringFound := TF^.StringFound;
  721.   End;
  722.  
  723.  
  724. Function  shOpenFile(Var F: File; PathName: String): Boolean;
  725.   Begin
  726.   Assign(f,pathname);
  727.   FileMode := fmReadWrite + fmDenyNone;
  728.   shOpenFile := shReset(f,1);
  729.   End;
  730.  
  731.  
  732. Function  shMakeFile(Var F: File; PathName: String): Boolean;
  733.   Begin
  734.   Assign(f,pathname);
  735.   ReWrite(f,1);
  736.   shMakeFile := (IOresult = 0);
  737.   END;
  738.  
  739.  
  740. Procedure shCloseFile(Var F: File);
  741.   Begin
  742.   Close(F);
  743.   If (IOresult <> 0) Then;
  744.   End;
  745.  
  746.  
  747. Function  shSeekFile(Var F: File; FPos: LongInt): Boolean;
  748.   Begin
  749.   Seek(F,FPos);
  750.   shSeekFile := (IOresult = 0);
  751.   End;
  752.  
  753.  
  754. Function  shFindFile(Pathname: String; Var Name: String; Var Size, Time: LongInt): Boolean;
  755.   Var
  756.     {$IFDEF WINDOWS}
  757.       SR: TSearchRec;
  758.       PStr: Array[0..128] of Char;
  759.     {$ELSE}
  760.       SR: SearchRec;
  761.    {$ENDIF}
  762.  
  763.   Begin
  764.   {$IFDEF WINDOWS}
  765.   StrPCopy(PStr, PathName);
  766.   FindFirst(PStr, faArchive, SR);
  767.   {$ELSE}
  768.   FindFirst(PathName, Archive, SR);
  769.   {$ENDIF}
  770.   If (DosError = 0) Then
  771.     Begin
  772.     shFindFile := True;
  773.     {$IFDEF WINDOWS}
  774.     Name := StrPas(SR.Name);
  775.     {$ELSE}
  776.     Name := Sr.Name;
  777.     {$ENDIF}
  778.     Size := Sr.Size;
  779.     Time := Sr.Time;
  780.     End
  781.   Else
  782.     Begin
  783.     shFindFile := False;
  784.     End;
  785.   End;
  786.  
  787.  
  788. Procedure shSetFTime(Var F: File; Time: LongInt);
  789.   Begin
  790.   SetFTime(F, Time);
  791.   If (IOresult <> 0) Then;
  792.   End;
  793.  
  794.  
  795.  
  796. Function IsDevice(FilePath: String): Boolean;
  797.   Var
  798.     F: File;
  799.     Handle: Word Absolute F;
  800.     {$IFDEF WINDOWS}
  801.     Regs: TRegisters;
  802.     {$ELSE}
  803.     Regs: Registers;
  804.     {$ENDIF}
  805.  
  806.   Begin
  807.   Assign(F, FilePath);
  808.   Reset(F);
  809.   If IoResult <> 0 Then
  810.     IsDevice := False
  811.   Else
  812.     Begin
  813.     Regs.ah := $44;
  814.     Regs.al := 0;
  815.     Regs.bx := Handle;
  816.     Intr($21, Regs);
  817.     IsDevice := ((Regs.Dx and 128) <> 0);
  818.     End;
  819.   Close(F);
  820.   If IoResult <> 0 THen;
  821.   End;
  822.  
  823.  
  824. Function LoadFile(FN: String; Var Rec; FS: Word): Word;
  825.   Begin
  826.   LoadFile := LoadFilePos(FN, Rec, FS, 0);
  827.   End;
  828.  
  829.  
  830. Function LoadFilePos(FN: String; Var Rec; FS: Word; FPos: LongInt): Word;
  831.   Var
  832.     F: File;
  833.     Error: Word;
  834.     NumRead: Word;
  835.  
  836.   Begin
  837.   Error := 0;
  838.   If Not FileExist(FN) Then
  839.     Error := 8888;
  840.   If Error = 0 Then
  841.     Begin
  842.     If Not shAssign(F, FN) Then
  843.       Error := FileError;
  844.     End;
  845.   FileMode := fmReadOnly + fmDenyNone;
  846.   If Not shReset(F,1) Then
  847.     Error := FileError;
  848.   If Error = 0 Then
  849.     Begin
  850.     Seek(F, FPos);
  851.     Error := IoResult;
  852.     End;
  853.   If Error = 0 Then
  854.     If Not shRead(F, Rec, FS, NumRead) Then
  855.       Error := FileError;
  856.   If Error = 0 Then
  857.     Begin
  858.     Close(F);
  859.     Error := IoResult;
  860.     End;
  861.   LoadFilePos := Error;
  862.   End;
  863.  
  864.  
  865. Function SaveFile(FN: String; Var Rec; FS: Word): Word;
  866.    Begin
  867.    SaveFile := SaveFilePos(FN, Rec, FS, 0);
  868.    End;
  869.  
  870.  
  871.  
  872. Function SaveFilePos(FN: String; Var Rec; FS: Word; FPos: LongInt): Word;
  873.   Var
  874.     F: File;
  875.     Error: Word;
  876.  
  877.   Begin
  878.   Error := 0;
  879.   If Not shAssign(F, FN) Then
  880.     Error := FileError;
  881.   FileMode := fmReadWrite + fmDenyNone;
  882.   If FileExist(FN) Then
  883.     Begin
  884.     If Not shReset(F,1) Then
  885.       Error := FileError;
  886.     End
  887.   Else
  888.     Begin
  889.     ReWrite(F,1);
  890.     Error := IoResult;
  891.     End;
  892.   If Error = 0 Then
  893.     Begin
  894.     Seek(F, FPos);
  895.     Error := IoResult;
  896.     End;
  897.   If Error = 0 Then
  898.     If Not shWrite(F, Rec, FS) Then
  899.       Error := FileError;
  900.   If Error = 0 Then
  901.     Begin
  902.     Close(F);
  903.     Error := IoResult;
  904.     End;
  905.   SaveFilePos := Error;
  906.   End;
  907.  
  908.  
  909. Function ExtendFile(FN: String; ToSize: LongInt): Word;
  910. {Pads file with nulls to specified size}
  911.   Type
  912.     FillType = Array[1..8000] of Byte;
  913.  
  914.   Var
  915.     F: File;
  916.     Error: Word;
  917.     FillRec: ^FillType;
  918.  
  919.   Begin
  920.   New(FillRec);
  921.   FillChar(FillRec^, SizeOf(FillRec^), 0);
  922.   Error := 0;
  923.   If Not shAssign(F, FN) Then
  924.     Error := FileError;
  925.   FileMode := fmReadWrite + fmDenyNone;
  926.   If FileExist(FN) Then
  927.     Begin
  928.     If Not shReset(F,1) Then
  929.       Error := FileError;
  930.     End
  931.   Else
  932.     Begin
  933.     ReWrite(F,1);
  934.     Error := IoResult;
  935.     End;
  936.   If Error = 0 Then
  937.     Begin
  938.     Seek(F, FileSize(F));
  939.     Error := IoResult;
  940.     End;
  941.   If Error = 0 Then
  942.     Begin
  943.     While ((FileSize(F) < (ToSize - SizeOf(FillRec^))) and (Error = 0)) Do
  944.     If Not shWrite(F, FillRec^, SizeOf(FillRec^)) Then
  945.       Error := FileError;
  946.     End;
  947.   If ((Error = 0) and (FileSize(F) < ToSize)) Then
  948.     Begin
  949.     If Not shWrite(F, FillRec^, ToSize - FileSize(F)) Then
  950.       Error := FileError;
  951.     End;
  952.   If Error = 0 Then
  953.     Begin
  954.     Close(F);
  955.     Error := IoResult;
  956.     End;
  957.   Dispose(FillRec);
  958.   ExtendFile := Error;
  959.   End;
  960.  
  961.  
  962. End.
  963.