{  (c) Copyright 1999,2000 Bernhard R. Link (2:2476/841.64;brl@gmx.de)
Parts based on:
     MkFiles - Copyright 1993 by Mark May - MK Software
Changes (c) 2001 by Oliver Kopp (2:2471/1464;olly98@users.sourceforge.net)
****************************************************************************
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.

This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
****************************************************************************}
Unit UFiles;
{$I platform.inc}
{$I mkglobal.inc}
{$I-}

{Es fehlt noch einiges was nicht von MKMsgSqu gebraucht wird}

{
     MkFiles - Copyright 1993 by Mark May - MK Software
     Mythical Kingom Tech BBS (513)237-7737 HST/v32
     FidoNet: 1:110/290
     Rime: ->MYTHKING
     You may also reach me at maym@dmapub.dma.org

     Mark gave permission for distributing LGPL.
}


Interface

Uses
{$IFDEF PPC_VIRTUAL}
  use32,Dos,
  {$DEFINE PureDos} {Virtual seems to be better in emulating dos than supporting directly}
  {$IFDEF OS_OS2}
    os2base,
  {$ENDIF}
  {$IFDEF OS_Windows}
    windows,
  {$ENDIF}
  VpSysLow,
{$ELSE PPC_VIRTUAL}
  {$IFDEF OS_WINDOWS}
    {$IFNDEF PPC_DELPHI}
      WinDos,
      {$DEFINE WWOD} {Windows without Delphi, da Delphi machmal Pascal hnlicher}
     {$ELSE}
      SysUtils,
    {$ENDIF}
   {$ELSE OS_WINDOWS}
    {$IFDEF OS_LINUX}
      linux,
     {$ELSE}
      {$IFDEF OS_Dos}
        Dos,
        {$DEFINE PureDos}
       {$ELSE}
        {$IFDEF OS_OS2}
          {$STOP later...}
         {$ELSE}
          {$STOP Unknown OS!}
        {$ENDIF}
      {$ENDIF}
    {$ENDIF}
  {$ENDIF else OS_Windows}
{$ENDIF PPC_VIRTUAL}
aTypes,aString;

Const
  fmReadOnly = 0;          {FileMode constants}
  fmWriteOnly = 1;
  fmReadWrite = 2;
  fmDenyAll = 16;
  fmDenyWrite = 32;
  fmDenyRead = 48;
  fmDenyNone = 64;
  fmNoInherit = 128;

Const
  Tries: Word = 150;
  TryDelay: Word = 100;

{$IFDEF PureDos}
Type
  PathStr=Dos.PathStr;
  DirStr=Dos.DirStr;
  NameStr=Dos.NameStr;
  ExtStr=Dos.ExtStr;
{$ELSE}
{$IFDEF OS_WINDOWS}
{$IFNDEF Longstrings}
Type
  PathStr = String[128];
  DirStr = String[128];
  NameStr = String[13];
  ExtStr = String[4];
{$ELSE Longstrings}
Type
  PathStr = AnsiString;
  DirStr = AnsiString;
  NameStr = AnsiString;
  ExtStr = AnsiString;
{$ENDIF}
{$Else OS_WINDOWS}
{$IFDEF OS_LINUX}
Type
  PathStr=Linux.PathStr;
  DirStr=Linux.DirStr;
  NameStr=Linux.NameStr;
  ExtStr=Linux.ExtStr;
{$ELSE}
{$STOP Unknown OS}
{$ENDIF Linux}
{$ENDIF Windows}
{$ENDIF PureDos}

{$IFNDEF OS_Linux}
{$Define SupportLocking}
{$ENDIF}

Var
  UFilesError: Word;

Function  FileExist(FName: TString): Boolean;
Function  SizeFile(FName: TString): TFileOfs;
Function  DateFile(FName: TString): LongInt;
{$IFDEF SupportLocking}
Function  LongLo(InNum: LongInt): Word;
Function  LongHi(InNum: LongInt): Word;
Function  LockFile(Var F:File; LockStart: TFileOfs; LockLength: TFileOfs): Word;
{$ENDIF}
Function  UnLockFile(Var F:File; LockStart,LockLength: TFileOfs): Word;
Function  shAssign(Var F: File; FName: TString): Boolean;
Function  shLock(Var F:File; LockStart,LockLength: TFileOfs): Word;
Function  shReset(Var F: File; RecSize: Word): Boolean;
Function  shRead(Var F: File; Var Rec; ReadSize: Word; Var NumRead: Word): Boolean;
Function  shWrite(Var F: File; Var Rec; ReadSize: Word): Boolean;
Function  shReadEx(Var F: File; pos:TFileOfs; Var Rec; ReadSize: Word; Var NumRead: Word): Boolean;
Function  shWriteEx(Var F: File; pos:TFileOfs; Var Rec; WriteSize: Word): Boolean;
Function  shWriteZeroEx(Var F: File; pos:TFileOfs; WriteSize: Word): Boolean;
 {$IFNDEF PPC_DELPHI}
 Function  GetEnv(const Str:OpenString):TString;
 Function  FSearch(const Path:OpenString;const DirList:OpenString): TString;
 {$ENDIF}
