Package Files

Uses KbdCRT,Error,Partition,Dir

Interface

Const
     Input,Output,Badput
Type
    Record File is
      Mode as Byte
      Size as LongWord
      NbReadedBytes as LongWord
      CurClus,CurPos,First as Word
      ClusEntry,IndEntry as Word
    End

Sub Move(Src,Dest as Reference; Length as Word)
Sub Open(F as @File; Name,Ext as String; M as Byte)
Def FileExists(Name,Ext as String) as Byte
Def FileSize(F as @File) as LongWord
Def FileLength(Name,Ext as String) as LongWord
Def EOF(F as @File) as Byte
Sub Read(F as @File,Buf as Reference,Size as Word)
Sub Write(F as @File,Buf as Reference,Size as Word)
Sub Close(F as @File)

Implementation

Sub Move(Src,Dest as Reference; Length as Word)
Enter
\ CLD \
  InLine(&HFC)
\ PUSH DS \
  InLine(&H1E)
\ LES SI,[Src] \
  InLine(&HC4,&HB6,Src)
\ MOV BX,ES \
  InLine(&H8C,&HC3)
\ MOV DS,BX \
  InLine(&H8E,&HDB)
\ LES DI,[Dest] \
  InLine(&HC4,&HBE,Dest)
\ MOV CX,[Length] \
  InLine(&H8B,&H8E,Length)
\ REPZ MOVSB \
  InLine(&HF3,&HA4)
\ POP DS \
  InLine(&H1F)
Leave

Type
    BufClus is Array[0..2047] Of Byte
Var
   RDataClusNo,WDataClusNo as Word
   Dirty as Byte

Sub Open(F as @File; Name,Ext as String; M as Byte)
  D as DirEntry
  OldFirst as Word
Enter
  Case M Of
    Input:
    Begin
      If FindFile(D,Name,Ext)=0 Then Error "Open : file not found";
      F.Mode=Input
      F.Size=D.Size
      F.First=D.First
      F.NbReadedBytes=0
      If D.First<2 Then Error "Open : bad D.First";
      F.CurClus=D.First
      F.CurPos=0
    End
    Output:
      If FindFile(D,Name,Ext)=0 Then
      Begin
        If CreateFile(D,Name,Ext)=0 Then Error("Too many files");
      Else
        DirPiece[IndLastFile].Date=0
        DirPiece[IndLastFile].Time=0
        DirPiece[IndLastFile].Attr=&H20
        OldFirst=DirPiece[IndLastFile].First
        DirPiece[IndLastFile].First=0
        DirPiece[IndLastFile].Size=0
        WriteDirClus(DirPiece,NoDirPieceSect)
        ReWriteFATString(OldFirst)
      End
      F.Mode=Output
      F.Size=0
      F.First=F.CurClus=0
      F.CurPos=SizeCluster
      F.ClusEntry=NoDirPieceSect
      F.IndEntry=IndLastFile
      F.NbReadedBytes=0
    End
    Else
      Error "Open : bad mode";
  End
Leave

Def FileExists(Name,Ext as String) as Byte
  D as DirEntry
Enter
  Result=FindFile(D,Name,Ext)
Leave

Def FileSize(F as @File) as LongWord
Enter
  Result=F.Size
Leave

Def FileLength(Name,Ext as String) as LongWord
  D as DirEntry
Enter
  If FindFile(D,Name,Ext)=0 Then Error "FileLength : file not found";
  Result=D.Size
Leave

Def EOF(F as @File) as Byte
Enter
  Result=(F.NbReadedBytesðF.Size)
Leave

Sub Read(F as @File,Buf as Reference,Size as Word)
Static
      RDataBufClus as BufClus
Var
   PtrInTheBuf as Word
   Len as LongWord
