Beijing Paradise BBS Backup/PARADISE.ISO/software/BBSDOORW/MFM_119C.ZIP/SETUP.PAS

Pascal/Delphi Source File | 1993-06-04 | 15.5 KB | 484 lines

Unit Setup;
{========================================================================}
Interface
  Uses
    MfmDefs;
  Procedure ParseCommandLine;
  Procedure BuildSkipList;
  Procedure ParseConfigFile;
  Function OkToAdd(InString : String) : Boolean;
  Function CommentEntry : Boolean;
  Procedure FindOrphans;
  Procedure BuildList;
  Function Bytes(NumberOfBytes : LongInt) : S8;
  Procedure SetupScreen;
  Procedure ReDrawScreen;
{========================================================================}
Implementation
  Uses
    Crt, Display, Dos, General, MaxAreas, MfmStr, Quit, Screen;
{========================================================================}
Procedure BuildClt;
  Var
    Cltb : Byte;
  Begin
    CommandLineTail := '';
    If ParamCount > 0 Then
    Begin
      For Cltb := 1 To ParamCount Do CommandLineTail := CommandLineTail+ParamStr(Cltb)+' ';
      Delete(CommandLineTail,Length(CommandLineTail),1);
    End;
  End;
{========================================================================}
Procedure ParseCommandLine;
  Var
    Pclb : Byte;
    FileAreaPathOk, AreaPathOk, OutputSelected : Boolean;
  Begin
    BuildClt;
    CommandLineTail := UpperString(CommandLineTail);
    ReDirectTo := StandardIO;
    Assign(Input,''); Reset(Input);
    Assign(Output,''); Rewrite(Output);
    OutputSelected := False;
    WriteLn(Pgmid); WriteLn;
    FileAreaPath := '';
    FileAreaPathOk := False;
    AreaPathOk := False;
    MfmRunFb := False;
    AreaChanged := False;
    If ParamCount = 0 Then
    Begin
      ReDirectTo := Console;
      OutputSelected := True;
      AssignCrt(Input); Reset(Input);
      AssignCrt(Output); Rewrite(Output);
      AreaPath := MfmExeDir+'AREA.DAT';
    End
    Else
    Begin
      If (Pos('/A',CommandLineTail) > 0) Or (Pos('-A',CommandLineTail) > 0) Then
      Begin
        AreaPathOk := True;
        If Pos('/A',CommandLineTail) > 0 Then
        Begin
          AreaPath := HereToSpace(CommandLineTail,Pos('/A',CommandLineTail)+2);
        End
        Else
        Begin
          AreaPath := HereToSpace(CommandLineTail,Pos('-A',CommandLineTail)+2);
        End;
        If Length(AreaPath) > 0 Then
        Begin
          If Not FileExist(AreaPath) Then
          Begin
            If Copy(AreaPath,Length(AreaPath),1) <> '\' Then AreaPath := AreaPath + '\';
            If Not FileExist(AreaPath+'AREA.DAT') Then
            Begin
              WriteLn('AREA.DAT not found in '+AreaPath+' !');
              Halt(1);
            End
            Else
            Begin
              AreaPath := AreaPath+'AREA.DAT';
            End;
          End;
        End;
      End;
      If (Pos('/C',CommandLineTail) > 0) Or (Pos('-C',CommandLineTail) > 0) Then
      Begin
        OutputSelected := True;
        If (Pos('/C0',CommandLineTail) > 0) Or (Pos('-C0',CommandLineTail) > 0) Then
        Begin
          ReDirectTo := Console;
          AssignCrt(Input); Reset(Input);
          AssignCrt(Output); Rewrite(Output);
        End;
        If (Pos('/C1',CommandLineTail) > 0) Or (Pos('-C1',CommandLineTail) > 0) Then
        Begin
          ReDirectTo := ComPort1;
          Assign(Input,'Com1'); Reset(Input);
          Assign(Output,'Com1'); Rewrite(Output);
        End;
        If (Pos('/C2',CommandLineTail) > 0) Or (Pos('-C2',CommandLineTail) > 0) Then
        Begin
          ReDirectTo := ComPort2;
          Assign(Input,'Com2'); Reset(Input);
          Assign(Output,'Com2'); Rewrite(Output);
        End;
        If (Pos('/C9',CommandLineTail) > 0) Or (Pos('-C9',CommandLineTail) > 0) Then
        Begin
          ReDirectTo := StandardIO;
          Assign(Input,''); Reset(Input);
          Assign(Output,''); Rewrite(Output);
        End;
      End;
      If (Pos('/P',CommandLineTail) > 0) Or (Pos('-P',CommandLineTail) > 0) Then
      Begin
        FileAreaPathOk := True;
        If Pos('/P',CommandLineTail) > 0 Then
        Begin
          FileAreaPath := HereToSpace(CommandLineTail,Pos('/P',CommandLineTail)+2);
        End
        Else
        Begin
          FileAreaPath := HereToSpace(CommandLineTail,Pos('-P',CommandLineTail)+2);
        End;
        If Length(FileAreaPath) > 0 Then
        Begin
          FileAreaPath := FExpand(FileAreaPath);
          If Not DirExist(FileAreaPath) Then
          Begin
            WriteLn('Directory "'+FileAreaPath+'" not found.');
            Halt(1);
          End;
          If Not FileExist(FileAreaPath+'*.*') Then
          Begin
            WriteLn('No files exist in "'+FileAreaPath+'".');
            Halt(1);
          End;
        End;
      End;
      If Pos('/R',CommandLineTail) > 0 Then MfmRunFb := True;
      If (Pos('/T',CommandLineTail) > 0) Or (Pos('-T',CommandLineTail) > 0) Then TabOk := False;
    End;
    If (Not AreaPathOk) Then AreaPath := MfmExeDir+'AREA.DAT';
    If (Not OutputSelected) Then
    Begin
      ReDirectTo := Console;
      OutputSelected := True;
      AssignCrt(Input); Reset(Input);
      AssignCrt(Output); Rewrite(Output);
    End;
    If (Not FileAreaPathOk) Then
    Begin
      Repeat
        Result := SelectArea(AreaPath,FileAreaPath,FilesBbsPath,OldArea);
        If Result In [252..255] Then
        Begin
          If Result = 255 Then
          Begin
            WriteLn('"'+AreaPath+'" not found.');
            Halt(Result);
          End;
          If Result = 254 Then
          Begin
            WriteLn('Could not open "'+AreaPath+'".');
            Halt(Result);
          End;
          QuitMfm;
        End;
      Until Result < 252;
    End;
  End;
{========================================================================}
Procedure BuildSkipList;
  Var
    Bslb : Byte;
    InFile : Text;
  Begin
    For Bslb := 1 To MaxSkip Do SkipList[Bslb] := 'ACBDEFGHIJKL';
    If FileExist(MfmExeDir+'MFM-SKIP.LST') Then
    Begin
      Assign(InFile,MfmExeDir+'MFM-SKIP.LST');
      Reset(InFile);
      Bslb := 1;
      While (Not Eof(InFile)) And (Bslb < MaxSkip) Do
      Begin
        ReadLn(InFile,SkipList[Bslb]);
        Inc(Bslb);
      End;
      Close(InFIle);
    End;
  End;
{========================================================================}
Procedure ParseConfigFile;
  Var
    CfgFile : Text;
    CfgStr : String;
  Begin
    DefaultViewer := 'L.COM';
    CompressedFileViewer := 'SHEZ.EXE';
    CompressedFileExt := 'ARCARJLZHPAKSDNZIPZOO';
    PictureFileViewer := 'VPIC.EXE';
    PictureFileExt := 'GIF';
    If FileExist(MfmExeDir+'MFM.CFG') Then
    Begin
      Assign(CfgFile,MfmExeDir+'MFM.CFG');
      Reset(CfgFile);
      While Not Eof(CfgFile) Do
      Begin
        ReadLn(CfgFile,CfgStr);
        CfgStr := UpperString(CfgStr);
        If Pos('DEFAULT VIEWER',CfgStr) > 0 Then DefaultViewer := Copy(CfgStr,18,255);
        If Pos('COMPRESSED FILE VIEWER',CfgStr) > 0 Then CompressedFileViewer := Copy(CfgStr,26,255);
        If Pos('PICTURE FILE VIEWER',CfgStr) > 0 Then PictureFileViewer := Copy(CfgStr,23,255);
        If Pos('COMPRESSED FILE EXT',CfgStr) > 0 Then CompressedFileExt := Copy(CfgStr,23,255);
        If Pos('PICTURE FILE EXT',CfgStr) > 0 Then PictureFileExt := Copy(CfgStr,20,255);
      End;
      Close(CfgFile);
    End;
  End;
{========================================================================}
Function OkToAdd(InString : String) : Boolean;
  Var
    Otab : Byte;
  Begin
    If (MaxAvail > SizeOf(ListRecord)) Then
    Begin
      OkToAdd := True;
      For Otab := 1 To 10 Do If Pos(SkipList[Otab],UpperString(InString)) = 1 Then OkToAdd := False;
    End
    Else
    Begin
      OkToAdd := False;
    End;
  End;
{========================================================================}
Function CommentEntry : Boolean;
  Begin
    CommentEntry := False;
    If Length(WorkString) = 0 Then CommentEntry := True;
    If Copy(WorkString,1,1) = ' ' Then CommentEntry := True;
    If Copy(WorkString,1,1) = '-' Then CommentEntry := True;
    If Pos(WorkString[1],Base153) = 0 Then CommentEntry := True;
  End;
{========================================================================}
Procedure FindOrphans;
  Var
    FileFound : Boolean;
    SearchEntry : ListPtr;
  Begin
    FileFound := False; SearchEntry := FirstEntry;
    If FilesBbs Then
    Begin
      While (Not FileFound) And (SearchEntry^.NextEntry <> NIL) Do
      Begin
        If DirInfo.Name = SearchEntry^.FileName Then FileFound := True;
        SearchEntry := SearchEntry^.NextEntry;
      End;
    End;
    If FilesBbs Then
    Begin
      If (Not FileFound) And (DirInfo.Name <> SearchEntry^.FileName) Then
      Begin
        If OkToAdd(DirInfo.Name) Then
        Begin
          New(NewEntry);
          If NumberOfEntries = 0 Then
          Begin
            FirstEntry := NewEntry;
            NewEntry^.PrevEntry := NIL;
            OldEntry := FirstEntry;
          End
          Else
          Begin
            NewEntry^.PrevEntry := OldEntry;
            OldEntry^.NextEntry := NewEntry;
            OldEntry := NewEntry;
          End;
          NewEntry^.TypeOfRecord := Orphan;
          NewEntry^.FileName := DirInfo.Name;
          NewEntry^.FileSize := DirInfo.Size;
          If DirInfo.Name <> 'FILES.BBS' Then
          Begin
            SizeOfFiles := SizeOfFiles + DirInfo.Size;
            Inc(NumberOfFiles);
          End;
          NewEntry^.FileDate := DirInfo.Time;
          NewEntry^.Description := '';
          NewEntry^.Tagged := False;
          Inc(NumberOfEntries);
        End;
      End;
    End
    Else
    Begin
      If Not FileFound Then
      Begin
        If MaxAvail > SizeOf(ListRecord) Then
        Begin
          New(NewEntry);
          NewEntry^.Tagged := False;
          If NumberOfEntries = 0 Then
          Begin
            FirstEntry := NewEntry;
            NewEntry^.PrevEntry := NIL;
            OldEntry := FirstEntry;
          End
          Else
          Begin
            NewEntry^.PrevEntry := OldEntry;
            OldEntry^.NextEntry := NewEntry;
            OldEntry := NewEntry;
          End;
          NewEntry^.TypeOfRecord := Orphan;
          NewEntry^.FileName := DirInfo.Name;
          NewEntry^.FileSize := DirInfo.Size;
          If DirInfo.Name <> 'FILES.BBS' Then
          Begin
            SizeOfFiles := SizeOfFiles + DirInfo.Size;
            Inc(NumberOfFiles);
          End;
          NewEntry^.FileDate := DirInfo.Time;
          NewEntry^.Description := '';
          Inc(NumberOfEntries);
        End;
      End;
    End;
  End;
{========================================================================}
Procedure BuildList;
  Begin
    NumberOfEntries := 0; FilesBbs := True; Altered := False;
    SizeOfFiles := 0; NumberOfFiles := 0;
    Assign(FileList,FilesBbsPath);
    FileMode := 64; {ReadOnly & DenyNone}
    {$I-} Reset(FileList); {$I+}
    If IOresult = 0 Then
    Begin
      AnsiGotoXY(25,1); NewTextColor(White); NewTextBackground(Black);
      AnsiClearToEOL; Write('Loading FILES.BBS ...');
      While Not Eof(FileList) Do
      Begin
        ReadLn(FileList,WorkString);
        If OkToAdd(WorkString) Then
        Begin
          Inc(NumberOfEntries);
          If CommentEntry Then
          Begin
            New(NewEntry);
            NewEntry^.TypeOfRecord := Comment;
            NewEntry^.FileName := '';
            NewEntry^.FileSize := 0;
            NewEntry^.FileDate := 0;
            NewEntry^.Description := WorkString;
            NewEntry^.Tagged := False;
            If NumberOfEntries = 1 Then
            Begin
              FirstEntry := NewEntry;
              NewEntry^.PrevEntry := NIL;
              OldEntry := FirstEntry;
            End
            Else
            Begin
              NewEntry^.PrevEntry := OldEntry;
              OldEntry^.NextEntry := NewEntry;
              OldEntry := NewEntry;
            End;
          End
          Else
          Begin
            New(NewEntry);
            NewEntry^.Tagged := False;
            If NumberOfEntries = 1 Then
            Begin
              FirstEntry := NewEntry;
              NewEntry^.PrevEntry := NIL;
              OldEntry := FirstEntry;
            End
            Else
            Begin
              NewEntry^.PrevEntry := OldEntry;
              OldEntry^.NextEntry := NewEntry;
              OldEntry := NewEntry;
            End;
            If Pos(' ',WorkString) = 0 Then
            Begin
              NewEntry^.FileName := UpperString(WorkString);
            End
            Else
            Begin
              NewEntry^.FileName := UpperString(Copy(Copy(WorkString,1,Pos(' ',WorkString)-1),1,12));
            End;
            FindFirst(FileAreaPath+NewEntry^.FileName,AnyFile,DirInfo);
            If DosError = 0 Then
            Begin
              NewEntry^.TypeOfRecord := FileRecord;
              NewEntry^.FileSize := DirInfo.Size;
              SizeOfFiles := SizeOfFiles + DirInfo.Size;
              Inc(NumberOfFiles);
              NewEntry^.FileDate := DirInfo.Time;
              If Pos(' ',WorkString) = 0 Then
              Begin
                NewEntry^.Description := '';
              End
              Else
              Begin
                NewEntry^.Description := AllTrim(Copy(WorkString,Pos(' ',WorkString)+1,MaxDescLength));
              End;
            End
            Else
            Begin
              NewEntry^.TypeOfRecord := Offline;
              NewEntry^.FileSize := 0;
              NewEntry^.FileDate := 0;
              If Pos(' ',WorkString) = 0 Then
              Begin
                NewEntry^.Description := '';
              End
              Else
              Begin
                NewEntry^.Description := AllTrim(Copy(WorkString,Pos(' ',WorkString)+1,MaxDescLength));
              End;
            End;
          End;
        End;
      End;
      Close(FileList);
      NewEntry^.NextEntry := NIL;
      If NumberOfEntries = 0 Then FilesBbs := False;
    End
    Else
    Begin
      FilesBbs := False;
    End;
    FindFirst(FileAreaPath+'*.*',Archive,DirInfo);
    If DosError = 0 Then FindOrphans;
    While DosError = 0 Do
    Begin
      NewEntry^.NextEntry := NIL;
      FindNext(DirInfo);
      If DosError = 0 Then FindOrphans;
    End;
    LastEntry := NewEntry;
    LastEntry^.NextEntry := NIL;
    StackEntry := NIL; KillEntry := NIL;
    AnsiGotoXY(25,1); AnsiClearToEOL;
  End;
{========================================================================}
Function Bytes(NumberOfBytes : LongInt) : S8;
  Var
    TempString : S8;
  Begin
    If NumberOfBytes < 1024 Then
    Begin
      TempString := MyStr(NumberOfBytes,4)+'K';
    End
    Else
    Begin
      Str(NumberOfBytes/1024:3:1,TempString);
      TempString := TempString+'M';
    End;
    Bytes := TempString;
  End;
{========================================================================}
Procedure SetupScreen;
  Begin
    NewTextColor(White); NewTextBackground(Black);
    AnsiClearScreen; AnsiGotoXY(24,1);
    NewTextColor(Black); NewTextBackground(Cyan);
    Write(Pgmid+'     ^Q=quit ?=help');
    NewTextColor(White); NewTextBackground(Black);
  End;
{========================================================================}
Procedure ReDrawScreen;
  Begin
    SetupScreen;
    DisplayScreen;
  End;
{========================================================================}
Begin
End.
{========================================================================}