Function  FExpand(const Str:OpenString): TString;
Procedure FSplit(const Path:OpenString;Var Dir:DirStr;Var Name:NameStr;Var Ext:ExtStr);
Function  LoadFilePos(FN: TString; Var Rec; FS: Word; FPos: TFileOfs): Word;
Function  LoadFile(FN: TString; Var Rec; FS: Word): Word;
Function  SaveFilePos(FN: TString; Var Rec; FS: Word; FPos: TFileOfs): Word;
Function  SaveFile(FN: TString; Var Rec; FS: Word): Word;
Function  ExtendFile(FN: TString; ToSize: TFileOfs): Word;
Function  MakePath(FP: OpenString): Boolean;

{Aus MKString:}
Procedure AddBackSlash(Var InPath: OpenString);
Function WithBackSlash(InPath: OpenString): TString;
{neu:}
Procedure DeleteBackSlash(Var InPath:OpenString);
Function NoExt(const s:Openstring):TString;
Function StripExt(const s:Openstring;ext:ExtStr):TString;
Function CreateDir(const FilePath:OpenString):Boolean;
Function NoPath(const s:OpenString):TString;

{01/04/01 OK added 1:1 from history/ag_ok/mkfiles.pas}
Procedure FlushFile(Var F); {Dupe file handle, close dupe handle}
Function  shSeekFile(Var F: File; FPos: LongInt): Boolean;
Function  GetTempName(FN: String): String;
Function  EraseFile(Const FN: String): Boolean;

Const
  {$IFDEF OS_LINUX}
  DirSeperator='/';
  {$ELSE}
  {$IFDEF OS_AMIGA}
  DirSeperator='/';
  {$ELSE}
  DirSeperator='\';
  {$ENDIF}
  {$ENDIF}
  {$IFDEF OS_LINUX}
  FileListSeperator=':';
  {$ELSE}
  FileListSeperator=';';
  {$ENDIF}

Implementation

Uses
{$IFDEF WWOD}
 Strings,
{$ENDIF}
 UString,UDelay{$IFDEF DirDebug},Errors{$ENDIF};

{$I-}

{$IFNDEF PPC_DELPHI}
Function GetEnv(const Str:OpenString):TString;
{$IFDEF PureDos}
begin
GetEnv:=Dos.GetEnv(Str);
end;
{$ELSE}
{$IFDEF OS_WINDOWS}
  Var
    NStr: Array[0..255] of Char;
    PStr: PChar;

  Begin
  StrPCopy(NStr, Str);
  PStr := GetEnvVar(NStr);
  If PStr = nil Then
    GetEnv := ''
  Else
    GetEnv := StrPas(PStr);
  End;
{$ELSE}
{$IFDEF OS_LINUX}
Var PStr: PChar;
begin
PStr := Linux.GetEnv(Str);
If PStr = nil Then
  GetEnv := ''
 else
  GetEnv := StrPas(PStr);
end;
{$ELSE}
{$STOP Unknown OS!}
{$ENDIF}
{$ENDIF}
{$ENDIF}
{$ENDIF}

Function FExpand(const Str: OpenString): TString;
{$IFNDEF PureDos}
{$IFDEF OS_WINDOWS}
{$IFNDEF PPC_DELPHI}
  Var
    IStr: Array[0..128] of Char;
    OStr: Array[0..128] of Char;

  Begin
  StrPCopy(IStr, Str);
  FileExpand(OStr, IStr);
  FExpand := StrPas(OStr);
  End;
{$ELSE}
  begin
  FExpand:=ExpandFileName(Str);
  end;
{$ENDIF}
{$ELSE}
Begin
FExpand:={$IFDEF OS_LINUX}Linux.{$ENDIF}FExpand(Str)
end;
{$ENDIF}
{$ELSE}
Begin
FExpand:=Dos.FExpand(Str)
end;
{$ENDIF}

Procedure FSplit(const Path:OpenString;Var Dir:DirStr;Var Name:NameStr;Var Ext:ExtStr);
{$IFNDEF PureDos}
{$IFDEF OS_WINDOWS}
{$IFNDEF PPC_DELPHI}
  Var
    FPath: Array[0..129] of Char;
    TD: Array[0..129] of Char;
    TN: Array[0..14] of Char;
    TE: Array[0..5] of Char;

  Begin
  StrPCopy(FPath, Path);
  FileSplit(FPath, TD, TN, TE);
  Dir := StrPas(TD);
  Name := StrPas(TN);
  Ext := StrPas(TE);
  End;
{$ELSE}
  Begin
  Dir := ExtractFilePath(Path);
  Name := ExtractFileName(Path);
  Ext := ExtractFileExt(Path);
  End;
{$ENDIF}
{$ELSE}
var d:DirStr;n:NameStr;e:ExtStr;
begin
{$IFDEF OS_LINUX}Linux.{$ENDIF}FSplit(Path,D,N,E);
Dir:=d;Name:=n;Ext:=e;
end;
{$ENDIF}
{$ELSE}
var d:DirStr;n:NameStr;e:ExtStr;
begin
Dos.FSplit(Path,D,N,E);
Dir:=d;Name:=n;Ext:=e;
end;
{$ENDIF}