Enter
  If F.Mode=Input Then
    PtrInTheBuf=0
  \
          Bytes restants ds F<>0      Place … remplir ds Buf<>0 \
    While F.Size<>F.NbReadedBytes And PtrInTheBuf<>Size Do
    Begin
    \
      Avancer d'un cluster si n‚c‚ssaire \
      If F.CurPos=SizeCluster Then F.CurClus=FATNext(F.CurClus):F.CurPos=0;
    \
      Len=Bytes non lus ds F \
      Len=F.Size-F.NbReadedBytes
    \
      Len=Min(Len,Place … remplir ds Buf) \
      If Len>Size-PtrInTheBuf Then Len=Size-PtrInTheBuf;
    \
      Len=Min(Len,Donn‚es restant … lire ds RDataBufClus) \
      If Len>SizeCluster-F.CurPos Then Len=SizeCluster-F.CurPos;
    \
      Oblig‚ de passer par RDataBufClus \
      If Len<SizeCluster Then
      Begin
      \ Ca correspond ? \
        If RDataClusNo<>F.CurClus Then ReadCluster(RDataBufClus,F.CurClus-2)
                                       RDataClusNo=F.CurClus;
        Move(RDataBufClus[F.CurPos],Buf+PtrInTheBuf,Len)
    \
      Lecture directe ds Buf \
      Else
        ReadCluster(Buf+PtrInTheBuf,F.CurClus-2)
      End
      PtrInTheBuf+=Len
      F.CurPos+=Len
      F.NbReadedBytes+=Len
    Wend
  Else
    Error("Read : bad mode");
Leave

Var
   WDataBufClus as BufClus

Sub Write(F as @File,Buf as Reference,Size as Word)
Var
   PtrInTheBuf,Len as Word
Enter
  If F.Mode=Output Then
    PtrInTheBuf=0
  \
    Check fichier vide \
    If Size<>0 And F.First=0 Then
      F.First=F.CurClus=FATAlloc(0)
      F.CurPos=0
    End
  \
          Bytes … ‚crire ds F<>0 \
    While PtrInTheBuf<>Size Do
    Begin
    \
      Allouer un cluster si n‚c‚ssaire \
      If F.CurPos=SizeCluster Then F.CurClus=FATAlloc(F.CurClus):F.CurPos=0;
    \
      Len=Bytes non ‚crits ds F \
      Len=Size-PtrInTheBuf
    \
      Len=Min(Len,Donn‚es restant … ‚crire ds WDataBufClus) \
      If Len>SizeCluster-F.CurPos Then Len=SizeCluster-F.CurPos;
    \
      Oblig‚ de passer par WDataBufClus \
      If F.CurPos<>0 Then
      Begin
      \ Ca correspond ? \
        If WDataClusNo<>F.CurClus Then
        Begin
          If Dirty=1 Then WriteCluster(WDataBufClus,WDataClusNo-2):Dirty=0;
          ReadCluster(WDataBufClus,F.CurClus-2)
          WDataClusNo=F.CurClus
        End
        Move(Buf+PtrInTheBuf,WDataBufClus[F.CurPos],Len)
        If F.CurPos+Len<>SizeCluster Then Dirty=1
        Else
          WriteCluster(WDataBufClus,WDataClusNo-2):Dirty=0;
    \
      Ecriture directe … partir de Buf \
      Else
        WriteCluster(Buf+PtrInTheBuf,F.CurClus-2)
      End
      PtrInTheBuf+=Len
      F.CurPos+=Len
      F.Size+=Len
    Wend
  Else
    Error("Write : bad mode");
Leave

Sub Close(F as @File)
Enter
  Case F.Mode Of
    Input:;
    Output:
      FlushDirtyFATPiece
      If Dirty=1 And F.CurClus=WDataClusNo Then
        WriteCluster(WDataBufClus,WDataClusNo-2)
        Dirty=0
      End
      ReadDirClus(DirPiece,F.ClusEntry)
      DirPiece[F.IndEntry].Size=F.Size
      DirPiece[F.IndEntry].First=F.First
      WriteDirClus(DirPiece,F.ClusEntry)
    End
    Else
      Error "Close : bad mode";
  End
  F.Mode=Badput
Leave

Enter
\ Init R/WDataClusNo,Dirty \
  RDataClusNo=&HFFFF
  WDataClusNo=&HFFFF
  Dirty=0
  PrintS "Files start done":PrintCR
Leave