home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 8 Other / 08-Other.zip / fss100.zip / FSS.PAS < prev   
Pascal/Delphi Source File  |  1994-11-08  |  14KB  |  428 lines
  1. PROGRAM FileSaveSet;
  2. {
  3.  
  4.    Creates BackMaster-compatible (mostly....)  SaveSet files
  5.    in the *.FSS format.
  6.  
  7. WARNING:
  8.  
  9.    ┌────────────────────────────────────────────────────┐
  10.    │ USES AND GLOBAL VARIABLES & CONSTANTS !  Ugly!     │
  11.    └────────────────────────────────────────────────────┘
  12. }
  13.  
  14. USES Crt,Dos;
  15.  
  16. TYPE
  17.  
  18.   FPtr      = ^Dir_Rec;
  19.  
  20.   Dir_Rec   = record                             { Double pointer record    }
  21.     DirName : string;
  22.     DirNum  : integer;
  23.     Next    : Fptr;
  24.     Prev    : Fptr;
  25.   END;
  26.  
  27.   Str_type  = string[65];
  28.  
  29. VAR
  30.  
  31.   Dir       : string;
  32.   Loop      : boolean;
  33.   Level     : integer;
  34.   Flag      : array[1..5] of string;
  35.   Tree      : boolean;
  36.   TotlBytes : longint;
  37.   DirChar   : Char;
  38.   DriveNum  : longint;
  39.  
  40.   F         : text;
  41.   Fbase,
  42.   Fext,
  43.   Fname     : String;
  44.   Code,
  45.   Outfiles  : integer;
  46.   BytesBacked,
  47.   TargetSize,
  48.   OutSize   : longint;
  49.  
  50. {
  51.    ┌────────────────────────────────────────────────────┐
  52.    │ PROCEDURE Beepit                                   │
  53.    └────────────────────────────────────────────────────┘
  54. }
  55. Procedure OPENIT;
  56. Begin
  57.    Inc(Outfiles);
  58.    Fbase := 'bs_';
  59.    Fext  := '.FSS';
  60.    Fname := Fbase+Dir[1]+'_'+CHR(Outfiles)+Fext;
  61.  
  62.    Assign(f,Fname);
  63.    ReWrite(f);
  64.  
  65.    WriteLn(f,'BACKMASTER VERSION 1.1');
  66.    WriteLn(f,'SAVESET FILE ',Fname);
  67.    Writeln(f,'SOURCE DRIVE ',UPCASE(Dir[1]));
  68.    Writeln(f,'ENDHEADER');
  69.    Writeln(f,'  This saveset file was created automatically!');
  70.    WriteLn(f,'  Targeted Size is "less than" ',(TargetSize/1000000):8:2,' MBytes.');
  71.    Writeln(f,'ENDCOMMENT');
  72. End;
  73.  
  74. PROCEDURE CLOSEIT;
  75. Begin
  76.   Writeln(f,'ENDDIRS');
  77.   IF Outfiles = 65 then WriteLn(f,'\*.*'); {root dir files go in first set}
  78.   Writeln(f,'END');
  79.   WriteLn(f,'; MBytes Backed up by this saveset = ',(BytesBacked/1000000):8:2);
  80.   Flush(f);
  81.   Close(f);
  82. End;
  83.  
  84. PROCEDURE Beepit;
  85.  
  86. BEGIN
  87.   SOUND (760);                                          { Beep the speaker }
  88.   DELAY (80);
  89.   NOSOUND;
  90.   ClrScr;
  91. END;
  92.  
  93. {
  94.    ┌────────────────────────────────────────────────────┐
  95.    │ PROCEDURE Format_Num                               │
  96.    └────────────────────────────────────────────────────┘
  97. }
  98.  
  99. PROCEDURE Format_Num (Number : longint; VAR NumStr : string);
  100.  
  101. BEGIN
  102.   STR(Number,NumStr);
  103.  
  104.   IF (LENGTH (NumStr) > 6) THEN                  { Insert millions comma    }
  105.     INSERT (',',NumStr,(LENGTH(NumStr) - 5));
  106.  
  107.   IF (LENGTH (NumStr) > 3) THEN                  { Insert thousands comma   }
  108.     INSERT (',',NumStr,(LENGTH(NumStr) - 2));
  109.  
  110. END;
  111.  
  112. {
  113.    ┌────────────────────────────────────────────────────┐
  114.    │ PROCEDURE DisplayDir                               │
  115.    └────────────────────────────────────────────────────┘
  116. }
  117.  
  118. PROCEDURE DisplayDir (DirP : str_type; DirN : str_type; Levl : integer;
  119.                      NumSubsVar2 : integer; SubNumVar2 : integer;
  120.                      NumSubsVar3 : integer;
  121.                      NmbrFil : integer; FilLen : longint);
  122.  
  123. {NumSubsVar2 is the # of subdirs. in previous level;
  124.  NumSumsVar3 is the # of subdirs. in the current level.
  125.  DirN is the current subdir.; DirP is the previous path}
  126.  
  127. VAR
  128.   BegLine : string;
  129.   MidLine : string;
  130.   Blank   : string;
  131.   WrtStr  : string;
  132.   NumFil  : string;
  133.   FilByte : string;
  134.  
  135. BEGIN
  136.  
  137.   IF Levl > 5 THEN
  138.     BEGIN
  139.       BEEPIT;
  140.       WRITELN;
  141.       WRITELN ('CANNOT DISPLAY MORE THAN 5 LEVELS.');
  142.       WRITELN;
  143.       EXIT;
  144.     END;
  145.  
  146.   Blank   := '               ';                  { Init. variables          }
  147.   BegLine := '';
  148.   MidLine := ' ──────────────────';
  149.  
  150.   IF Levl = 0 THEN                               { Special handling for     }
  151.     IF Dir = '' THEN                             { initial (0) dir. level   }
  152.       IF Tree = False THEN
  153.         WrtStr := 'ROOT ──'
  154.       ELSE
  155.         WrtStr := 'ROOT'
  156.     ELSE
  157.       IF Tree = False THEN
  158.        begin
  159.         WrtStr := DirP + ' ──'
  160.        end
  161.       ELSE
  162.         WrtStr := DirP
  163.   ELSE
  164.     BEGIN                                        { Level 1+ routines        }
  165.       IF SubNumVar2 = NumSubsVar2 THEN           { If last node in subtree, }
  166.         BEGIN                                    { use └─ symbol & set flag }
  167.           BegLine  := '└─';                      { padded with blanks       }
  168.           Flag[Levl] := ' ' + Blank;
  169.         END
  170.       ELSE                                       { Otherwise, use ├─ symbol }
  171.         BEGIN                                    { & set flag padded with   }
  172.           BegLine    := '├─';                    { blanks                   }
  173.           Flag[Levl] := '│' + Blank;
  174.         END;
  175.  
  176.       CASE Levl OF                               { Insert │ & blanks as     }
  177.          1: BegLine := BegLine;                  { needed, based on level   }
  178.          2: Begline := Flag[1] + BegLine;
  179.          3: Begline := Flag[1] + Flag[2] + BegLine;
  180.          4: Begline := Flag[1] + Flag[2] + Flag[3] + BegLine;
  181.          5: Begline := Flag[1] + Flag[2] + Flag[3] + Flag[4] + BegLine;
  182.       END; {end case}
  183.  
  184.       IF Levl = 1 then
  185.       begin
  186.         WriteLn(f,'\',DirN);
  187.         If BytesBacked > TargetSize then
  188.            begin
  189.             Closeit;
  190.             BytesBacked :=0;
  191.             Openit
  192.            end;
  193.        end;
  194.  
  195.       IF (NumSubsVar3 = 0) THEN                  { If cur. level has no     }
  196.         WrtStr := BegLine + DirN                 { subdirs., leave end blank}
  197.       ELSE
  198.         IF Tree = False THEN
  199.           WrtStr := BegLine + DirN + COPY(Midline,1,(13-LENGTH(DirN))) + '─┬─'
  200.         ELSE
  201.           WrtStr := BegLine + DirN + COPY(Midline,1,(13-LENGTH(DirN))) + '─┐ ';
  202.     END;                                         { End level 1+ routines    }
  203.  
  204.   Format_Num(NmbrFil,NumFil);
  205.   Format_Num(FilLen,FilByte);
  206.  
  207.   IF ((Levl < 4) OR ((Levl = 4) AND (NumSubsVar3=0))) AND (Tree = False) THEN
  208.     WRITELN (WrtStr,'':(65 - LENGTH(WrtStr)),NumFil:3,FilByte:11)
  209.   ELSE
  210.     WRITELN (WrtStr);                            { Write # of files & bytes  }
  211.                                                  { only if it fits, else     }
  212. END;                                             { write only tree outline   }
  213.  
  214. {
  215.    ┌────────────────────────────────────────────────────┐
  216.    │ PROCEDURE ReadFiles                                │
  217.    └────────────────────────────────────────────────────┘
  218. }
  219.  
  220. PROCEDURE ReadFiles (DirPrev : str_type; DirNext : str_type;
  221.                      SubNumVar1 : integer; NumSubsVar1 : integer);
  222.  
  223. VAR
  224.   FileInfo  : SearchRec;
  225.   FileBytes : longint;
  226.   NumFiles  : integer;
  227.   NumSubs   : integer;
  228.   Dir_Ptr   : FPtr;
  229.   CurPtr    : FPtr;
  230.   FirstPtr  : FPtr;
  231.  
  232. BEGIN
  233.   FileBytes := 0;
  234.   Numfiles  := 0;
  235.   NumSubs   := 0;
  236.   Dir_Ptr   := nil;
  237.   CurPtr    := nil;
  238.   FirstPtr  := nil;
  239.  
  240.   IF Loop THEN FindFirst (DirPrev + DirNext + '\*.*', AnyFile, FileInfo);
  241.   Loop      := False;                            { Get 1st file             }
  242.  
  243.   WHILE DosError = 0 DO                          { Loop until no more files }
  244.     BEGIN
  245.       IF (FileInfo.Name <> '.') AND (FileInfo.Name <> '..') THEN
  246.         BEGIN
  247.           IF (FileInfo.attr = directory) THEN    { If fetched file is dir., }
  248.             BEGIN                                { store a record with dir. }
  249.               NEW (Dir_Ptr);                     { name & occurence number, }
  250.               Dir_Ptr^.DirName  := FileInfo.name;{ and set links to         }
  251.               INC (NumSubs);                     { other records if any     }
  252.               Dir_Ptr^.DirNum   := NumSubs;
  253.               IF CurPtr = nil THEN
  254.                 BEGIN
  255.                   Dir_Ptr^.Prev := nil;
  256.                   Dir_Ptr^.Next := nil;
  257.                   CurPtr        := Dir_Ptr;
  258.                   FirstPtr      := Dir_Ptr;
  259.                 END
  260.               ELSE
  261.                 BEGIN
  262.                   Dir_Ptr^.Prev := CurPtr;
  263.                   Dir_Ptr^.Next := nil;
  264.                   CurPtr^.Next  := Dir_Ptr;
  265.                   CurPtr        := Dir_Ptr;
  266.                  END;
  267.                END
  268.           ELSE
  269.             BEGIN                                { Tally # of bytes in file }
  270.               FileBytes := FileBytes + FileInfo.size;
  271.               INC(TotlBytes,FileInfo.size);      { Add to total bytes, too  }
  272.               INC(BytesBacked,FileInfo.Size);
  273.               INC(NumFiles);                     { Increment # of files,    }
  274.             END;                                 { excluding # of subdirs.  }
  275.         END;
  276.       FindNext (FileInfo);                       { Get next file            }
  277.     END;    {end WHILE}
  278.  
  279.  
  280.     DisplayDir (DirPrev, DirNext, Level, NumSubsVar1, SubNumVar1, NumSubs,
  281.                 NumFiles, FileBytes);            { Pass info to & call      }
  282.     INC (Level);                                 { display routine, & inc.  }
  283.                                                  { level number             }
  284.  
  285.  
  286.     WHILE (FirstPtr <> nil) DO                   { If any subdirs., then    }
  287.       BEGIN                                      { recursively loop thru    }
  288.         Loop     := True;                        { ReadFiles proc. til done }
  289.         ReadFiles ((DirPrev + DirNext + '\'),FirstPtr^.DirName,
  290.                     FirstPtr^.DirNum, NumSubs);
  291.         FirstPtr := FirstPtr^.Next;
  292.       END;
  293.  
  294.  
  295.     DEC (Level);                                 { Decrement level when     }
  296.                                                  { finish a recursive loop  }
  297.                                                  { call to lower level of   }
  298.                                                  { subdir.                  }
  299. END;
  300.  
  301.  
  302. {
  303.    ┌────────────────────────────────────────────────────┐
  304.    │ PROCEDURE Read_Parm                                │
  305.    └────────────────────────────────────────────────────┘
  306. }
  307.  
  308. PROCEDURE Read_Parm;
  309.  
  310. VAR
  311.   Cur_Dir : string;
  312.   Param   : string;
  313.   i       : integer;
  314.  
  315. BEGIN
  316.  
  317.   IF ParamCount > 2 THEN
  318.     BEGIN
  319.       BEEPIT;
  320.       WRITELN ('Too many parameters -- only starting path and "SIZE"');
  321.       WRITELN ('option (/s or /S) is allowed.');
  322.       HALT;
  323.     END;
  324.  
  325.   Param := '';
  326.  
  327.   FOR i := 1 TO ParamCount DO                    { If either param. is a T, }
  328.     BEGIN                                        { set Tree flag            }
  329.       Param := ParamStr(i);
  330.       IF Param[1] = '/' THEN
  331.         CASE Param[2] OF
  332.           's','S': BEGIN
  333.                      Val( copy(ParamStr(i),3,(length(paramStr(i))-2)),Targetsize,Code);
  334.                      TargetSize := TargetSize *1000000;
  335.                      IF ParamCount = 1 THEN EXIT;
  336.                    END;                          { Exit if only one param   }
  337.         ELSE
  338.           BEGIN
  339.             BEEPIT;
  340.             WRITELN ('Invalid parameter -- only /s or /S allowed.');
  341.             HALT;
  342.           END;
  343.         END; {case}
  344.     END;
  345.  
  346.  
  347.   GETDIR (0,Cur_Dir);                            { Save current dir         }
  348.   FOR i := 1 TO ParamCount DO
  349.     BEGIN
  350.       Param := ParamStr(i);                        { Set var to param. string }
  351.       IF (POS ('/',Param) = 0) THEN
  352.         BEGIN
  353.           Dir := Param;
  354. {$I-}     CHDIR (Dir);                           { Try to change to input   }
  355.           IF IOResult = 0 THEN                   { dir.; if it exists, go   }
  356.             BEGIN                                { back to orig. dir.       }
  357. {$I+}        CHDIR (Cur_Dir);
  358.              IF (POS ('\',Dir) = LENGTH (Dir)) THEN
  359.                DELETE (Dir,LENGTH(Dir),1);       { Change root symbol back  }
  360.              EXIT                                { to null, 'cause \ added  }
  361.             END                                  { in later                 }
  362.           ELSE
  363.             BEGIN
  364.               BEEPIT;
  365.               WRITELN ('No such directory -- please try again.');
  366.               HALT;
  367.             END;
  368.         END;
  369.     END;
  370.  
  371. END;
  372.  
  373. {
  374.    ┌────────────────────────────────────────────────────┐
  375.    │ MAIN PROGRAM                                       │
  376.    └────────────────────────────────────────────────────┘
  377. }
  378.  
  379. VAR
  380.  
  381.   Version : string;
  382.  
  383. BEGIN
  384.   TargetSize := 180000000; {should fit on one tape...}
  385.   BytesBacked := 0;
  386.   TotlBytes := 0;
  387.   Version := 'FSS Ver. 1.0a, 11-08-94';   { Sticks in EXE file      }
  388.  
  389.   Dir     := '';                                 { Init. global vars.      }
  390.   Loop    := True;
  391.   Level   := 0;
  392.   Tree    := False;
  393.   OutFiles := 64;
  394.  
  395.   ClrScr;
  396.  
  397.   IF ParamCount > 0 THEN Read_Parm;              { Deal with any params.   }
  398.   If Length(Dir) < 2 then
  399.   begin
  400.     ClrScr;
  401.     WriteLn('You must enter the Drive: to be used - for example:');
  402.     WriteLn;
  403.     WriteLn('FSS c:');
  404.     Writeln;
  405.     WriteLn('In addition to the drive, you may specify an approximate');
  406.     Writeln('size limit for the saveset in millions of bytes - for example:');
  407.     WriteLn;
  408.     WriteLn('FSS D: /s40');
  409.     WriteLn;
  410.     WriteLn('would create as many FSS files as necessary to put about');
  411.     WriteLn('40,000,000 bytes per saveset.');
  412.     HALT(2)
  413.   end;
  414.   Openit;
  415.   ReadFiles (Dir,'',0,0);                        { Do main read routine    }
  416.   DirChar := UpCase(Dir[1]);
  417.   Case DirChar of
  418.     'A'..'Z':DriveNum := Ord(DirChar)-64;
  419.   else
  420.     DriveNum := 0;
  421.   end;
  422.   WriteLn(' TOTAL BYTES used     = ',TotlBytes);
  423.   Writeln(' BYTES FREE on drive ',Dir,' = ',DiskFree(DriveNum));
  424.   WriteLn(VERSION);
  425.   CloseIt;
  426. END.
  427.  
  428.