Function  FSearch(const Path:OpenString;const DirList:OpenString): TString;
{$IFNDEF PureDos}
{$IFDEF OS_WINDOWS}
{$IFNDEF PPC_DELPHI}
  Var
    FPath: Array[0..129] of Char;
    DL: Array[0..129] of Char;
    RS: Array[0..129] of Char;

  Begin
  StrPCopy(Fpath, Path);
  StrPCopy(DL, DirList);
  FileSearch(RS, FPath, DL);
  FSearch := StrPas(RS);
  End;
{$ELSE}
begin
FSearch:=SysUtils.FileSearch(Path,DirList);
end;
{$ENDIF}
{$ELSE}
begin
FSearch:={$IFDEF OS_LINUX}Linux.{$ENDIF}FSearch(Path,DirList);
end;
{$ENDIF}
{$ELSE}
begin
FSearch:=Dos.FSearch(Path,DirList);
end;
{$ENDIF}

Function shAssign(Var F: File; FName: TString): Boolean;
  Begin
  Assign(F, FName);
  UFilesError := IoResult;
  shAssign := (UFilesError = 0);
  End;

Function shRead(Var F: File; Var Rec; ReadSize: Word; Var NumRead: Word): Boolean;
  Var
    Count: Word;
    Code: Word;
    {$IFDEF PPC_Delphi2}
    t:Integer;
    {$ENDIF}
  Begin
  Count := Tries;
  Code := 5;
  While ((Count > 0) and (Code = 5)) Do
    Begin
    {$IFDEF PPC_Delphi2}
    t:=NumRead;
    BlockRead(F,Rec,ReadSize,t);
    {$ELSE}
    BlockRead(F,Rec,ReadSize,NumRead);
    {$ENDIF}
    Code := IoResult; if Code<>0 then Delay(TryDelay);
    Dec(Count);
    End;
  UFilesError := Code;
  ShRead := (Code = 0);
  End;


Function shWrite(Var F: File; Var Rec; ReadSize: Word): Boolean;
  Var
    Count: Word;
    Code: Word;

  Begin
  Count := Tries;
  Code := 5;
  While ((Count > 0) and (Code = 5)) Do
    Begin
    BlockWrite(F,Rec,ReadSize);
    Code := IoResult; if Code<>0 then Delay(TryDelay);
    Dec(Count);
    End;
  UFilesError := Code;
  shWrite := (Code = 0);
  End;

Function shReadEx(Var F:File;pos:TFileOfs;Var Rec; ReadSize: Word;
                  Var NumRead: Word): Boolean;
  Var
    Count: Word;
    Code: Word;
    {$IFDEF PPC_Delphi2}
    t:Integer;
    {$ENDIF}
  Begin
  Seek(F,pos);
  Code:=IOResult;
  If code=0 then
    begin
    Count := Tries;
    Code := 5;
    While ((Count > 0) and (Code = 5)) Do
      Begin
      {$IFDEF PPC_Delphi2}
      t:=NumRead;
      BlockRead(F,Rec,ReadSize,t);
      {$ELSE}
      BlockRead(F,Rec,ReadSize,NumRead);
      {$ENDIF}
      Code := IoResult; if Code<>0 then Delay(TryDelay);
      Dec(Count);
      End;
    end;
  UFilesError := Code;
  ShReadEx := (Code = 0);
  End;

Function  shWriteZeroEx(Var F: File; pos:TFileOfs; WriteSize: Word): Boolean;
  Var
    Count: Word;
    Code: Word;
    p:Pointer;

  Begin
  shWriteZeroEx:=false;
  getmem(p,pos);
  If p=nil then
    exit;
  FillChar(p^,WriteSize,0);
  seek(f,pos);
  code:=IOResult;
  If code=0 then
    begin
    Count := Tries;
    Code := 5;
    While ((Count > 0) and (Code = 5)) Do
      Begin
      BlockWrite(F,p^,WriteSize);
      Code := IoResult; if Code<>0 then Delay(TryDelay);
      Dec(Count);
      End;
    end;
  UFilesError := Code;
  shWriteZeroEx := (Code = 0);
  End;


Function  shWriteEx(Var F: File; pos:TFileOfs; Var Rec; WriteSize: Word): Boolean;
  Var
    Count: Word;
    Code: Word;

  Begin
  seek(f,pos);
  code:=IOResult;
  If code=0 then
    begin
    Count := Tries;
    Code := 5;
    While ((Count > 0) and (Code = 5)) Do
      Begin
      BlockWrite(F,Rec,WriteSize);
      Code := IoResult; if Code<>0 then Delay(TryDelay);
      Dec(Count);
      End;
    end;
  UFilesError := Code;
  shWriteEx := (Code = 0);
  End;


Function shLock(Var F:File; LockStart,LockLength: TFileOfs): Word;
  {$IFNDEF SupportLocking}
  Begin
  shLock:=0;
  {$ELSE}
  Var
    Count: Word;
    Code: Word;

  Begin
  Count := Tries;
  Code := $21;
  While ((Count > 0) and (Code = $21)) Do
    Begin
    Code := LockFile(F,LockStart,LockLength);
    Dec(Count);
    If Code = $21 Then
      Delay(TryDelay);
    End;
  If Code = 1 Then
    Code := 0;
  shLock := Code;
  {$ENDIF SupportLocking}
  End;



