home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / mksmvp10.zip / MKFILE.PAS < prev    next >
Pascal/Delphi Source File  |  1997-09-28  |  26KB  |  1,223 lines
  1. Unit MKFile;
  2. {$I MKB.Def}
  3.  
  4. {
  5.      MKFile - Copyright 1993 by Mark May - MK Software
  6.      You are free to use this code in your programs, however
  7.      it may not be included in Source/TPU function libraries
  8.      without my permission.
  9.  
  10.      Mythical Kingom Tech BBS (513)237-7737 HST/v32
  11.      FidoNet: 1:110/290
  12.      Rime: ->MYTHKING
  13.      You may also reach me at maym@dmapub.dma.org
  14. }
  15.  
  16.  
  17. Interface
  18.  
  19. Uses Dos, Use32;
  20.  
  21. Const
  22.   fmReadOnly = 0;          {FileMode constants}
  23.   fmWriteOnly = 1;
  24.   fmReadWrite = 2;
  25.   fmDenyAll = 16;
  26.   fmDenyWrite = 32;
  27.   fmDenyRead = 48;
  28.   fmDenyNone = 64;
  29.   fmNoInherit = 128;
  30.  
  31.  
  32. Const
  33.   Tries: Word = 150;
  34.   TryDelay: Word = 100;
  35.  
  36.  
  37. {$IFDEF WINDOWS}
  38. Type
  39.   PathStr = String[128];
  40.   DirStr = String[128];
  41.   NameStr = String[13];
  42.   ExtStr = String[4];
  43. {$ENDIF}
  44.  
  45.  
  46. Type FindRec = Record
  47.   {$IFDEF WINDOWS}
  48.   SR: TSearchRec;
  49.   TStr: Array[0..180] of Char;
  50.   {$ELSE}
  51.   SR: SearchRec;
  52.   {$ENDIF}
  53.   Dir: DirStr;
  54.   Name: NameStr;
  55.   Ext: ExtStr;
  56.   DError: Word;
  57.   End;
  58.  
  59.  
  60. Type FindObj = Object
  61.   FI: ^FindRec;
  62.   Procedure Init; {Initialize}
  63.   Procedure Done; {Done}
  64.   Procedure FFirst(FN: String); {Find first}
  65.   Procedure FNext;
  66.   Function  Found: Boolean; {File was found}
  67.   Function  GetName: String; {Get Filename}
  68.   Function  GetFullPath: String; {Get filename with path}
  69.   Function  GetDate: LongInt; {Get file date}
  70.   Function  GetSize: LongInt; {Get file size}
  71.   End;
  72.  
  73.  
  74. Type TFileArray = Array[1..$fff0] of Char;
  75.  
  76. Type TFileRec = Record
  77.   MsgBuffer: ^TFileArray;
  78.   BufferPtr: Word;
  79.   BufferChars: Word;
  80.   BufferStart: LongInt;
  81.   BufferFile: File;
  82.   CurrentStr: String;
  83.   StringFound: Boolean;
  84.   Error: Word;
  85.   BufferSize: Word;
  86.   End;
  87.  
  88.  
  89. Type TFile = Object
  90.   TF: ^TFileRec;
  91.   Procedure Init;
  92.   Procedure Done;
  93.   Function  GetString:String;          {Get string from file}
  94.   Function  GetUString: String; {Get LF delimited string}
  95.   Function  OpenTextFile(FilePath: String): Boolean;  {Open file}
  96.   Function  CloseTextFile: Boolean;    {Close file}
  97.   Function  GetChar: Char;             {Internal use}
  98.   Procedure BufferRead;                {Internal use}
  99.   Function  StringFound: Boolean;      {Was a string found}
  100.   Function  SeekTextFile(SeekPos: LongInt): Boolean; {Seek to position}
  101.   Function  Restart: Boolean;          {Reset to start of file}
  102.   Procedure SetBufferSize(BSize: Word); {Set buffer size}
  103.   Function  GetTextPos: LongInt;       {Get text file position}
  104.   End;
  105.  
  106.  
  107.  
  108. Var
  109.   MKFileError: Word;
  110.  
  111.  
  112. Function  FileExist(FName: String): Boolean;
  113. Function  SizeFile(FName: String): LongInt;
  114. Function  DateFile(FName: String): LongInt;
  115. Function  FindPath(FileName: String): String;
  116. Function  LongLo(InNum: LongInt): Word;
  117. Function  LongHi(InNum: LongInt): Word;
  118. Function  LockFile(Var F; LockStart: LongInt; LockLength: LongInt): Word;
  119. Function  UnLockFile(Var F; LockStart: LongInt; LockLength: LongInt): Word;
  120. Function  shAssign(Var F: File; FName: String): Boolean;
  121. Function  shLock(Var F; LockStart,LockLength: LongInt): Word;
  122. Procedure FlushFile(Var F); {Dupe file handle, close dupe handle}
  123. Function  shReset(Var F: File; RecSize: Word): Boolean;
  124. Function  shRead(Var F: File; Var Rec; ReadSize: Word; Var NumRead: Word): Boolean;
  125. Function  shWrite(Var F: File; Var Rec; ReadSize: Word): Boolean;
  126. Function  shOpenFile(Var F: File; PathName: String): Boolean;
  127. Function  shMakeFile(Var F: File; PathName: String): Boolean;
  128. Procedure shCloseFile(Var F: File);
  129. Function  shSeekFile(Var F: File; FPos: LongInt): Boolean;
  130. Function  shFindFile(Pathname: String; Var Name: String; Var Size, Time: LongInt): Boolean;
  131. Procedure shSetFTime(Var F: File; Time: LongInt);
  132. Function  GetCurrentPath: String;
  133. Procedure CleanDir(FileDir: String);
  134. {$IFDEF WINDOWS}
  135. Function  GetEnv(Str: String): String;
  136. Function  FExpand(Str: String): String;
  137. Procedure FSplit(Path: String; Var Dir: String; Var Name: String; Var Ext: String);
  138. Function  FSearch(Path: String; DirList: String): String;
  139. {$ENDIF}
  140. Function  IsDevice(FilePath: String): Boolean;
  141. Function  LoadFilePos(FN: String; Var Rec; FS: Word; FPos: LongInt): Word;
  142. Function  LoadFile(FN: String; Var Rec; FS: Word): Word;
  143. Function  SaveFilePos(FN: String; Var Rec; FS: Word; FPos: LongInt): Word;
  144. Function  SaveFile(FN: String; Var Rec; FS: Word): Word;
  145. Function  ExtendFile(FN: String; ToSize: LongInt): Word;
  146. Function  GetTempName(FN: String): String;
  147. Function  FindOnPath(FN: String; Var OutName: String): Boolean;
  148. Function  CopyFile(FN1: String; FN2: String): Boolean;
  149. Function  EraseFile(FN: String): Boolean;
  150. Function  MakePath(FP: String): Boolean;
  151.  
  152.  
  153. Implementation
  154.  
  155. {$IFDEF WINDOWS}
  156. Uses Strings, MKWCrt;
  157. {$ELSE}
  158. Uses
  159.   {$IFDEF OPRO}
  160.   OpCrt;
  161.   {$ELSE}
  162.   Crt, Os2Base;
  163.   {$ENDIF}
  164. {$ENDIF}
  165.  
  166.  
  167. {$IFDEF WINDOWS}
  168. Function GetEnv(Str: String): String;
  169.   Var
  170.     NStr: Array[0..128] of Char;
  171.     PStr: PChar;
  172.  
  173.   Begin
  174.   StrPCopy(NStr, Str);
  175.   PStr := GetEnvVar(NStr);
  176.   If PStr = nil Then
  177.     GetEnv := ''
  178.   Else
  179.     GetEnv := StrPas(PStr);
  180.   End;
  181. {$ENDIF}
  182.  
  183. {$IFDEF WINDOWS}
  184. Function FExpand(Str: String): String;
  185.   Var
  186.     IStr: Array[0..128] of Char;
  187.     OStr: Array[0..128] of Char;
  188.  
  189.   Begin
  190.   StrPCopy(IStr, Str);
  191.   FileExpand(OStr, IStr);
  192.   FExpand := StrPas(OStr);
  193.   End;
  194. {$ENDIF}
  195.  
  196. {$IFDEF WINDOWS}
  197. Procedure FSplit(Path: String; Var Dir: String; Var Name: String; Var Ext: String);
  198.   Var
  199.     FPath: Array[0..129] of Char;
  200.     TD: Array[0..129] of Char;
  201.     TN: Array[0..14] of Char;
  202.     TE: Array[0..5] of Char;
  203.  
  204.   Begin
  205.   StrPCopy(FPath, Path);
  206.   FileSplit(FPath, TD, TN, TE);
  207.   Dir := StrPas(TD);
  208.   Name := StrPas(TN);
  209.   Ext := StrPas(TE);
  210.   End;
  211. {$ENDIF}
  212.  
  213. {$IFDEF WINDOWS}
  214. Function  FSearch(Path: String; DirList: String): String;
  215.   Var
  216.     FPath: Array[0..129] of Char;
  217.     DL: Array[0..129] of Char;
  218.     RS: Array[0..129] of Char;
  219.  
  220.   Begin
  221.   StrPCopy(Fpath, Path);
  222.   StrPCopy(DL, DirList);
  223.   FileSearch(RS, FPath, DL);
  224.   FSearch := StrPas(RS);
  225.   End;
  226. {$ENDIF}
  227.  
  228. Procedure FindObj.Init;
  229.   Begin
  230.   New(FI);
  231.   FI^.DError := 1;
  232.   End;
  233.  
  234.  
  235. Procedure FindObj.Done;
  236.   Begin
  237.   Dispose(FI);
  238.   End;
  239.  
  240.  
  241. Procedure FindObj.FFirst(FN: String);
  242.   Begin
  243.   FN := FExpand(FN);
  244.   FSplit(FN, FI^.Dir, FI^.Name, FI^.Ext);
  245.   FindFirst(FN, Archive + ReadOnly, FI^.SR);
  246.   FI^.DError := Dos.DosError;
  247.   End;
  248.  
  249.  
  250. Function  FindObj.GetName: String;
  251.   Begin
  252.   If Found Then
  253.     Begin
  254.     {$IFDEF WINDOWS}
  255.     GetName := StrPas(FI^.SR.Name)
  256.     {$ELSE}
  257.     GetName := FI^.SR.Name
  258.     {$ENDIF}
  259.     End
  260.   Else
  261.     GetName := '';
  262.   End;
  263.  
  264.  
  265. Function FindObj.GetFullPath: String;
  266.   Begin
  267.   GetFullPath := FI^.Dir + GetName;
  268.   End;
  269.  
  270.  
  271. Function  FindObj.GetSize: LongInt;
  272.   Begin
  273.   If Found Then
  274.     GetSize := FI^.SR.Size
  275.   Else
  276.     GetSize := 0;
  277.   End;
  278.  
  279.  
  280. Function  FindObj.GetDate: LongInt;
  281.   Begin
  282.   If Found Then
  283.     GetDate := FI^.SR.Time
  284.   Else
  285.     GetDate := 0;
  286.   End;
  287.  
  288.  
  289. Procedure FindObj.FNext;
  290.   Begin
  291.   FindNext(FI^.SR);
  292.   FI^.DError := Dos.DosError;
  293.   End;
  294.  
  295.  
  296. Function FindObj.Found: Boolean;
  297.   Begin
  298.   Found := (FI^.DError = 0);
  299.   End;
  300.  
  301.  
  302. Function shAssign(Var F: File; FName: String): Boolean;
  303.   Begin
  304.   Assign(F, FName);
  305.   MKFileError := IoResult;
  306.   shAssign := (MKFileError = 0);
  307.   End;
  308.  
  309.  
  310.  
  311. Function shRead(Var F: File; Var Rec; ReadSize: Word; Var NumRead: Word): Boolean;
  312.   Var
  313.     Count: Word;
  314.     Code: Word;
  315.  
  316.   Begin
  317.   Count := Tries;
  318.   Code := 5;
  319.   While ((Count > 0) and (Code = 5)) Do
  320.     Begin
  321.     BlockRead(F,Rec,ReadSize,NumRead);
  322.     Code := IoResult;
  323.     Dec(Count);
  324.     End;
  325.   MKFileError := Code;
  326.   ShRead := (Code = 0);
  327.   End;
  328.  
  329.  
  330. Function shWrite(Var F: File; Var Rec; ReadSize: Word): Boolean;
  331.   Var
  332.     Count: Word;
  333.     Code: Word;
  334.  
  335.   Begin
  336.   Count := Tries;
  337.   Code := 5;
  338.   While ((Count > 0) and (Code = 5)) Do
  339.     Begin
  340.     BlockWrite(F,Rec,ReadSize);
  341.     Code := IoResult;
  342.     Dec(Count);
  343.     End;
  344.   MKFileError := Code;
  345.   shWrite := (Code = 0);
  346.   End;
  347.  
  348.  
  349. Procedure CleanDir(FileDir: String);
  350.   Var
  351.     {$IFDEF WINDOWS}
  352.       SR: TSearchRec;
  353.       TStr: Array[0..128] of Char;
  354.     {$ELSE}
  355.       SR: SearchRec;
  356.     {$ENDIF}
  357.     F: File;
  358.  
  359.   Begin
  360.   {$IFDEF WINDOWS}
  361.   StrPCopy(TStr, FileDir);
  362.   StrCat(TStr,'*.*');
  363.   FindFirst(TStr, faReadOnly + faArchive, SR);
  364.   {$ELSE}
  365.   FindFirst(FileDir + '*.*', ReadOnly + Archive, SR);
  366.   {$ENDIF}
  367.   While Dos.DosError = 0 Do
  368.     Begin
  369.     {$IFDEF WINDOWS}
  370.     If Not shAssign(F, FileDir + StrPas(SR.Name)) Then;
  371.     {$ELSE}
  372.     If Not shAssign(F, FileDir + SR.Name) Then;
  373.     {$ENDIF}
  374.     Erase(F);
  375.     If IoResult <> 0 Then;
  376.     FindNext(SR);
  377.     End;
  378.   End;
  379.  
  380.  
  381.  
  382. {$IFDEF WINDOWS}
  383. Function GetCurrentPath: String;
  384.   Var
  385.     Path: Array[0..128] of Char;
  386.     CName: Array[0..13] of Char;
  387.     CExt: Array[0..4] of Char;
  388.     TStr: Array[0..128] of Char;
  389.  
  390.   Begin
  391.   FileExpand('*.*', TStr);
  392.   FileSplit(TStr, Path, CName, CExt);
  393.   GetCurrentPath := StrPas(Path);
  394.   End;
  395. {$ELSE}
  396. Function GetCurrentPath: String;
  397.   Var
  398.     CName: NameStr;
  399.     Path: DirStr;
  400.     CExt: ExtStr;
  401.  
  402.   Begin
  403.   FSplit(FExpand('*.*'),Path,CName,CExt);
  404.   GetCurrentPath := Path;
  405.   End;
  406. {$ENDIF}
  407.  
  408.  
  409. Function shLock(Var F; LockStart,LockLength: LongInt): Word;
  410.   Var
  411.     Count: Word;
  412.     Code: Word;
  413.  
  414.   Begin
  415.   Count := Tries;
  416.   Code := $21;
  417.   While ((Count > 0) and (Code = $21)) Do
  418.     Begin
  419.     Code := LockFile(F,LockStart,LockLength);
  420.     Dec(Count);
  421.     If Code = $21 Then
  422.       Delay(TryDelay);
  423.     End;
  424.   If Code = 1 Then
  425.     Code := 0;
  426.   shLock := Code;
  427.   End;
  428.  
  429.  
  430.  
  431. Function shReset(Var F: File; RecSize: Word): Boolean;
  432.   Var
  433.     Count: Word;
  434.     Code: Word;
  435.  
  436.   Begin
  437.   Count := Tries;
  438.   Code := 5;
  439.   While ((Count > 0) and (Code = 5)) Do
  440.     Begin
  441.     Reset(F,RecSize);
  442.     Code := IoResult;
  443.     Dec(Count);
  444.     End;
  445.   MKFileError := Code;
  446.   ShReset := (Code = 0);
  447.   End;
  448.  
  449.  
  450. Procedure FlushFile(Var F); {Dupe file handle, close dupe handle}
  451.   Begin
  452.   End;
  453.  
  454.  
  455. Function LockFile(Var F; LockStart: LongInt; LockLength: LongInt): Word;
  456.   Var
  457.     Handle: Word Absolute F;
  458.     Tmp: Word;
  459.     RC : LongInt;
  460.     FL1, FL2 : FileLock;
  461.   Begin;
  462.      FL1.loffset := 0;
  463.      FL1.lrange := 0;
  464.      FL2.loffset := LockStart;
  465.      FL2.lrange := LockLength;
  466.      RC := DosSetFileLocks(Handle,FL1,FL2,500000,0);
  467.      LockFile := RC And $FFFF;
  468.   End;
  469.  
  470.  
  471. Function UnLockFile(Var F; LockStart: LongInt; LockLength: LongInt): Word;
  472.   Var
  473.     Handle: Word Absolute F;
  474.     Tmp: Word;
  475.     RC : LongInt;
  476.     FL1, FL2 : FileLock;
  477.   Begin;
  478.      FL2.loffset := 0;
  479.      FL2.lrange := 0;
  480.      FL1.loffset := LockStart;
  481.      FL1.lrange := LockLength;
  482.      RC := DosSetFileLocks(Handle,FL1,FL2,500000,0);
  483.      UnLockFile := RC And $FFFF;
  484.   End;
  485.  
  486. Function LongLo(InNum: LongInt): Word;
  487.   Begin
  488.   LongLo := InNum and $FFFF;
  489.   End;
  490.  
  491.  
  492. Function LongHi(InNum: LongInt): Word;
  493.   Begin
  494.   LongHi := InNum Shr 16;
  495.   End;
  496.  
  497.  
  498. Function SizeFile(FName: String): LongInt;
  499.   Var
  500.     {$IFDEF WINDOWS}
  501.     SR: TSearchRec;
  502.     TStr: Array[0..128] of Char;
  503.     {$ELSE}
  504.     SR: SearchRec;
  505.     {$ENDIF}
  506.  
  507.   Begin
  508.   {$IFDEF WINDOWS}
  509.   StrPCopy(TStr, FName);
  510.   FindFirst(TStr, faAnyFile, SR);
  511.   {$ELSE}
  512.   FindFirst(FName, AnyFile, SR);
  513.   {$ENDIF}
  514.   If Dos.DosError = 0 Then
  515.     SizeFile := SR.Size
  516.   Else
  517.     SizeFile := -1;
  518.   End;
  519.  
  520.  
  521. Function  DateFile(FName: String): LongInt;
  522.   Var
  523.     {$IFDEF WINDOWS}
  524.     SR: TSearchRec;
  525.     TStr: Array[0..128] of Char;
  526.     {$ELSE}
  527.     SR: SearchRec;
  528.     {$ENDIF}
  529.  
  530.   Begin
  531.   {$IFDEF WINDOWS}
  532.   StrPCopy(TStr, FName);
  533.   FindFirst(TStr, faAnyFile, SR);
  534.   {$ELSE}
  535.   FindFirst(FName, AnyFile, SR);
  536.   {$ENDIF}
  537.   If Dos.DosError = 0 Then
  538.     DateFile := SR.Time
  539.   Else
  540.     DateFile := 0;
  541.   End;
  542.  
  543.  
  544. Function FileExist(FName: String): Boolean;
  545.   Var
  546.     {$IFDEF WINDOWS}
  547.     SR: TSearchRec;
  548.     TStr: Array[0..128] of Char;
  549.     {$ELSE}
  550.     SR: SearchRec;
  551.     {$ENDIF}
  552.  
  553.   Begin
  554.   If IoResult <> 0 Then;
  555.   {$IFDEF WINDOWS}
  556.   StrPCopy(TStr, FName);
  557.   FindFirst(TStr, faReadOnly + faHidden + faArchive, SR);
  558.   {$ELSE}
  559.   FindFirst(FName, ReadOnly + Hidden + Archive, SR);
  560.   {$ENDIF}
  561.   If Dos.DosError = 0 Then
  562.     FileExist := True
  563.   Else
  564.     FileExist := False;
  565.   If IoResult <> 0 Then;
  566.   End;
  567.  
  568.  
  569. {$IFDEF WINDOWS}
  570. Function FindPath(FileName: String): String;
  571.   Var
  572.     TStr: Array[0..128] of Char;
  573.     NStr: Array[0..14] of Char;
  574.  
  575.   Begin
  576.   FindPath := FileName;
  577.   If FileExist(FileName) Then
  578.     Begin
  579.     FileExpand(TStr, StrPCopy(NStr,FileName));
  580.     FindPath := StrPas(TStr);
  581.     End
  582.   Else
  583.     Begin
  584.     FileSearch(TStr, StrPCopy(NStr, FileName), GetEnvVar('Path'));
  585.     FileExpand(TStr, TStr);
  586.     FindPath := StrPas(TStr);
  587.     End;
  588.   End;
  589. {$ELSE}
  590. Function FindPath(FileName: String):String;
  591.   Begin
  592.   FindPath := FileName;
  593.   If FileExist(FileName) Then
  594.     FindPath := FExpand(FileName)
  595.   Else
  596.     FindPath := FExpand(FSearch(FileName,GetEnv('PATH')));
  597.   End;
  598. {$ENDIF}
  599.  
  600.  
  601. Procedure TFile.BufferRead;
  602.   Begin
  603.   TF^.BufferStart := FilePos(TF^.BufferFile);
  604.   if Not shRead (TF^.BufferFile,TF^.MsgBuffer^ , TF^.BufferSize, TF^.BufferChars) Then
  605.     TF^.BufferChars := 0;
  606.   TF^.BufferPtr := 1;
  607.   End;
  608.  
  609.  
  610. Function TFile.GetChar: Char;
  611.   Begin
  612.   If TF^.BufferPtr > TF^.BufferChars Then
  613.     BufferRead;
  614.   If TF^.BufferChars > 0 Then
  615.     GetChar := TF^.MsgBuffer^[TF^.BufferPtr]
  616.   Else
  617.     GetChar := #0;
  618.   Inc(TF^.BufferPtr);
  619.   If TF^.BufferPtr > TF^.BufferChars Then
  620.     BufferRead;
  621.   End;
  622.  
  623.  
  624. Function TFile.GetString: String;
  625.  
  626.   Var
  627.     TempStr: String;
  628.     GDone: Boolean;
  629.     Ch: Char;
  630.  
  631.   Begin
  632.     TempStr := '';
  633.     GDone := False;
  634.     TF^.StringFound := False;
  635.     While Not GDone Do
  636.       Begin
  637.       Ch := GetChar;
  638.       Case Ch Of
  639.         #0:  If TF^.BufferChars = 0 Then
  640.                GDone := True
  641.              Else
  642.                Begin
  643.                Inc(TempStr[0]);
  644.                TempStr[Ord(TempStr[0])] := Ch;
  645.                TF^.StringFound := True;
  646.                If Length(TempStr) = 255 Then
  647.                  GDone := True;
  648.                End;
  649.         #10:;
  650.         #26:;
  651.         #13: Begin
  652.              GDone := True;
  653.              TF^.StringFound := True;
  654.              End;
  655.         Else
  656.           Begin
  657.             Inc(TempStr[0]);
  658.             TempStr[Ord(TempStr[0])] := Ch;
  659.             TF^.StringFound := True;
  660.             If Length(TempStr) = 255 Then
  661.               GDone := True;
  662.           End;
  663.         End;
  664.       End;
  665.     GetString := TempStr;
  666.   End;
  667.  
  668.  
  669. Function TFile.GetUString: String;
  670.  
  671.   Var
  672.     TempStr: String;
  673.     GDone: Boolean;
  674.     Ch: Char;
  675.  
  676.   Begin
  677.   TempStr := '';
  678.   GDone := False;
  679.   TF^.StringFound := False;
  680.   While Not GDone Do
  681.     Begin
  682.     Ch := GetChar;
  683.     Case Ch Of
  684.       #0:  If TF^.BufferChars = 0 Then
  685.              GDone := True
  686.            Else
  687.              Begin
  688.              Inc(TempStr[0]);
  689.              TempStr[Ord(TempStr[0])] := Ch;
  690.              TF^.StringFound := True;
  691.              If Length(TempStr) = 255 Then
  692.                GDone := True;
  693.              End;
  694.       #13:;
  695.       #26:;
  696.       #10: Begin
  697.            GDone := True;
  698.            TF^.StringFound := True;
  699.            End;
  700.       Else
  701.         Begin
  702.         Inc(TempStr[0]);
  703.         TempStr[Ord(TempStr[0])] := Ch;
  704.         TF^.StringFound := True;
  705.         If Length(TempStr) = 255 Then
  706.           GDone := True;
  707.         End;
  708.       End;
  709.     End;
  710.   GetUString := TempStr;
  711.   End;
  712.  
  713.  
  714. Function TFile.OpenTextFile(FilePath: String): Boolean;
  715.   Begin
  716.   If Not shAssign(TF^.BufferFile, FilePath) Then;
  717.   FileMode := fmReadOnly + fmDenyNone;
  718.   If Not shReset(TF^.BufferFile,1) Then
  719.     OpenTextFile := False
  720.   Else
  721.     Begin
  722.     BufferRead;
  723.     If TF^.BufferChars > 0 Then
  724.       TF^.StringFound := True
  725.     Else
  726.       TF^.StringFound := False;
  727.     OpenTextFile := True;
  728.     End;
  729.   End;
  730.  
  731.  
  732. Function TFile.SeekTextFile(SeekPos: LongInt): Boolean;
  733.   Begin
  734.   TF^.Error := 0;
  735.   If ((SeekPos < TF^.BufferStart) Or (SeekPos > TF^.BufferStart + TF^.BufferChars)) Then
  736.     Begin
  737.     Seek(TF^.BufferFile, SeekPos);
  738.     TF^.Error := IoResult;
  739.     BufferRead;
  740.     End
  741.   Else
  742.     Begin
  743.     TF^.BufferPtr := SeekPos + 1 - TF^.BufferStart;
  744.     End;
  745.   SeekTextFile := (TF^.Error = 0);
  746.   End;
  747.  
  748.  
  749. Function TFile.GetTextPos: LongInt;       {Get text file position}
  750.   Begin
  751.   GetTextPos := TF^.BufferStart + TF^.BufferPtr - 1;
  752.   End;
  753.  
  754.  
  755. Function TFile.Restart: Boolean;
  756.   Begin
  757.   Restart := SeekTextFile(0);
  758.   End;
  759.  
  760.  
  761. Function TFile.CloseTextFile: Boolean;
  762.   Begin
  763.   Close(TF^.BufferFile);
  764.   CloseTextFile := (IoResult = 0);
  765.   End;
  766.  
  767.  
  768. Procedure TFile.SetBufferSize(BSize: Word);
  769.   Begin
  770.   FreeMem(TF^.MsgBuffer, TF^.BufferSize);
  771.   TF^.BufferSize := BSize;
  772.   GetMem(TF^.MsgBuffer, TF^.BufferSize);
  773.   TF^.BufferChars := 0;
  774.   TF^.BufferStart := 0;
  775.   If SeekTextFile(GetTextPos) Then;
  776.   End;
  777.  
  778.  
  779. Procedure TFile.Init;
  780.   Begin
  781.   New(TF);
  782.   TF^.BufferSize := 2048;
  783.   GetMem(TF^.MsgBuffer, TF^.BufferSize);
  784.   End;
  785.  
  786.  
  787. Procedure TFile.Done;
  788.   Begin
  789.   Close(TF^.BufferFile);
  790.   If IoResult <> 0 Then;
  791.   FreeMem(TF^.MsgBuffer, TF^.BufferSize);
  792.   Dispose(TF);
  793.   End;
  794.  
  795.  
  796. Function TFile.StringFound: Boolean;
  797.   Begin
  798.   StringFound := TF^.StringFound;
  799.   End;
  800.  
  801.  
  802. Function  shOpenFile(Var F: File; PathName: String): Boolean;
  803.   Begin
  804.   Assign(f,pathname);
  805.   FileMode := fmReadWrite + fmDenyNone;
  806.   shOpenFile := shReset(f,1);
  807.   End;
  808.  
  809.  
  810. Function  shMakeFile(Var F: File; PathName: String): Boolean;
  811.   Begin
  812.   Assign(f,pathname);
  813.   ReWrite(f,1);
  814.   shMakeFile := (IOresult = 0);
  815.   END;
  816.  
  817.  
  818. Procedure shCloseFile(Var F: File);
  819.   Begin
  820.   Close(F);
  821.   If (IOresult <> 0) Then;
  822.   End;
  823.  
  824.  
  825. Function  shSeekFile(Var F: File; FPos: LongInt): Boolean;
  826.   Begin
  827.   Seek(F,FPos);
  828.   shSeekFile := (IOresult = 0);
  829.   End;
  830.  
  831.  
  832. Function  shFindFile(Pathname: String; Var Name: String; Var Size, Time: LongInt): Boolean;
  833.   Var
  834.     {$IFDEF WINDOWS}
  835.       SR: TSearchRec;
  836.       PStr: Array[0..128] of Char;
  837.     {$ELSE}
  838.       SR: SearchRec;
  839.    {$ENDIF}
  840.  
  841.   Begin
  842.   {$IFDEF WINDOWS}
  843.   StrPCopy(PStr, PathName);
  844.   FindFirst(PStr, faArchive, SR);
  845.   {$ELSE}
  846.   FindFirst(PathName, Archive, SR);
  847.   {$ENDIF}
  848.   If (Dos.DosError = 0) Then
  849.     Begin
  850.     shFindFile := True;
  851.     {$IFDEF WINDOWS}
  852.     Name := StrPas(SR.Name);
  853.     {$ELSE}
  854.     Name := Sr.Name;
  855.     {$ENDIF}
  856.     Size := Sr.Size;
  857.     Time := Sr.Time;
  858.     End
  859.   Else
  860.     Begin
  861.     shFindFile := False;
  862.     End;
  863.   End;
  864.  
  865.  
  866. Procedure shSetFTime(Var F: File; Time: LongInt);
  867.   Begin
  868.   SetFTime(F, Time);
  869.   If (IOresult <> 0) Then;
  870.   End;
  871.  
  872.  
  873.  
  874. Function IsDevice(FilePath: String): Boolean;
  875.   Var
  876.     F: File;
  877.     Handle: Word Absolute F;
  878.     Tmp: Word;
  879.  
  880.   Begin
  881.   {$I-}
  882.   Assign(F, FilePath);
  883.   Reset(F);
  884.   If IoResult <> 0 Then
  885.     IsDevice := False
  886.   Else
  887.   Close(F);
  888.   If IoResult <> 0 Then;
  889.   {$I+}
  890.   End;
  891.  
  892.  
  893. Function LoadFile(FN: String; Var Rec; FS: Word): Word;
  894.   Begin
  895.   LoadFile := LoadFilePos(FN, Rec, FS, 0);
  896.   End;
  897.  
  898.  
  899. Function LoadFilePos(FN: String; Var Rec; FS: Word; FPos: LongInt): Word;
  900.   Var
  901.     F: File;
  902.     Error: Word;
  903.     NumRead: Word;
  904.  
  905.   Begin
  906.   Error := 0;
  907.   If Not FileExist(FN) Then
  908.     Error := 8888;
  909.   If Error = 0 Then
  910.     Begin
  911.     If Not shAssign(F, FN) Then
  912.       Error := MKFileError;
  913.     End;
  914.   FileMode := fmReadOnly + fmDenyNone;
  915.   If Not shReset(F,1) Then
  916.     Error := MKFileError;
  917.   If Error = 0 Then
  918.     Begin
  919.     Seek(F, FPos);
  920.     Error := IoResult;
  921.     End;
  922.   If Error = 0 Then
  923.     If Not shRead(F, Rec, FS, NumRead) Then
  924.       Error := MKFileError;
  925.   If Error = 0 Then
  926.     Begin
  927.     Close(F);
  928.     Error := IoResult;
  929.     End;
  930.   LoadFilePos := Error;
  931.   End;
  932.  
  933.  
  934. Function SaveFile(FN: String; Var Rec; FS: Word): Word;
  935.    Begin
  936.    SaveFile := SaveFilePos(FN, Rec, FS, 0);
  937.    End;
  938.  
  939.  
  940.  
  941. Function SaveFilePos(FN: String; Var Rec; FS: Word; FPos: LongInt): Word;
  942.   Var
  943.     F: File;
  944.     Error: Word;
  945.  
  946.   Begin
  947.   Error := 0;
  948.   If Not shAssign(F, FN) Then
  949.     Error := MKFileError;
  950.   FileMode := fmReadWrite + fmDenyNone;
  951.   If FileExist(FN) Then
  952.     Begin
  953.     If Not shReset(F,1) Then
  954.       Error := MKFileError;
  955.     End
  956.   Else
  957.     Begin
  958.     ReWrite(F,1);
  959.     Error := IoResult;
  960.     End;
  961.   If Error = 0 Then
  962.     Begin
  963.     Seek(F, FPos);
  964.     Error := IoResult;
  965.     End;
  966.   If Error = 0 Then
  967.     If FS > 0 Then
  968.       Begin
  969.       If Not shWrite(F, Rec, FS) Then
  970.         Error := MKFileError;
  971.       End;
  972.   If Error = 0 Then
  973.     Begin
  974.     Close(F);
  975.     Error := IoResult;
  976.     End;
  977.   SaveFilePos := Error;
  978.   End;
  979.  
  980.  
  981. Function ExtendFile(FN: String; ToSize: LongInt): Word;
  982. {Pads file with nulls to specified size}
  983.   Type
  984.     FillType = Array[1..8000] of Byte;
  985.  
  986.   Var
  987.     F: File;
  988.     Error: Word;
  989.     FillRec: ^FillType;
  990.  
  991.   Begin
  992.   Error := 0;
  993.   New(FillRec);
  994.   If FillRec = Nil Then
  995.     Error := 10;
  996.   If Error = 0 Then
  997.     Begin
  998.     FillChar(FillRec^, SizeOf(FillRec^), 0);
  999.     If Not shAssign(F, FN) Then
  1000.     Error := MKFileError;
  1001.     FileMode := fmReadWrite + fmDenyNone;
  1002.     If FileExist(FN) Then
  1003.       Begin
  1004.       If Not shReset(F,1) Then
  1005.         Error := MKFileError;
  1006.       End
  1007.     Else
  1008.       Begin
  1009.       ReWrite(F,1);
  1010.       Error := IoResult;
  1011.       End;
  1012.     End;
  1013.   If Error = 0 Then
  1014.     Begin
  1015.     Seek(F, FileSize(F));
  1016.     Error := IoResult;
  1017.     End;
  1018.   If Error = 0 Then
  1019.     Begin
  1020.     While ((FileSize(F) < (ToSize - SizeOf(FillRec^))) and (Error = 0)) Do
  1021.       Begin
  1022.       If Not shWrite(F, FillRec^, SizeOf(FillRec^)) Then
  1023.         Error := MKFileError;
  1024.       End;
  1025.     End;
  1026.   If ((Error = 0) and (FileSize(F) < ToSize)) Then
  1027.     Begin
  1028.     If Not shWrite(F, FillRec^, ToSize - FileSize(F)) Then
  1029.       Error := MKFileError;
  1030.     End;
  1031.   If Error = 0 Then
  1032.     Begin
  1033.     Close(F);
  1034.     Error := IoResult;
  1035.     End;
  1036.   Dispose(FillRec);
  1037.   ExtendFile := Error;
  1038.   End;
  1039.  
  1040.  
  1041. { This routine was replaced with one of my own creation to create a unique
  1042.   temp file name. PS 9/97 }
  1043.  
  1044. Function  GetTempName(FN: String): String;
  1045.   Var
  1046.     TmpStr, tname: String;
  1047.     y, m, d, dw, h, mx, s, hu : Word;
  1048.     l, dy : LongInt;
  1049.  
  1050.   Begin
  1051.   If ((Length(FN) > 0) and (FN[Length(FN)] <> '\')) Then
  1052.     TmpStr := FN + '\'
  1053.   Else
  1054.     TmpStr := FN;
  1055.    GetDate(y, mx, d, dw);
  1056.    d := 1;
  1057.    GetTime(h, m, s, hu);
  1058.    l := s + (m * 60);
  1059.    dy := h;
  1060.    l := l + (dy * 3600);
  1061.    dy := d;
  1062.    l := l + ((dy mod 10) * 86400);
  1063.    l := (l * 100) + hu;
  1064.    Str(l,tname);
  1065.    While Length(tname) < 8 Do tname := '0' + tname;
  1066.     GetTempName := TmpStr + tname;
  1067.   End;
  1068.  
  1069. { This routine was removed for the port to OS/2. PS 9/97}
  1070.  
  1071. {Function  GetTextPos(Var F: Text): LongInt;
  1072.   Type WordRec = Record
  1073.     LongLo: Word;
  1074.     LongHi: Word;
  1075.     End;
  1076.  
  1077.   Var
  1078.    Tmp: LongInt;
  1079.    Handle: Word;
  1080.  
  1081.   Begin
  1082.   Handle := TR.Handle;
  1083.   Regs.ah := $42;
  1084.   Regs.al := $01;
  1085.   Regs.bx := Handle;
  1086.   Regs.cx := 0;
  1087.   Regs.dx := 0;
  1088.   MsDos(Regs);
  1089.   If (Regs.Flags and 1) <> 0 Then
  1090.     Begin
  1091.     Regs.ax := $ffff;
  1092.     Regs.dx := $ffff;
  1093.     End;
  1094.   WordRec(Tmp).LongLo := Regs.Ax;
  1095.   WordRec(Tmp).LongHi := Regs.Dx;
  1096.   If Tmp >= 0 Then
  1097.     Inc(Tmp, TR.BufPos);
  1098.   GetTextPos := Tmp;
  1099.   End;}
  1100.  
  1101.  
  1102. Function FindOnPath(FN: String; Var OutName: String): Boolean;
  1103.   Var
  1104.     TmpStr: String;
  1105.  
  1106.   Begin
  1107.   If FileExist(FN) Then
  1108.     Begin
  1109.     OutName := FExpand(FN);
  1110.     FindOnPath := True;
  1111.     End
  1112.   Else
  1113.     Begin
  1114.     TmpStr := FSearch(FN, GetEnv('Path'));
  1115.     If FileExist(TmpStr) Then
  1116.       Begin
  1117.       OutName := TmpStr;
  1118.       FindOnPath := True;
  1119.       End
  1120.     Else
  1121.       Begin
  1122.       OutName := FN;
  1123.       FindOnPath := False;
  1124.       End;
  1125.     End;
  1126.   End;
  1127.  
  1128.  
  1129. Function  CopyFile(FN1: String; FN2: String): Boolean;
  1130.   Type
  1131.     TmpBufType = Array[1..8192] of Byte;
  1132.  
  1133.   Var
  1134.     F1: File;
  1135.     F2: File;
  1136.     NumRead: Word;
  1137.     Buf: ^TmpBufType;
  1138.     Error: Word;
  1139.  
  1140.   Begin
  1141.   New(Buf);
  1142.   Error := 0;
  1143.   Assign(F1, FN1);
  1144.   FileMode := fmReadOnly + fmDenyNone;
  1145.   Reset(F1, 1);
  1146.   Error := IoResult;
  1147.   If Error = 0 Then
  1148.     Begin
  1149.     Assign(F2, FN2);
  1150.     FileMode := fmReadWrite + fmDenyNone;
  1151.     ReWrite(F2, 1);
  1152.     Error := IoResult;
  1153.     End;
  1154.   If Error = 0 Then
  1155.     Begin
  1156.     BlockRead(F1, Buf^, SizeOf(Buf^), NumRead);
  1157.     Error := IoResult;
  1158.     While ((NumRead <> 0) and (Error = 0)) Do
  1159.       Begin
  1160.       BlockWrite(F2, Buf^, NumRead);
  1161.       Error := IoResult;
  1162.       If Error = 0 Then
  1163.         Begin
  1164.         BlockRead(F1, Buf^, SizeOf(Buf^), NumRead);
  1165.         Error := IoResult;
  1166.         End;
  1167.       End;
  1168.     End;
  1169.   If Error = 0 Then
  1170.     Begin
  1171.     Close(F1);
  1172.     Error := IoResult;
  1173.     End;
  1174.   If Error = 0 Then
  1175.     Begin
  1176.     Close(F2);
  1177.     Error := IoResult;
  1178.     End;
  1179.   Dispose(Buf);
  1180.   CopyFile := (Error = 0);
  1181.   End;
  1182.  
  1183.  
  1184. Function  EraseFile(FN: String): Boolean;
  1185.   Var
  1186.     F: File;
  1187.  
  1188.   Begin
  1189.   Assign(F, FN);
  1190.   Erase(F);
  1191.   EraseFile := (IoResult = 0);
  1192.   End;
  1193.  
  1194.  
  1195. Function  MakePath(FP: String): Boolean;
  1196.   Var
  1197.     i: Word;
  1198.  
  1199.   Begin
  1200.   If FP[Length(FP)] <> '\' Then
  1201.     FP := FP + '\';
  1202.   If Not FileExist(FP + 'Nul') Then
  1203.     Begin
  1204.     i := 2;
  1205.     While (i <= Length(FP)) Do
  1206.       Begin
  1207.       If FP[i] = '\' Then
  1208.         Begin
  1209.         If FP[i-1] <> ':' Then
  1210.           Begin
  1211.           MkDir(Copy(FP, 1, i - 1));
  1212.           If IoResult <> 0 Then;
  1213.           End;
  1214.         End;
  1215.       Inc(i);
  1216.       End;
  1217.     End;
  1218.   MakePath := FileExist(FP + 'Nul');
  1219.   End;
  1220.  
  1221.  
  1222. End.
  1223.