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