Function shReset(Var F: File; RecSize: Word): Boolean;
  Var
    Count: Word;
    Code: Word;

  Begin
  Count := Tries;
  Code := 5;
  While ((Count > 0) and (Code = 5)) Do
    Begin
    Reset(F,RecSize);
    Code := IoResult; if Code<>0 then Delay(TryDelay);
    Dec(Count);
    End;
  UFilesError := Code;
  ShReset := (Code = 0);
  End;


{$IFDef SupportLocking}
Function LockFile(Var F:File; LockStart, LockLength: TFileOfs): Word;
{$IFDEF PPC_VIRTUAL}
 {$ifdef os_os2}
  var
    lock,
    unlock : FileLock;
  begin
  with lock do
    begin
    lOffset := LockStart;
    lRange := LockLength;
    end;
  fillchar(unlock,sizeof(FileLock),0);
  LockFile := DosSetFileLocks(FileRec(F).Handle, unlock, lock, 1000, 0);
  end;
 {$else os_os2}
   {$ifdef os_Windows}
    begin
    LockFile := Word(Windows.LockFile(FileRec(f).handle,LockStart,0,LockLength,0));
    end;
    {$endif os_Windows}
 {$endif os_os2}
{$ELSE} {not PPC_Virtual:}
{$IFNDEF PPC_Delphi2}
  Var
    Tmp: Word;
    StrtHi: Word;
    StrtLo: Word;
    LgHi: Word;
    LgLo: Word;
  {$IFNDEF BASMINT}
    {$IFDEF OS_WINDOWS}
    Regs: TRegisters;
    {$ELSE}
    Regs: Registers;
    {$ENDIF OS_WINDOWS}
  {$ENDIF BASMINT}

  Begin
  Tmp := FileRec(f).Handle;
  StrtHi := LongHi(LockStart);
  StrtLo := LongLo(LockStart);
  LgHi := LongHi(LockLength);
  LgLo := LongLo(LockLength);
  {$IFDEF BASMINT}
  Asm
    Mov ah, $5c;
    Mov al, $00;
    Mov bx, Tmp;
    Mov cx, StrtHi;
    Mov dx, StrtLo;
    Mov si, LgHi;                 {00h = success           }
    Mov di, LgLo;                 {01h = share not loaded  }
    Int $21;                      {06h = invalid handle    }
    Jc @JLock                     {21h = lock violation    }
    Mov ax, $00;                  {24h = share buffer full }
    @JLock:
    Mov Tmp, ax;
    End;
  {$ELSE}{not BASMINT}
  Regs.ah := $5c;
  Regs.al := $00;
  Regs.bx := Tmp;
  Regs.cx := StrtHi;
  Regs.dx := StrtLo;
  Regs.si := LgHi;
  Regs.di := LgLo;
  MsDos(Regs);
  If (Regs.Flags and 1) = 0 Then
    Begin
    Regs.ax := 0;
    End;
  Tmp := Regs.ax;
  {$ENDIF BASMINT}
  If Tmp = 1 Then
    Tmp := 0;
  LockFile := Tmp;
  {$ELSE}{not PPC_DELPHI2:}
  Begin
  {$ENDIF PPC_DELPHI2}
  LockFile:=0;
  End;
{$ENDIF PPC_VIRTUAL}

Function UnLockFile(Var F:File; LockStart,LockLength: TFileOfs): Word;
{$IFDEF ppc_VIRTUAL}
 {$ifdef os_os2}
  var
    lock,
    unlock : FileLock;
  begin
  with unlock do
    begin
    lOffset := LockStart;
    lRange := LockLength;
    end;
  fillchar(lock,sizeof(FileLock),0);
  UnLockFile := DosSetFileLocks(FileRec(F).Handle, unlock, lock, 1000, 0);
  end;
 {$else os_os2}
   {$ifdef os_Windows}
   begin
   UnLockFile := Word(Windows.UnLockFile(FileRec(f).handle,LockStart,0,LockLength,0));
   end;
   {$else os_Windows}
   begin
     {linux: nothing found}
   end;
   {$endif OS_Windows}
 {$endif os_os2}
{$ELSE ppc_VIRTUAL}
{$IFNDEF PPC_Delphi2}
  Var
    {Handle: Word Absolute F;}
    Tmp: Word;
    StrtHi: Word;
    StrtLo: Word;
    LgHi: Word;
    LgLo: Word;
  {$IFNDEF BASMINT}
    {$IFDEF OS_WINDOWS}
    Regs: TRegisters;
    {$ELSE}
    Regs: Registers;
    {$ENDIF}
  {$ENDIF}

  Begin
  Tmp := FileRec(f).Handle;
  StrtHi := LongHi(LockStart);
  StrtLo := LongLo(LockStart);
  LgHi := LongHi(LockLength);
  LgLo := LongLo(LockLength);
  {$IFDEF BASMINT}
  Asm
    Mov ah, $5c;
    Mov al, $01;
    Mov bx, Tmp;
    Mov cx, StrtHi;
    Mov dx, StrtLo;
    Mov si, LgHi;                 {00h = success           }
    Mov di, LgLo;                 {01h = share not loaded  }
    Int $21;                      {06h = invalid handle    }
    Jc @JLock                     {21h = lock violation    }
    Mov ax, $00;                  {24h = share buffer full }
    @JLock:
    Mov Tmp, ax;
    End;
  {$ELSE BASMINT}
  Regs.ah := $5c;
  Regs.al := $01;
  Regs.bx := Tmp;
  Regs.cx := StrtHi;
  Regs.dx := StrtLo;
  Regs.si := LgHi;
  Regs.di := LgLo;
  MsDos(Regs);
  If (Regs.Flags and 1) = 0 Then
    Begin
    Regs.ax := 0;
    End;
  Tmp := Regs.ax;
  {$ENDIF BASMINT}
  If Tmp = 1 Then
    Tmp := 0;
  UnLockFile := Tmp;
  {$ELSE BASMINT}
  Begin
  {$ENDIF BASMINT}
  UnLockFile:=0;
  End;
{$ENDIF SupportLocking}

