Program QFix;

{ This source code is provided as a sample of how to use the fixup list }
{ to change the BBS's download file list.  This program works with      }
{ QuickBBS and 4DOS, it may work with others.                           }

{ Permission is hereby granted to modify this program to work with      }
{ other BBS list formats.  Please send me a copy (with docs) so that    }
{ I may add it to the ZZAP package.  Proper acknowledgements will be    }
{ provided in the ZZAP documents for all used submissions.              }


Uses
  Crt,
  Dos,
  TpString;  { This is from Turbo Professional 5.0, Turbo Power Software}
             { Since I can't include a copy of this unit you will have  }
             { to provide your own or replace all of the routines from  }
             { this unit.  The string manipulation routines I used from }
             { this package should be fairly easy to duplicate.         }

{ Routines used from TpString:                                              }
{                                                                           }
{ Function AddBackSlash(Path : String);                                     }
{   - Adds a backslash to the path if required.                             }
{                                                                           }
{ Function ForceExtension(Name,Ext : String) : String;                      }
{   - Forces the specified extension onto the file name.                    }
{                                                                           }
{ Function JustFilename(PathName : String);                                 }
{    - Return just the filename and extension of a pathname.                }
{                                                                           }
{ Function StUpCase(S : String) : String;                                   }
{    - Convert lower case letters to uppercase.                             }
{                                                                           }
{ Function JustPathName(Pathname : String) : String;                        }
{    - Return just the drive and directory portion of a pathname.           }

Type
  String12 = String[12];
  ListPtr = ^ListRec;
  ListRec = Record
              OldName : String12;
              NewName : String12;
              Next    : ListPtr;
            End;

Const
  SourceName : String12 = 'FILES.BBS';

Var
  FixList  : Text;
  Line     : String;
  BufLine  : String;   { holds the next line from the list file }
  FileName : String;
  PathName : String;
  LastPath : String;
  ListName : String;
  OldName  : String;
  NewName  : String;
  HeapTop  : ^BYTE;
  First    : ListPtr;
  Current  : ListPtr;

Procedure ReadLine(Var Source : Text;Var Line : String);

{-Returns the buffered line (BUFLINE) if not empty, otherwise }
{ reads a line directly from the file.                        }

Begin
  If BufLine = ''
    Then ReadLn(Line)
  Else Begin
    Line := BufLine;
    BufLine := '';
  End;
End;

Function PeekLine(Var Source : Text) : String;

{-Returns a line of text, the line is buffered so that it will }
{ be returned by the next use of READLINE.                     }

Begin
  If BufLine = '' Then ReadLn(Source,BufLine);
  PeekLine := BufLine;
End;

Function EndOfFile(Var Source : Text) : Boolean;

{-Returns TRUE if at the end of the file AND the buffered line is empty. }

Begin
  EndOfFile := Eof(Source) And (BufLine = '');
End;

Function ExtractWord(N : Byte;S : String) : String;

Var
  Line  : String;
  CL    : ^String;

Begin
  CL := Ptr(PrefixSeg,$0080);
  Line := CL^;
  CL^ := S;
  ExtractWord := ParamStr(N);
  CL^ := Line;
End;

Procedure ProcessList(First : ListPtr;Path : String);

{-Processes the list of files in the given subdirectory. }

Var
  Current : ListPtr;
  Source   : Text;
  Target   : Text;
  Dummy    : File;
  Line     : String;
  FileName : String;
  Name     : String12;
  Attr     : Word;
  X        : Integer;

Begin
  FileName := AddBackSlash(Path) + SourceName;
  Assign(Source,FileName);
  GetFAttr(Source,Attr);
  If (DosError <> 0) OR (Attr AND (SysFile OR ReadOnly) <> 0) Then Exit;
  SetFAttr(Source,Attr AND $3C);
  Reset(Source);
  Assign(Target,ForceExtension(FileName,'$$$'));
  Rewrite(Target);
  Write(Path,'  ');
  X := WhereX;
  While Not Eof(Source) Do
  Begin
    ReadLn(Source,Line);       { get a line from the BBS list             }
    If Pos(' ',Line) > 1 Then  { if a blank is in the first position then }
    Begin                      { it can't be a file name, perhaps part of }
                               { a multiline description or a null line   }
      Name := StUpCase(ExtractWord(1,Line));
      Current := First;
      While Current <> NIL Do
      Begin
        If Name = Current^.OldName
          Then Begin
            GotoXY(X,WhereY);
            ClrEol;
            Write(Current^.OldName,' ==> ',Current^.NewName);
            Delete(Line,1,Length(Name));      { delete the old name      }
            Line := Current^.NewName + Line;  { add the new name         }
            Current := Nil;                   { force us out of the loop }
          End
        Else Current := Current^.Next;
      End;
    End;
    WriteLn(Target,Line);
  End;
  Write(^M);
  ClrEol;
  Close(Source);
  Close(Target);
  Assign(Dummy,ForceExtension(FileName,'BAK'));
  {$I-}
  Erase(Dummy);
  {$I+}
  If IOResult = 0 Then {} ;
  Rename(Source,ForceExtension(FileName,'BAK'));
  Rename(Target,FileName);
  SetFAttr(Target,Attr);
End;

Begin
  If ParamCount > 0 Then SourceName := JustFilename(ParamStr(1));
  ListName := FSearch('FILES.FIX',GetEnv('PATH'));
  If ListName = '' Then
  Begin
    WriteLn('List file, FILES.FIX, not found.');
    Halt(1);
  End;
  Assign(FixList,ListName);
  {$I-}
  Reset(FixList);
  {$I+}
  If IOResult <> 0 Then Halt;
  LastPath := '';
  BufLine := '';
  While Not EndOfFile(FixList) Do
  Begin
    First := Nil;
    Mark(HeapTop);
    Repeat
{ If the next path to read is the same as the current path then add the }
{ file names to the linked list.                                        }

      If JustPathName(ExtractWord(1,PeekLine(FixList))) = LastPath
      Then Begin  { if the same path as the previous file }

        ReadLine(FixList,Line);  { get the next line }
        PathName := JustPathName(ExtractWord(1,Line));
        OldName := JustFileName(ExtractWord(1,Line));
        NewName := ExtractWord(2,Line);
        If OldName <> NewName Then    { only care about file names that change }
        Begin                         { delete this test if you must touch up  }
                                      { entries even if the file name hasn't   }
                                      { changes.                               }
          If First = NIL    { add the file name to the linked list }
            Then Begin
              New(First);
              Current := First;
            End
          Else Begin
            New(Current^.Next);
            Current := Current^.Next;
          End;
          Current^.OldName := OldName;
          Current^.NewName := NewName;
          Current^.Next := Nil;
        End;
      End;
    Until (PathName <> JustPathName(PeekLine(FixList))) OR EndOfFile(FixList);

{ Go fix up the BBS list for the current subdirectory }

    If First <> NIL Then ProcessList(First,LastPath); { process the list }

{ the next path is now the current path }

    LastPath := JustPathName(PeekLine(FixList));
    Release(HeapTop);
  End;
  Close(FixList);   { close the fix list }
  Erase(FixList);   { .. and erase it    }
End.