Function LongLo(InNum: Longint): Word;
  Begin
  LongLo := InNum and $FFFF;
  End;


Function LongHi(InNum: Longint): Word;
  Begin
  LongHi := InNum Shr 16;
  End;
{$ELSE}
Function UnLockFile(Var F:File; LockStart, LockLength: TFileOfs): Word;
begin
UnLockFile:=0;
end;
{$ENDIF}

Function SizeFile(FName: TString): TFileOfs;
  Var
    {$IFDEF PureDos}
    SR: SearchRec;
    {$ELSE}
    {$IFDEF OS_WINDOWS}
    SR: TSearchRec;
    TStr: Array[0..128] of Char;
    {$IFDEF PPC_DELPHI}
    DosError:Integer;
    {$EndIf}
    {$ELSE}
    {$IFDEF OS_LINUX}
    s:Stat;
    {$ELSE}
    SR: SearchRec;
    {$WARNING Where are we?}
    {$ENDIF}
    {$ENDIF}
    {$ENDIF}

  Begin
 {$IFNDEF PureDos}
  {$IFDEF OS_LINUX}
  If FStat(FName,s) then
    SizeFile:=s.size
   else
    SizeFile:=-1;
  {$ELSE}{ not OS_LINUX:}
   {$IFDEF OS_WINDOWS}
  StrPCopy(TStr, FName);
  {$IfDef PPC_DELPHI}DosError:={$ENDIF} FindFirst(TStr, faAnyFile, SR);
   {$ELSE OS_WINDOWS}
  FindFirst(FName, AnyFile, SR);
   {$ENDIF OS_WINDOWS}
  If DosError = 0 Then
    SizeFile := SR.Size
  Else
    SizeFile := -1;
  {$ENDIF not OS_LINUX}
 {$ELSE} {PureDos:}
  Dos.FindFirst(FName, AnyFile, SR);
  If Dos.DosError = 0 Then
    SizeFile := SR.Size
  Else
    SizeFile := -1;
 {$IFDEF PPC_VIRTUAL}
  Dos.FindClose(SR);
 {$ENDIF PPC_VIRTUAL}
 {$ENDIF PureDos}
 End;

Function  DateFile(FName: TString): LongInt;
  Var
    {$IFDEF PureDos}
    SR: SearchRec;
    {$ELSE}
    {$IFDEF OS_WINDOWS}
    SR: TSearchRec;
    {$IFDEF PPC_DELPHI}
    DosError:Integer;
    {$ELSE}
    TStr: Array[0..128] of Char;
    {$EndIf}
    {$ELSE}
    {$IFDEF OS_LINUX}
    s:Stat;y,m,d,h,min,sec:Word;
    {$ELSE}
    SR: SearchRec;
    {$ENDIF}
    {$ENDIF}
    {$ENDIF}

  Begin
 {$IFNDEF PureDos}
  {$IFDEF OS_LINUX}
  If fstat(FName,s) then
    begin
    EpochToLocal(s.mtime,y,m,d,h,min,sec);
    DateFile:=(sec div 2)+
              (m shl 5)+
              (h shl 11)+
              (cardinal(d) shl 16)+
              (cardinal(m) shl 21)+
              (cardinal(y-1980)shl 25)
    end
   else
    DateFile:=0;
 {$ELSE OS_LINUX}
  {$IFDEF OS_WINDOWS}
  {$IFNDef PPC_DELPHI}
  StrPCopy(TStr, FName);
  FindFirst(TStr, faAnyFile, SR);
  {$ELSE PPC_DELPHI}
  DosError:=FindFirst(FName, faAnyFile, SR);
  {$ENDIF PPC_DELPHI}
  {$ELSE OS_WINDOWS}
  FindFirst(FName, AnyFile, SR);
  {$ENDIF OS_WINDOWS}
  If DosError = 0 Then
    DateFile := SR.Time
  Else
    DateFile := 0;
 {$ENDIF OS_LINUX}
 {$ELSE}{PureDos:}
  Dos.FindFirst(FName, AnyFile, SR);
  If Dos.DosError = 0 Then
    DateFile := SR.Time
  Else
    DateFile := 0;
   {$IFDEF PPC_VIRTUAL}
  Dos.FindClose(SR);
   {$ENDIF}
 {$ENDIF PureDos}
 End;

Function FileExist(FName: TString): Boolean;
  Var
    {$IFDEF PureDos}
    SR: SearchRec;
    {$ELSE}
    {$IFDEF OS_WINDOWS}
    SR: TSearchRec;
    TStr: Array[0..128] of Char;
    {$IFDEF PPC_DELPHI}
    DosError:Integer;
    {$EndIf}
    {$ELSE}
    {$IFNDEF OS_LINUX}
    SR: SearchRec;
    {$ELSE}
    s:stat;
    {$ENDIF}
    {$ENDIF}
    {$ENDIF}

  Begin
 {$IFNDEF PureDos}
  {$IFDEF OS_LINUX}
  FileExist:=fstat(FName,s);
  {$ELSE}
  If IoResult <> 0 Then;
  {$IFDEF OS_WINDOWS}
  StrPCopy(TStr, FName);
  {$IFDef PPC_DELPHI}DosError:={$ENDIF}
  FindFirst(TStr, faReadOnly + faHidden + faArchive, SR);
  {$ELSE}
  FindFirst(FName, ReadOnly + Hidden + Archive, SR);
  {$ENDIF}
  FileExist := DosError = 0;
  If IoResult <> 0 Then;
  {$ENDIF}
 {$ELSE PureDos}
  Dos.FindFirst(FName, ReadOnly + Hidden + Archive, SR);
  FileExist := Dos.DosError = 0;
  If IoResult <> 0 Then;
   {$IFDEF PPC_VIRTUAL}
  Dos.FindClose(SR);
   {$ENDIF}
 {$ENDIF PureDos}
  End;

Function LoadFile(FN: TString; Var Rec; FS: Word): Word;
  Begin
  LoadFile := LoadFilePos(FN, Rec, FS, 0);
  End;

Function LoadFilePos(FN: TString; Var Rec; FS: Word; FPos: TFileOfs): Word;
  Var
    F: File;
    Error: Word;
    NumRead: Word;

  Begin
  Error := 0;
  If Not FileExist(FN) Then
    Error := 8888;
  If Error = 0 Then
    Begin
    If Not shAssign(F, FN) Then
      Error := UFilesError;
    End;
  FileMode := fmReadOnly + fmDenyNone;
  If Not shReset(F,1) Then
    Error := UFilesError;
  If Error = 0 Then
    Begin
    Seek(F, FPos);
    Error := IoResult;
    End;
  If Error = 0 Then
    If Not shRead(F, Rec, FS, NumRead) Then
      Error := UFilesError;
  If Error = 0 Then
    Begin
    Close(F);
    Error := IoResult;
    End;
  LoadFilePos := Error;
  End;


Function SaveFile(FN: TString; Var Rec; FS: Word): Word;
   Begin
   SaveFile := SaveFilePos(FN, Rec, FS, 0);
   End;



Function SaveFilePos(FN: TString; Var Rec; FS: Word; FPos: TFileOfs): Word;
  Var
    F: File;
    Error: Word;

  Begin
  Error := 0;
  If Not shAssign(F, FN) Then
    Error := UFilesError;
  FileMode := fmReadWrite + fmDenyNone;
  If FileExist(FN) Then
    Begin
    If Not shReset(f,1) Then
      Error := UFilesError;
    End
  Else
    Begin
    ReWrite(F,1);
    Error := IoResult;
    End;
  If Error = 0 Then
    Begin
    Seek(F, FPos);
    Error := IoResult;
    End;
  If Error = 0 Then
    If FS > 0 Then
      Begin
      If Not shWrite(F, Rec, FS) Then
        Error := UFilesError;
      End;
  If Error = 0 Then
    Begin
    Close(F);
    Error := IoResult;
    End;
  SaveFilePos := Error;
  End;


Function ExtendFile(FN: TString; ToSize: TFileOfs): Word;
{Pads file with nulls to specified size}
  Type
    FillType = Array[1..8192] of Byte;

  Var
    F: File;
    Error: Word;
    FillRec: ^FillType;

  Begin
  Error := 0;
  New(FillRec);
  If FillRec = Nil Then
    Error := 10;
  If Error = 0 Then
    Begin
    FillChar(FillRec^, SizeOf(FillRec^), 0);
    If Not shAssign(F, FN) Then
    Error := UFilesError;
    FileMode := fmReadWrite + fmDenyNone;
    If FileExist(FN) Then
      Begin
      If Not shReset(F,1) Then
        Error := UFilesError;
      End
    Else
      Begin
      ReWrite(F,1);
      Error := IoResult;
      End;
    End;
  If Error = 0 Then
    Begin
    Seek(F, FileSize(F));
    Error := IoResult;
    End;
  If Error = 0 Then
    Begin
    While ((FileSize(F) < (ToSize - SizeOf(FillRec^))) and (Error = 0)) Do
      Begin
      If Not shWrite(F, FillRec^, SizeOf(FillRec^)) Then
        Error := UFilesError;
      End;
    End;
  If ((Error = 0) and (FileSize(F) < ToSize)) Then
    Begin
    If Not shWrite(F, FillRec^, ToSize - FileSize(F)) Then
      Error := UFilesError;
    End;
  If Error = 0 Then
    Begin
    Close(F);
    Error := IoResult;
    End;
  Dispose(FillRec);
  ExtendFile := Error;
  End;

Function  MakePath(FP: OpenString): Boolean;

  Function DirExist(FName: TString): Boolean;
    Var
    {$IFDEF PureDos}
    SR: SearchRec;
    {$ELSE}
      {$IFDEF PPC_DELPHI}
      DosError:Integer;
      SR: TSearchRec;
      {$ELSE}
      {$IFDEF OS_WINDOWS}
      SR: TSearchRec;
      TStr: Array[0..128] of Char;
      {$ELSE}
      {$IFDEF OS_LINUX}
      s:stat;
      {$ELSE}
      SR: SearchRec;
      {$ENDIF}
      {$ENDIF}
      {$ENDIF}
     {$ENDIF}

    Begin
   {$IFNDEF PureDos}
    {$IFDEF OS_LINUX}
    DirExist:=fstat(FName,s) and (LinuxError=0)and S_ISDIR(s.mode);
    {$ELSE}
    If IoResult <> 0 Then;
    {$IFDef PPC_DELPHI}
    DosError:=
    FindFirst(FName, faDirectory+faReadOnly + faHidden + faArchive, SR);
    {$ELSE}
     {$IFDEF OS_WINDOWS}
     StrPCopy(TStr, FName);
     FindFirst(TStr, faDirectory+faReadOnly + faHidden + faArchive, SR);
     {$ELSE}
     FindFirst(FName, Directory+ReadOnly + Hidden + Archive, SR);
     {$ENDIF}
    {$ENDIF}
    DirExist := DosError=0;
    If IoResult <> 0 Then;
    {$ENDIF OS_LINUX}
   {$ELSE PureDos}
    Dos.FindFirst(FName, Directory+ReadOnly + Hidden + Archive, SR);
    DirExist := Dos.DosError=0;
    If IoResult <> 0 Then;
     {$IFDEF PPC_VIRTUAL}
    Dos.FindClose(SR);
     {$ENDIF}
   {$ENDIF PureDos}
    End;

{$IFDEF PPC_VIRTUAL}var a:AnsiString;{$ENDIF}
  Begin
  AddBackSlash(FP);
  If DirExist(FP+'.') then
    MakePath:=true
   else
    begin
    {$IFDEF DirDebug}
    LogStr('Nicht gefunden:'+FP+'.');
    {$ENDIF}
    DeleteBackSlash(FP);
    If(FP=''){$IFNDEF OS_LINUX}or(FP[length(FP)]=':'){$ENDIF} then
      MakePath:=True {Das Hauptverzeichnis existiert!!}
     else
      If Createdir(FP) then  {bergeordnetes Verzeichnis checken}
        begin
        {$IFDEF DirDebug}
        LogStr('Versuche zu erzeugen:'+FP);
        {$ENDIF}
        {$IFDEF VIRTUALPASCAL}
        a:=fp;
        MakePath:=SysDirCreate(PChar(a))=0; {????? TODO: <>0 oder =0?}
        {$ELSE}
        MkDir(FP);            {Und dann dieses erzeugen}
        MakePath:=IOResult=0; {Wenn erfolgreich, true zurckliefern}
        {$ENDIF}
        end
       else
        MakePath:=false;{Wenn wir nicht das bergeordnete erzeugen knnen,
        mssen wir es hier erst gar nicht versuchen.}
    end;
{  If Not FileExist(FP + 'NUL') Then     Paaah!
    Begin
    i := 2;
    While (i <= Length(FP)) Do
      Begin
      If FP[i] = DirSeperator Then
        Begin
        If FP[i-1] <> ':' Then
          Begin
          MkDir(Copy(FP, 1, i - 1));
          If IoResult <> 0 Then;
          End;
        End;
      Inc(i);
      End;
    End;
  MakePath := FileExist(FP + 'NUL');
  }
  End;

Procedure AddBackSlash(Var InPath: OpenString);
  Begin
  If Length(InPath) > 0 Then
    Begin
    If InPath[Length(InPath)] <> DirSeperator Then
      Begin
      InPath:=InPath+DirSeperator
      End;
    End;
  End;

Procedure DeleteBackSlash(Var InPath:OpenString);
  Begin
  If Length(InPath) > 0 Then
    Begin
    If InPath[Length(InPath)] = DirSeperator Then
      Begin
      Delete(InPath,Length(InPath),1);
      End;
    End;
  End;

Function WithBackSlash(InPath: OpenString): TString;
  Begin
  AddBackSlash(InPath);
  WithBackSlash := InPath;
  End;

Function NoExt(const s:OpenString):TString;
var d:DirStr;n:NameStr;e:ExtStr;
begin
FSplit(s,d,n,e);
NoExt:=d+n;
end;
Function StripExt(const s:Openstring;ext:ExtStr):TString;
begin
if upString(copy(s,length(s)-length(ext),length(ext)+1))='.'+upString(ext) then
    stripExt:=copy(s,1,length(s)-length(ext)-1)
   else
    stripExt:=s
end;
Function NoPath(const s:OpenString):TString;
var d:DirStr;n:NameStr;e:ExtStr;
begin
FSplit(s,d,n,e);
NoPath:=n+e
end;

Function CreateDir(const FilePath:OpenString):Boolean;
var d:DirStr;n:NameStr;e:ExtStr;
begin
FSplit(FilePath,d,n,e);
If d<>'' then
  CreateDir:=MakePath(d)
 else
  Createdir:=true;
end;

Procedure FlushFile(Var F); {Dupe file handle, close dupe handle}
{$IFDEF PPC_VIRTUAL}
  begin
  {$ifdef OS2}
    DosResetBuffer(FileRec(F).handle);
  {$endif}
  {$ifdef LINUX}
    {ist eigentlich eine Procedure aus VPSYSLOW, also msste es auch damit unter OS/2 und WIN gehen}
    SysFileFlushBuffers(FileRec(F).handle);
  {$endif linux}
  {$ifdef WINDOWS}
    FlushFileBuffers(FileRec(f).handle);
  {$endif windows}
  end;
{$ELSE}

{$IFDEF PPC_FPC}
begin
{not yet implemented}
end;
{$ELSE}
  Var
    Handle: Word Absolute F;
    {$IFDEF BASMINT}
      Tmp: Word;
    {$ELSE}
      {$IFDEF WINDOWS}
        Regs: TRegisters;
      {$ELSE}
        Regs: Registers;
      {$ENDIF}
    {$ENDIF}

  Begin
  {$IFDEF BASMINT}
  Tmp := Handle;
  Asm
    Mov ah, $45;
    Mov bx, Tmp;
    Int $21;
    Jc  @JFlush;
    Mov bx, ax;
    Mov ah, $3e;
    Int $21;
    @JFlush:
    End;
  {$ELSE}
  Regs.ah := $45;
  Regs.bx := Handle;
  MsDos(Regs);
  If (Regs.Flags and 1) = 0 Then   {carry}
    Begin
    Regs.bx := Regs.ax;
    Regs.Ah := $3e;
    MsDos(Regs);
    End;
  {$ENDIF}
  End;
{$ENDIF PPC_FPC}
{$ENDIF}


Function  shSeekFile(Var F: File; FPos: LongInt): Boolean;
  Begin
  Seek(F,FPos);
  shSeekFile := (IOresult = 0);
  End;

Function  GetTempName(FN: String): String;
{$IFNDEF PPC_BP}
  var
    Tmp : string;
    Nr : LongInt;
  begin
  If ((Length(FN) > 0) and (FN[Length(FN)] <> DirSeperator)) Then
    FN := FN + DirSeperator;
  Nr := 0;
  repeat
    Inc(Nr);
    Str(Nr, Tmp);
  until (Nr = 1000) or not (FileExist( FN + tmp ));
  if Nr <> 1000 then GetTempName := FN + Tmp else GetTempName := '';
  end;
{$ELSE}
  Var
    TOfs: Word;
    TSeg: Word;
    FH: Word;
    i: Word;

  Begin
  TSeg := Seg(FN[1]);
  TOfs := Ofs(FN[1]);
  If ((Length(FN) > 0) and (FN[Length(FN)] <> '\')) Then
    FN := FN + '\';
  For i := 1 to 16 Do
   FN[Length(FN) + i] := #0;
  i := 0;
  Asm
    Push ds;
    Mov ah, $5a;
    Mov ch, $00;
    Mov dx, TSeg;
    Mov ds, dx;
    Mov dx, TOfs;
    Mov cl, $00;
    Int $21;              {Create tmp file}
    Mov FH, ax;
    Mov ax, 1;
    jc @JErr
    Mov bx, FH;
    Mov ah, $3e;
    {jmp @J3; this was originally in my code, appears to be an error}
    Int $21;              {Close tmp file}
    @J3:
    Mov ax, 2;
    jc @JErr;
    Mov ah, $41
    Mov dx, TSeg;
    Mov ds, dx;
    Mov dx, TOfs;
    Int $21;              {Erase tmp file}
    Mov ax, 3;
    jc @JErr;
    jmp @JEnd
    @JErr:
    Mov i, ax;
    @JEnd:
    Pop ds;
    End;
  FN[0] := #255;
  FN[0] := Chr(Pos(#0, FN) - 1);
  If i = 0 Then
    GetTempName := FN
  Else
    GetTempName := '';
  End;
{$ENDIF}

(*
  TODO:
    2000/02/24 OK Falls das File nicht gelscht werden konnte, Attribut-Reset versuchen
                  evtl. noch tries einfhren.
*)
Function  EraseFile(Const FN: String): Boolean;
  Var
    F: File;

  Begin
  Assign(F, FN);
  Erase(F);
  EraseFile := (IoResult = 0);
  End;

End.