home *** CD-ROM | disk | FTP | other *** search
/ ftp.wwiv.com / ftp.wwiv.com.zip / ftp.wwiv.com / pub / MISC / TGBACKUP.ZIP / TGBACKUP.PAS < prev   
Pascal/Delphi Source File  |  1997-09-21  |  35KB  |  1,095 lines
  1. Program TelegardBackup;
  2. {$F+,R+,I-,S+,D-}
  3. {$M $4000,0,0 }
  4. {---------------------------------------------------------------------------}
  5. {                          .∙·General·Information·∙.                        }
  6. {---------------------------------------------------------------------------}
  7. {
  8.  
  9.                                 Telegard Backup
  10.                             North Star Technologies
  11.                        Copyright (c) 1996-97 Jon Parise
  12. }
  13.  
  14. Uses Dos, Crt, nstAsm, nstStr, nstFile, nstTask, Inputs, Fader;
  15.  
  16. {$I Main.Pas}
  17.  
  18. {---------------------------------------------------------------------------}
  19. {                         .∙·Constant·Declarations·∙.                       }
  20. {---------------------------------------------------------------------------}
  21. Const
  22.    Version      = '1.5';
  23.    cfgVersion   = 14;
  24.    Years        = '1996-97';
  25.    ConfigName   = 'TgBackup.Cfg';
  26.    MaxArchivers = 4;
  27.  
  28. {---------------------------------------------------------------------------}
  29. {                           .∙·Type·Declarations·∙.                         }
  30. {---------------------------------------------------------------------------}
  31. Type
  32.     tConfigRec = Record
  33.      cfgVer           : Byte;
  34.      TelegardPath     : String[80];    { Path to Telegard.Dat }
  35.      BackupPath       : String[80];    { Path to create backups }
  36.      UseDate          : Boolean;       { Include date in backup filename? }
  37.      KeepDays         : Byte;          { Days to keep dated backups }
  38.      Archiver         : Byte;          { Which archiver? }
  39.      ArchiverPath     : String[80];    { Path to archivers }
  40.      Fades            : Boolean;       { Use fades? }
  41.      Main             : Boolean;       { Backup Main? }
  42.      Data             : Boolean;       { Backup Data? }
  43.      Files            : Boolean;       { Backup Files? }
  44.      Lang             : Boolean;       { Backup Language? }
  45.      Logs             : Boolean;       { Backup Logs? }
  46.      Menu             : Boolean;       { Backup Menu? }
  47.      Text             : Boolean;       { Backup Text? }
  48.      Msgs             : Boolean;       { Backup Msgs? }
  49.      Masks            : Array[1..8] of String[12]; { file masks }
  50.      Extra1           : String[80];    { User Definable Path 1 }
  51.      Extra2           : String[80];    { User Definable Path 2 }
  52.     End; { tConfigRec}
  53.  
  54.     tArchiverRec = Record
  55.      Name             : String[10];    { Name of archiver }
  56.      Ext              : String[4];     { Extention of archiver }
  57.      Filename         : String[12];    { Filename of archiver }
  58.      Compress         : String[20];    { Compression commandline }
  59.     End; { tArchiverRec }
  60.  
  61.     tScreenType = Array [0..3999] of Byte;
  62.  
  63.     tArchiverArray = Array [1..MaxArchivers] of tArchiverRec;
  64.  
  65. {$I Telegard.Inc}   { Telegard Type Definitions }
  66.  
  67. {---------------------------------------------------------------------------}
  68. {                         .∙·Variable·Declarations·∙.                       }
  69. {---------------------------------------------------------------------------}
  70. Var
  71.    Screen      : tScreenType absolute $B800:0000;
  72.    Config      : tConfigRec;     { Configuration }
  73.    Telegard    : ConfigRec;      { Telegard.Dat }
  74.    Archivers   : tArchiverArray; { Array of available archivers }
  75.    Prefix      : String[8];      { Archive Prefix }
  76.    C           : Char;           { Holds Charactor to Write }
  77.    OrigPath    : String;         { Original Path }
  78.    ArcName     : String[8];      { Override backup name }
  79.    ArcType     : Byte;           { Override archiver type }
  80.  
  81.    { Date / Time Variables }
  82.    Year        : Word;           { Year }
  83.    Month       : Word;           { Month }
  84.    Day         : Word;           { Day }
  85.    DoW         : Word;           { Day of Week }
  86.    Hour        : Word;           { Hour }
  87.    Minute      : Word;           { Minute }
  88.    Second      : Word;           { Second }
  89.    Sec100      : Word;           { Sec100 }
  90.  
  91. {---------------------------------------------------------------------------}
  92. {                         .∙·Function·Declarations·∙.                       }
  93. {---------------------------------------------------------------------------}
  94.  
  95. Function SearchExec (ProgName, Parameters : String) : Integer;
  96. Var Result : Integer;
  97.  
  98.  Begin { SearchExec }
  99.  
  100.   { If the program doesn't exist then search on the %PATH for it }
  101.   If Not fExist(ProgName) then ProgName := fSearch(ProgName,GetEnv('PATH'));
  102.  
  103.   { Now call the program...if it didn't exist the set DOSError to 2 }
  104.   If ProgName <> '' then
  105.      Begin
  106.         SwapVectors;
  107.         Exec(ProgName, Parameters);
  108.         Result := DosError;
  109.         SwapVectors;
  110.         SearchExec := Result;
  111.      End else SearchExec := 2;
  112.  
  113.  End;  { SearchExec }
  114.  
  115. {---------------------------------------------------------------------------}
  116.  
  117. Procedure Patch1; Interrupt;
  118.  
  119.  Begin { Patch1 }
  120.   Write(C);
  121.  End;  { Patch1 }
  122.  
  123. {---------------------------------------------------------------------------}
  124.  
  125. Procedure Patch; Assembler;
  126.  
  127.   Asm
  128.      Push DS
  129.      Push Ax
  130.      Mov  AX, Seg C;
  131.      Mov  DS, AX;
  132.      Pop  AX;
  133.      Mov  C, Al;
  134.      Pop  DS
  135.      Jmp  Patch1;
  136.   End;  { Patch }
  137.  
  138. {---------------------------------------------------------------------------}
  139.  
  140. Function WindowExec (Archiver,Params,Path : String) : Integer;
  141. Var
  142.    Old_29h  : Pointer;
  143.    CmdLine  : String[255];
  144.  
  145.  Begin { WindowExec }
  146.  
  147.   {$F+}
  148.   GetIntVec($29, Old_29h);
  149.   SetIntVec($29, @Patch);
  150.   Window(11, 15, 68, 24);
  151.   ClrScr;
  152.   TextColor(DarkGray);
  153.   CmdLine := Params + Path;
  154.   WindowExec := SearchExec(Config.ArchiverPath + Archiver,CmdLine);
  155.   SetIntVec($29, Old_29h);
  156.  
  157.  End;  { WindowExec }
  158.  
  159. {---------------------------------------------------------------------------}
  160. {                         .∙·Procedure·Declarations·∙.                      }
  161. {---------------------------------------------------------------------------}
  162.  
  163. Procedure ProgInfo;
  164.  
  165.  Begin { ProgInfo }
  166.  
  167.   TextColor(11); Writeln('Telegard Backup v',Version);
  168.   TextColor(03); Writeln('Copyright ',Years,' by Jon Parise. All rights reserved.');
  169.   TextColor(08); Writeln('A North Star Technologies Software Release');
  170.  
  171.  End; { ProgInfo }
  172.  
  173. {---------------------------------------------------------------------------}
  174.  
  175. Procedure SetDefaults;
  176. Var I : Byte;
  177.  
  178.  Begin { SetDefaults }
  179.  
  180.   With Config Do
  181.     Begin
  182.        cfgVer       := cfgVersion;
  183.        TelegardPath := AddBackslash(GetEnv('TELEGARD'));
  184.        If (not(DirExist(TelegardPath))) or (Length(TelegardPath) < 3) then
  185.        TelegardPath := 'C:\Telegard\';
  186.        BackupPath   := 'C:\TGBackup\';
  187.        UseDate      := False;
  188.        KeepDays     := 0;
  189.        Archiver     := 1;
  190.        ArchiverPath := TelegardPath + 'Archive\';
  191.        Fades        := True;
  192.        Main         := True;
  193.        Data         := True;
  194.        Files        := True;
  195.        Lang         := True;
  196.        Logs         := True;
  197.        Menu         := True;
  198.        Text         := True;
  199.        Msgs         := True;
  200.        For I := 1 to 8 do Masks[I] := '*.*';
  201.        Extra1       := '';
  202.        Extra2       := '';
  203.      End;
  204.  
  205.  End;  { SetDefaults }
  206.  
  207. {---------------------------------------------------------------------------}
  208.  
  209. Procedure ReadTelegard;
  210. Var
  211.    ConfigFile : File of ConfigRec;
  212.    TempStr    : String;
  213.    Ignore     : Integer;
  214.  
  215.  Begin { ReadTelegard }
  216.  
  217.   {$I-}
  218.   TempStr := Config.TelegardPath + 'Config.Tg';
  219.  
  220.   If Not fExist(TempStr) Then
  221.      Begin
  222.         Writeln; TextColor(LightCyan);
  223.         Writeln ('        ',TempStr,' not found!');
  224.         Writeln;
  225.         Halt (1);
  226.       End;
  227.   Assign(ConfigFile,TempStr);
  228.   Ignore := IoResult;
  229.   Repeat
  230.      Reset(ConfigFile);
  231.      Ignore := IoResult;
  232.      If Ignore = 5 Then Delay(300);
  233.   Until Ignore <> 5;
  234.   Read (ConfigFile,Telegard);
  235.   Close (ConfigFile);
  236.   {$I+}
  237.  
  238.  End;  { ReadTelegard }
  239.  
  240. {---------------------------------------------------------------------------}
  241.  
  242. Procedure ReadConfig (Filename : String);
  243. Var
  244.    ConfigFile : File of tConfigRec;
  245.    Ignore     : Integer;
  246.  
  247.  Begin { ReadConfig }
  248.  
  249.   {$I-}
  250.   If Not fExist(Filename) Then
  251.      Begin
  252.         Writeln; TextColor(LightCyan);
  253.         Writeln ('        Configuration file not found!');
  254.         Writeln; TextColor(White);
  255.         Writeln ('        Run TGBACKUP -C to create one.');
  256.         Writeln;
  257.         Halt (1);
  258.       End;
  259.   Assign(ConfigFile,Filename);
  260.   Ignore := IoResult;
  261.   Repeat
  262.      Reset(ConfigFile);
  263.      Ignore := IoResult;
  264.      If Ignore = 5 Then Delay(300);
  265.   Until Ignore <> 5;
  266.   Read (ConfigFile,Config);
  267.   Close (ConfigFile);
  268.   {$I+}
  269.  
  270.  End;  { ReadConfig }
  271.  
  272. {---------------------------------------------------------------------------}
  273.  
  274. Procedure WriteConfig (Filename : String);
  275. Var
  276.    ConfigFile : File of tConfigRec;
  277.    Ignore     : Integer;
  278.  
  279.  Begin { WriteConfig }
  280.  
  281.   {$I-}
  282.   Assign(ConfigFile,Filename);
  283.   Ignore := IoResult;
  284.   Repeat
  285.      Rewrite(ConfigFile);
  286.      Ignore := IoResult;
  287.      If Ignore = 5 Then Delay(300);
  288.   Until Ignore <> 5;
  289.   Write(ConfigFile,Config);
  290.   Close(ConfigFile);
  291.   {$I+}
  292.  
  293.  End;  { WriteConfig }
  294.  
  295. {---------------------------------------------------------------------------}
  296.  
  297. Procedure Configuration;
  298. Var
  299.    I,J    : Integer;
  300.    S      : String[25];
  301.    C,C2   : Char;
  302.    B      : Boolean;
  303.    MaxItems : Integer;
  304.    Status : Byte;
  305.    Err    : Integer;
  306.    InStr  : String[50];
  307.  
  308.  Begin { Configuration }
  309.  
  310.   If fExist(ConfigName) then ReadConfig(ConfigName) else SetDefaults;
  311.  
  312.   ClrScr; CursorOff;
  313.   Move (Main,Screen,4000);
  314.   GotoXY (43,3); TextColor(DarkGray); Write(Version);
  315.  
  316.   GotoXY (28,7);  S := 'C O N F I G U R A T I O N';
  317.   For I := 1 to 25 do
  318.       Begin
  319.          Case I of
  320.             1.. 4: TextColor (DarkGray);
  321.             5.. 9: TextColor (LightGray);
  322.            10..15: TextColor (White);
  323.            15..21: TextColor (LightGray);
  324.            22..25: TextColor (DarkGray);
  325.           End; { Case }
  326.          Write (S[I]);
  327.       End;
  328.  
  329.   B := False;
  330.   I := 1;
  331.   MaxItems := 26;
  332.  
  333.   Repeat
  334.      CursorOff;
  335.      If I = 18 then I := 6;
  336.      For J := 1 to MaxItems do
  337.          Begin
  338.             If J <= 16 then GotoXY(13,J+8) else GotoXY(44,J-4);
  339.             If J = I then TextColor(White) else TextColor(DarkGray);
  340.             Case J of
  341.                1: Write('Telegard Path:');
  342.                2: Write('  Backup Path:');
  343.                3: Write('Archiver Path:');
  344.                4: Write('     Archiver:');
  345.                5: Write('Dated Backups:');
  346.                6: Write(' Screen Fades:');
  347.                7: Write('  Backup Main:');
  348.                8: Write('  Backup Data:');
  349.                9: Write('  Backup File:');
  350.               10: Write('  Backup Lang:');
  351.               11: Write('  Backup Logs:');
  352.               12: Write('  Backup Menu:');
  353.               13: Write('  Backup Text:');
  354.               14: Write('  Backup Msgs:');
  355.               15: Write(' Extra Path 1:');
  356.               16: Write(' Extra Path 2:');
  357.               { Second column }
  358.               17: Write('Days to Keep:');
  359.               18: ; { blank }
  360.               19..26: Write('Mask:');
  361.              End; { Case }
  362.             If J <= 16 then GotoXY(29,J+8) else GotoXY(59,J-4);
  363.             TextColor(Cyan);
  364.             Case J of
  365.                1: Write(Config.TelegardPath);
  366.                2: Write(Config.BackupPath);
  367.                3: Write(Config.ArchiverPath);
  368.                4: Write(Archivers[(Config.Archiver)].Name);
  369.                5: If Config.UseDate then Write('Enabled ') else Write('Disabled');
  370.                6: If Config.Fades then Write('Enabled ') else Write('Disabled');
  371.                7: If Config.Main then Write('Enabled ') else Write('Disabled');
  372.                8: If Config.Data then Write('Enabled ') else Write('Disabled');
  373.                9: If Config.Files then Write('Enabled ') else Write('Disabled');
  374.               10: If Config.Lang then Write('Enabled ') else Write('Disabled');
  375.               11: If Config.Logs then Write('Enabled ') else Write('Disabled');
  376.               12: If Config.Menu then Write('Enabled ') else Write('Disabled');
  377.               13: If Config.Text then Write('Enabled ') else Write('Disabled');
  378.               14: If Config.Msgs then Write('Enabled ') else Write('Disabled');
  379.               15: Write(Config.Extra1);
  380.               16: Write(Config.Extra2);
  381.               { Second column }
  382.               17: If Config.KeepDays = 0 then Write('Disabled') else Write(Config.KeepDays,'       ');
  383.               18: ; { blank }
  384.               19..26: Begin
  385.                         GotoXY(51,WhereY);
  386.                         Write(Config.Masks[J-18]);
  387.                       End;
  388.              End; { Case }
  389.          End;
  390.  
  391.      C := ReadKey;
  392.      Case C of
  393.        #27: B := True;                    { Escape     }
  394.        #73: I := 1;                       { Home       }
  395.        #81: I := MaxItems;                { End        }
  396.        #71: I := 1;                       { Page Up    }
  397.        #75: If (I >= 17) and (I <= 26)    { Right Arrow}
  398.               then I := I - 12;
  399.        #77: If (I >= 5) and (I <= 14)     { Left Arrow }
  400.               then I := I + 12;
  401.        #79: I := MaxItems;                { Page Down  }
  402.        #72: If I > 1 then Dec(I);         { Up Arrow   }
  403.        #80: If I < MaxItems then Inc(I);  { Down Arrow }
  404.        ' ',                               { Space      }
  405.        #13: Begin                         { Enter      }
  406.                TextColor(LightCyan);
  407.                Case I of
  408.                   1: Begin
  409.                        InStr := Input(29,9,Config.TelegardPath,' ','',39,-1,[#32..#175],True,Status);
  410.                        If Status <> 27 then Config.TelegardPath := AddBackslash(InStr);
  411.                      End;
  412.                   2: Begin
  413.                        InStr := Input(29,10,Config.BackupPath,' ','',39,-1,[#32..#175],True,Status);
  414.                        If Status <> 27 then Config.BackupPath := AddBackslash(InStr);
  415.                      End;
  416.                   3: Begin
  417.                        InStr := Input(29,11,Config.ArchiverPath,' ','',39,-1,[#32..#175],True,Status);
  418.                        If Status <> 27 then Config.ArchiverPath := AddBackslash(InStr);
  419.                      End;
  420.                   4: If Config.Archiver < MaxArchivers then Inc(Config.Archiver)
  421.                         else Config.Archiver := 1;
  422.                   5: Config.UseDate := Not(Config.UseDate);
  423.                   6: Config.Fades := Not(Config.Fades);
  424.                   7: Config.Main := Not(Config.Main);
  425.                   8: Config.Data := Not(Config.Data);
  426.                   9: Config.Files := Not(Config.Files);
  427.                  10: Config.Lang := Not(Config.Lang);
  428.                  11: Config.Logs := Not(Config.Logs);
  429.                  12: Config.Menu := Not(Config.Menu);
  430.                  13: Config.Text := Not(Config.Text);
  431.                  14: Config.Msgs := Not(Config.Msgs);
  432.                  15: Begin
  433.                        InStr := Input(29,23,Config.Extra1,' ','',39,-1,[#32..#175],True,Status);
  434.                        If Status <> 27 then Config.Extra1 := AddBackslash(InStr);
  435.                      End;
  436.                  16: Begin
  437.                        InStr := Input(29,24,Config.Extra2,' ','',39,-1,[#32..#175],True,Status);
  438.                        If Status <> 27 then Config.Extra2 := AddBackslash(InStr);
  439.                      End;
  440.                  17: Begin
  441.                        GotoXY(59,13); Write('        ');
  442.                        Str(Config.KeepDays,InStr);
  443.                        InStr := Input(59,13,InStr,' ','',3,-1,[#48..#57],True,Status);
  444.                        If Status <> 27 then Val(InStr,Config.KeepDays,Err);
  445.                        If Config.KeepDays > 30 then Config.KeepDays := 30;
  446.                      End;
  447.                  18: ; { blank }
  448.                  19..26: Begin
  449.                            InStr := Input(51,I-4,Config.Masks[I-18],' ','',12,-1,[#32..#175],True,Status);
  450.                            If Status <> 27 then Config.Masks[I-18] := InStr;
  451.                          End;
  452.                 End; { Case }
  453.             End;
  454.       End; { Case }
  455.   Until B;
  456.  
  457.   GotoXY(26,25);
  458.   TextColor(LightGray); Write('Save this configuration?'); TextColor(White);
  459.   B := True;
  460.   Repeat
  461.      GotoXY (52,25);
  462.      If B then Write('Yes') else Write('No ');
  463.      C := ReadKey;
  464.      Case Upcase(C) of
  465.        'N': B := False;
  466.        'Y': B := True;
  467.        ' ': B := Not(B);
  468.       End; { Case }
  469.   Until C = #13;
  470.   If B Then WriteConfig(ConfigName);
  471.   CursorOn;
  472.   Halt(0);
  473.  
  474.  End;  { Configuration }
  475.  
  476. {---------------------------------------------------------------------------}
  477.  
  478. Procedure DefineArchivers (Var Archivers : tArchiverArray);
  479.  
  480.  Begin { DefineArchivers }
  481.  
  482.   With Archivers[1] Do
  483.     Begin
  484.       Name     := 'Zip       ';
  485.       Ext      := 'Zip ';
  486.       Filename := 'PkZip.Exe';
  487.       Compress := '-ex';
  488.     End;
  489.  
  490.   With Archivers[2] Do
  491.     Begin
  492.       Name     := 'Arj       ';
  493.       Ext      := 'Arj ';
  494.       Filename := 'Arj.Exe';
  495.       Compress := 'a -e';
  496.     End;
  497.  
  498.   With Archivers[3] Do
  499.     Begin
  500.       Name     := 'Lha       ';
  501.       Ext      := 'Lzh ';
  502.       Filename := 'Lha.Exe';
  503.       Compress := 'a';
  504.     End;
  505.  
  506.   With Archivers[4] Do
  507.     Begin
  508.       Name     := 'Rar       ';
  509.       Ext      := 'Rar ';
  510.       Filename := 'Rar.Exe';
  511.       Compress := 'a -m5';
  512.     End;
  513.  
  514.  End;  { DefineArchivers }
  515.  
  516. {---------------------------------------------------------------------------}
  517.  
  518. Procedure MakePath (Path : String);
  519. Var
  520.    Try    : Byte;
  521.    Slash  : Byte;
  522.    Error  : Word;
  523.    TmpDir : String;
  524.    IncDir : String;
  525.    NewDir : String;
  526.    OurDir : String;
  527.  
  528.  Begin { MakePath }
  529.  
  530.   NewDir := Path;
  531.   GetDir(0, OurDir);
  532.   While NewDir[Length (NewDir)] = '\' Do Dec (NewDir[0]);
  533.   IncDir := '';
  534.   Repeat
  535.      Slash := Pos('\', NewDir);
  536.      If (Slash <> 0) Then
  537.         Begin
  538.           IncDir := IncDir + Copy(NewDir, 1, Slash);
  539.           NewDir := Copy(NewDir, Slash + 1, Length(NewDir) - Slash);
  540.         End
  541.         Else IncDir := IncDir + NewDir;
  542.      TmpDir := IncDir;
  543.      If Length(TmpDir) > 3 Then
  544.         While TmpDir[Length(TmpDir)] = '\' Do Dec (TmpDir[0]);
  545.      Repeat
  546.         {$I-} ChDir(TmpDir); {$I+}
  547.         Error := IoResult;
  548.         If (Error <> 0) Then
  549.            Begin
  550.              {$I-} MkDir(TmpDir); {$I+}
  551.              Error := IoResult;
  552.            End;
  553.         If (Error <> 0) Then Inc(Try) Else Try := 0;
  554.       Until (Error = 0) or (Try > 3);
  555.   Until (Slash = 0) or (Error <> 0);
  556.   ChDir(OurDir);
  557.  
  558.  End;  { MakePath }
  559.  
  560. {---------------------------------------------------------------------------}
  561.  
  562. Procedure DrawHeader;
  563. Var TempStr : String[8];
  564.  
  565.  Begin { DrawHeader }
  566.  
  567.   GetDate(Year, Month, Day, DoW);
  568.   If ArcName <> '' then Prefix := ArcName else
  569.   If Config.UseDate then
  570.      Begin
  571.         Prefix := 'TGB-';
  572.         Str(Month, TempStr);
  573.         If Month < 10 then Prefix := Prefix + '0' + TempStr
  574.                       else Prefix := Prefix + TempStr;
  575.         Str(Day, TempStr);
  576.         If Day < 10 then Prefix := Prefix + '0' + TempStr
  577.                     else Prefix := Prefix + TempStr;
  578.      End else Prefix := 'TGBackup';
  579.  
  580.   TextColor(DarkGray);
  581.   GotoXY(13,7); Write('┌─────────────────--·[          ]·-──────────────────┐');
  582.   GotoXY(13,8); Write('│                                                    │');
  583.   GotoXY(13,9); Write('│                                                    │');
  584.   GotoXY(13,10);Write('│                                                    │');
  585.   GotoXY(13,11);Write('│                                                    │');
  586.   GotoXY(13,12);Write('│                                                    │');
  587.   GotoXY(13,13);Write('│                                                    │');
  588.   GotoXY(13,14);Write('└─────────────────--·[          ]·-──────────────────┘');
  589.  
  590.   TextColor(White);
  591.   GotoXY(36,7);  Write('Progress');
  592.   GotoXY(36,14); Write('Activity');
  593.  
  594.   TextColor(Cyan);
  595.   GotoXY(19,8);  Write('Main Directory');
  596.   GotoXY(19,9);  Write('Data Directory');
  597.   GotoXY(19,10); Write('File Directory');
  598.   GotoXY(19,11); Write('Lang Directory');
  599.   GotoXY(19,12); Write('Logs Directory');
  600.   GotoXY(48,8);  Write('Menu Directory');
  601.   GotoXY(48,9);  Write('Text Directory');
  602.   GotoXY(48,10); Write('Message Directory');
  603.   GotoXY(48,11); Write('Extra Directory 1');
  604.   GotoXY(48,12); Write('Extra Directory 2');
  605.   GotoXY(30,13); Write('Archiving ',Prefix + '.' + Archivers[Config.Archiver].Ext);
  606.  
  607.  End;  { DrawHeader }
  608.  
  609. {---------------------------------------------------------------------------}
  610.  
  611. Procedure Progress (Which  : Byte; Status : Byte);
  612.  
  613.  Begin { Progress }
  614.  
  615.   TextColor (LightCyan);
  616.   Window (1,1,80,25);
  617.  
  618.   Case Which of
  619.     1: GotoXY(17,8);
  620.     2: GotoXY(17,9);
  621.     3: GotoXY(17,10);
  622.     4: GotoXY(17,11);
  623.     5: GotoXY(17,12);
  624.  
  625.     6: GotoXY(46,8);
  626.     7: GotoXY(46,9);
  627.     8: GotoXY(46,10);
  628.     9: GotoXY(46,11);
  629.    10: GotoXY(46,12);
  630.  
  631.    11: GotoXY(28,13);
  632.    End; { Case }
  633.  
  634.   Case Status of
  635.     1: Begin
  636.          TextColor(LightCyan + Blink); Write ('∙');
  637.        End;
  638.     2: Write ('√');
  639.     3: Write ('-');
  640.    End; { Case }
  641.  
  642.  End;  { Progress }
  643.  
  644. {---------------------------------------------------------------------------}
  645.  
  646. Procedure Backup (Var Config : tConfigRec;
  647.                   Var Telegard : ConfigRec;
  648.                   Var Archivers : tArchiverArray);
  649. Var
  650.    Archiver : String[12];
  651.    Params   : String[120];
  652.    Path     : String[120];
  653.    Dest     : String[120];
  654.  
  655.  Begin { Backup }
  656.  
  657.   If Not DirExist(Config.BackupPath) then MakePath(Config.BackupPath);
  658.   Archiver := Archivers[Config.Archiver].Filename;
  659.   Dest     := Archivers[Config.Archiver].Compress;
  660.  
  661.   { Backup Main Directory }
  662.   If Config.Main Then
  663.      Begin
  664.        Progress(1,1);
  665.        Params   := Dest + ' ' + Config.BackupPath + 'Main.' +
  666.                    Archivers[Config.Archiver].Ext;
  667.        Path := Config.TelegardPath + Config.Masks[1];
  668.        WindowExec(Archiver,Params,Path);
  669.        Progress(1,2);
  670.      End
  671.      Else Progress (1,3);
  672.   TimeSlice;
  673.  
  674.   { Backup Data Directory }
  675.   If Config.Data Then
  676.      Begin
  677.        Progress(2,1);
  678.        Params   := Dest + ' ' + Config.BackupPath + 'Data.' +
  679.                    Archivers[Config.Archiver].Ext;
  680.        Path := Telegard.DataPath + Config.Masks[2];
  681.        WindowExec(Archiver,Params,Path);
  682.        Progress(2,2);
  683.      End
  684.      Else Progress (2,3);
  685.   TimeSlice;
  686.  
  687.   { Backup File Directory }
  688.   If Config.Files Then
  689.      Begin
  690.        Progress(3,1);
  691.        Params   := Dest + ' ' + Config.BackupPath + 'File.' +
  692.                    Archivers[Config.Archiver].Ext;
  693.        Path := Telegard.FilePath + Config.Masks[3];
  694.        WindowExec(Archiver,Params,Path);
  695.        Progress(3,2);
  696.      End
  697.      Else Progress (3,3);
  698.   TimeSlice;
  699.  
  700.   { Backup Language Directory }
  701.   If Config.Lang Then
  702.      Begin
  703.        Progress(4,1);
  704.        Params   := Dest + ' ' + Config.BackupPath + 'Lang.' +
  705.                    Archivers[Config.Archiver].Ext;
  706.        Path := Telegard.LangPath + Config.Masks[4];
  707.        WindowExec(Archiver,Params,Path);
  708.        Progress(4,2);
  709.      End
  710.      Else Progress (4,3);
  711.   TimeSlice;
  712.  
  713.   { Backup Logs Directory }
  714.   If Config.Logs Then
  715.      Begin
  716.        Progress(5,1);
  717.        Params   := Dest + ' ' + Config.BackupPath + 'Logs.' +
  718.                    Archivers[Config.Archiver].Ext;
  719.        Path := Telegard.LogsPath + Config.Masks[5];
  720.        WindowExec(Archiver,Params,Path);
  721.        Progress(5,2);
  722.      End
  723.      Else Progress (5,3);
  724.   TimeSlice;
  725.  
  726.   { Backup Menu Directory }
  727.   If Config.Menu Then
  728.      Begin
  729.        Progress(6,1);
  730.        Params   := Dest + ' ' + Config.BackupPath + 'Menu.' +
  731.                    Archivers[Config.Archiver].Ext;
  732.        Path := Telegard.MenuPath + Config.Masks[6];
  733.        WindowExec(Archiver,Params,Path);
  734.        Progress(6,2);
  735.       End
  736.       Else Progress(6,3);
  737.   TimeSlice;
  738.  
  739.   { Backup Text Directory }
  740.   If Config.Text Then
  741.      Begin
  742.        Progress(7,1);
  743.        Params   := Dest + ' ' + Config.BackupPath + 'Text.' +
  744.                    Archivers[Config.Archiver].Ext;
  745.        Path := Telegard.TextPath + Config.Masks[7];
  746.        WindowExec(Archiver,Params,Path);
  747.        Progress(7,2);
  748.      End
  749.      Else Progress(7,3);
  750.   TimeSlice;
  751.  
  752.   { Backup Message Directory }
  753.   If Config.Msgs Then
  754.      Begin
  755.        Progress(8,1);
  756.        Params   := Dest + ' ' + Config.BackupPath + 'Msgs.' +
  757.                    Archivers[Config.Archiver].Ext;
  758.        Path := Telegard.MsgPath + Config.Masks[8];
  759.        WindowExec(Archiver,Params,Path);
  760.        Progress(8,2);
  761.      End
  762.      Else Progress(8,3);
  763.   TimeSlice;
  764.  
  765.   { Backup Extra1 Directory }
  766.   If (Config.Extra1 <> '') and (DirExist(Config.Extra1)) Then
  767.      Begin
  768.        Progress(9,1);
  769.        Params   := Dest + ' ' + Config.BackupPath + 'Extra1.' +
  770.                    Archivers[Config.Archiver].Ext;
  771.        Path := Config.Extra1 + '*.*';
  772.        WindowExec(Archiver,Params,Path);
  773.        Progress(9,2);
  774.      End
  775.      Else Progress(9,3);
  776.   TimeSlice;
  777.  
  778.   { Backup Extra2 Directory }
  779.   If (Config.Extra2 <> '') and (DirExist(Config.Extra2)) Then
  780.      Begin
  781.        Progress(10,1);
  782.        Params   := Dest + ' ' + Config.BackupPath + 'Extra2.' +
  783.                    Archivers[Config.Archiver].Ext;
  784.        Path := Config.Extra2 + '*.*';
  785.        WindowExec(Archiver,Params,Path);
  786.        Progress(10,2);
  787.      End
  788.      Else Progress(10,3);
  789.   TimeSlice;
  790.  
  791.  End;  { Backup }
  792.  
  793. {---------------------------------------------------------------------------}
  794.  
  795. Procedure CompileBackups (Config : tConfigRec; Archivers : tArchiverArray);
  796. Var
  797.    Archiver : String[12];
  798.    Params   : String[120];
  799.    Path     : String[120];
  800.    Dest     : String[120];
  801.    TempStr  : String;
  802.    F        : File;
  803.  
  804.  Begin { CompileBackups }
  805.  
  806.   Archiver := Archivers[Config.Archiver].Filename;
  807.   Dest     := Archivers[Config.Archiver].Compress;
  808.   Path     := ' ';
  809.  
  810.   Progress(11,1);
  811.  
  812.   { Change to the Destination Directory }
  813.   TempStr := Config.BackupPath;
  814.   If (Length(TempStr) > 3) Then
  815.     While TempStr[Length(TempStr)] = '\' Do Dec(TempStr[0]);
  816.   ChDir(TempStr);
  817.  
  818.   { Erase existing backups with the same name }
  819.   If fExist (Prefix + '.' + Archivers[Config.Archiver].Ext) then
  820.      Begin
  821.        Assign(F,Prefix + '.' + Archivers[Config.Archiver].Ext);
  822.        Erase(F);
  823.      End;
  824.   TimeSlice;
  825.  
  826.   Params := Dest + ' ' + Config.BackupPath + Prefix + '.' +
  827.             Archivers[Config.Archiver].Ext;
  828.   If Config.Main Then Path := Path + 'Main.' + Archivers[Config.Archiver].Ext + ' ';
  829.   If Config.Data Then Path := Path + 'Data.' + Archivers[Config.Archiver].Ext + ' ';
  830.   If Config.Files Then Path := Path + 'File.' + Archivers[Config.Archiver].Ext + ' ';
  831.   If Config.Logs Then Path := Path + 'Lang.' + Archivers[Config.Archiver].Ext + ' ';
  832.   If Config.Logs Then Path := Path + 'Logs.' + Archivers[Config.Archiver].Ext + ' ';
  833.   If Config.Menu Then Path := Path + 'Menu.' + Archivers[Config.Archiver].Ext + ' ';
  834.   If Config.Text Then Path := Path + 'Text.' + Archivers[Config.Archiver].Ext + ' ';
  835.   If Config.Msgs Then Path := Path + 'Msgs.' + Archivers[Config.Archiver].Ext + ' ';
  836.   If fExist('Extra1.' + Archivers[Config.Archiver].Ext) or
  837.      fExist('Extra2.' + Archivers[Config.Archiver].Ext) then
  838.      Path := Path + 'Extra?.' + Archivers[Config.Archiver].Ext + ' ';
  839.   WindowExec(Archiver,Params,Path);
  840.   Progress(11,2);
  841.   TimeSlice;
  842.  
  843.  End;  { CompileBackups }
  844.  
  845. {---------------------------------------------------------------------------}
  846.  
  847. Procedure CleanUp (Config : tConfigRec; Archivers : tArchiverArray);
  848. Var
  849.    F     : File;
  850.    I     : Integer;
  851.    Files : Array [1..10] of String[12];
  852.  
  853.  Begin { CleanUp }
  854.  
  855.   Files[1] := 'Main.' + Archivers[Config.Archiver].Ext;
  856.   Files[2] := 'Data.' + Archivers[Config.Archiver].Ext;
  857.   Files[3] := 'File.' + Archivers[Config.Archiver].Ext;
  858.   Files[4] := 'Lang.' + Archivers[Config.Archiver].Ext;
  859.   Files[5] := 'Logs.' + Archivers[Config.Archiver].Ext;
  860.   Files[6] := 'Menu.' + Archivers[Config.Archiver].Ext;
  861.   Files[7] := 'Text.' + Archivers[Config.Archiver].Ext;
  862.   Files[8] := 'Msgs.' + Archivers[Config.Archiver].Ext;
  863.   Files[9] := 'Extra1.' + Archivers[Config.Archiver].Ext;
  864.   Files[10] := 'Extra2.' + Archivers[Config.Archiver].Ext;
  865.  
  866.   For I := 1 to 10 Do
  867.      If fExist(Files[I]) then
  868.         Begin
  869.           Assign(F,Files[I]);
  870.           Erase(F);
  871.         End;
  872.   TimeSlice;
  873.  
  874.  End;  { CleanUp }
  875.  
  876. {---------------------------------------------------------------------------}
  877.  
  878. Procedure AddToLog (Telegard : ConfigRec);
  879. Var
  880.    Log : Text;
  881.    Date : String[8];
  882.    Time : String[9];
  883.    St   : String[4];
  884.    Pm   : Boolean;
  885.  
  886.  Begin { AddToLog }
  887.  
  888.   GetDate(Year, Month, Day, DoW);
  889.   GetTime(Hour, Minute, Second, Sec100);
  890.   Date := ''; Time := '';
  891.  
  892.   Str(Month,St);
  893.   If Month < 10 Then Date := Date + '0' + St Else Date := Date + St;
  894.   Date := Date + '/';
  895.   Str(Day,St);
  896.   If Day < 10 Then Date := Date + '0' + St Else Date := Date + St;
  897.   Date := Date + '/';
  898.   Str(Year,St);
  899.   Delete(St,1,2);
  900.   Date := Date + St;
  901.  
  902.   Pm := (Hour > 12);
  903.   If Pm then Str(Hour-12,St) else Str(Hour,St);
  904.   If Hour < 10 then Time := Time + '0' + St else Time := Time + St;
  905.   Time := Time + ':';
  906.   Str(Minute,St);
  907.   If Minute < 10 then Time := Time + '0' + St else Time := Time + St;
  908.   Time := Time + ':';
  909.   Str(Second,St);
  910.   If Second < 10 then Time := Time + '0' + St else Time := Time + St;
  911.   If Pm then Time := Time + 'p' else Time := Time + 'a';
  912.  
  913.   Assign(Log,Telegard.LogsPath + 'Sysop.Log');
  914.   Append(Log);
  915.   Writeln(Log);
  916.   Writeln(Log,'                `08┌───────────────────────────────────────────────┐');
  917.   Writeln(Log,'                `08│                `0BTelegard Backup                `08│');
  918.   Writeln(Log,'                `08│`03-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-`08│');
  919.   Writeln(Log,'                `08│   `0FSystem backed up on ',Date,' at ',Time,'   `08│');
  920.   Writeln(Log,'                `08└───────────────────────────────────────────────┘`07');
  921.   Writeln(Log);
  922.   Close(Log);
  923.  
  924.  End;  { AddToLog }
  925.  
  926. {---------------------------------------------------------------------------}
  927.  
  928. Procedure Maintenance(Config : tConfigRec);
  929. Const
  930.  DaysPerMonth :
  931.  Array[1..12] of ShortInt = (031,028,031,030,031,030,031,031,030,031,030,031);
  932. Var
  933.   DT     : DateTime;
  934.   Target : LongInt;
  935.   fDate  : LongInt;
  936.   fUnix  : LongInt;
  937.   DirInfo: SearchRec;
  938.   F      : File;
  939.  
  940.  Begin { Maintenance }
  941.  
  942.   { Find target purge date ... }
  943.   GetDate(Year, Month, Day, DoW);
  944.   DT.Year := Year;   DT.Month := Month;   DT.Day  := Day;
  945.   PackUnixTime(DT,Target);
  946.   Target := Target - (Config.KeepDays * 86400);
  947.  
  948.   FindFirst(Config.BackupPath + 'TGB-????.*', Archive, DirInfo);
  949.   While DosError = 0 do
  950.     Begin
  951.       If IsNum(Copy(DirInfo.Name,5,4)) then
  952.         Begin
  953.           Assign(F,Config.BackupPath + DirInfo.Name);
  954.           {$I-} Reset(F); {$I+}
  955.           GetFTime(F,fDate);
  956.           UnPackTime(fDate,DT);
  957.           PackUnixTime(DT,fUnix);
  958.           Close(f);
  959.           If fUnix < Target then Erase(F);
  960.         End;
  961.       FindNext(DirInfo);
  962.     End;
  963.  
  964.  End; { Maintenance }
  965.  
  966. {---------------------------------------------------------------------------}
  967.  
  968. Procedure ParseCmdline;
  969. Var Count : Byte; St : String[8];
  970.  
  971.  Begin { ParseCmdline }
  972.  
  973.   For Count := 1 to ParamCount do
  974.     Begin
  975.        St := ParamStr(Count);
  976.        If (St[1] in ['-','/']) then
  977.        Case Upcase(St[2]) of
  978.          'A': Begin
  979.                 St := UpcaseStr(ParamStr(Count+1));
  980.                 If St = 'ZIP' then ArcType := 1 else
  981.                 If St = 'ARJ' then ArcType := 2 else
  982.                 If St = 'LHA' then ArcType := 3 else
  983.                 If St = 'RAR' then ArcType := 4 else
  984.                                    ArcType := 0;
  985.                 Inc(Count);
  986.               End;
  987.          'B': Begin
  988.                 ArcName := ParamStr(Count+1);
  989.                 Inc(Count);
  990.               End;
  991.          'C': Configuration;
  992.          'M': Begin
  993.                 ReadConfig(ConfigName);
  994.                 If Config.KeepDays <> 0 then
  995.                   Begin
  996.                     Maintenance(Config);
  997.                     Halt(0);
  998.                   End else
  999.                   Begin
  1000.                     TextColor(Cyan); Writeln;
  1001.                     Writeln('    Maintenance was not performed because no purge value has been set in');
  1002.                     Writeln('    TGBackup''s configuration. Run TGBackup -C to set a value for purging.');
  1003.                     Halt(2);
  1004.                   End;
  1005.               End;
  1006.         End; { Case }
  1007.     End;
  1008.  
  1009.  End; { ParseCmdline }
  1010.  
  1011. {---------------------------------------------------------------------------}
  1012. {                               .∙·Main·Body·∙.                             }
  1013. {---------------------------------------------------------------------------}
  1014.  
  1015. Begin { TGBackup }
  1016.  
  1017.  OrigPath := CurrentPath; { Store the current directory so we can return }
  1018.  ArcName  := '';
  1019.  
  1020.  DefineArchivers(Archivers);
  1021.  
  1022.  ProgInfo;
  1023.  OSDetect;
  1024.  If OperatingSystem <> _Dos then
  1025.    Begin
  1026.      Writeln;
  1027.      TextColor(Cyan);
  1028.      Write('Releasing timeslices under ');
  1029.      Case OperatingSystem of
  1030.         _DV : Write('DesqView');
  1031.        _Os2 : Write('OS/2');
  1032.        _Win : Write('Windows');
  1033.       End; { Case }
  1034.      Writeln(' v',OsMajor,'.',OsMinor,'.');
  1035.      TimeSlice;
  1036.      Delay(150);
  1037.      TimeSlice;
  1038.    End;
  1039.  
  1040.  If ParamCount > 0 then ParseCmdline;
  1041.  ReadConfig(ConfigName);
  1042.  ReadTelegard;
  1043.  
  1044.  { Override configured archiver via commandline }
  1045.  If ArcType <> 0 then Config.Archiver := ArcType;
  1046.  
  1047.  If Config.Fades then
  1048.     Begin
  1049.       TimeSlice;
  1050.       FadeOut(15);
  1051.       ClrScr;
  1052.       CursorOff;
  1053.       Move(Main,Screen,4000);
  1054.       GotoXY (43,3); TextColor(DarkGray); Write(Version);
  1055.       TimeSlice;
  1056.       FadeIn(15);
  1057.       TimeSlice;
  1058.     End else
  1059.     Begin
  1060.       ClrScr;
  1061.       CursorOff;
  1062.       Move(Main,Screen,4000);
  1063.       GotoXY (43,3); TextColor(DarkGray); Write(Version);
  1064.       TimeSlice;
  1065.     End;
  1066.  
  1067.  DrawHeader;
  1068.  Backup(Config,Telegard,Archivers);
  1069.  CompileBackups(Config,Archivers);
  1070.  CleanUp(Config,Archivers);
  1071.  If Config.KeepDays <> 0 then Maintenance(Config);
  1072.  
  1073.  AddToLog(Telegard);
  1074.  
  1075.  Window(1,1,80,25);
  1076.  If Config.Fades then
  1077.     Begin
  1078.       TimeSlice;
  1079.       FadeOut(15);
  1080.       ClrScr;
  1081.       ProgInfo;
  1082.       TimeSlice;
  1083.       FadeIn(15);
  1084.       TimeSlice;
  1085.     End else
  1086.     Begin
  1087.       ClrScr;
  1088.       ProgInfo;
  1089.       TimeSlice;
  1090.     End;
  1091.  
  1092.  {$I-} ChDir(OrigPath); {$I+}
  1093.  CursorOn;
  1094.  
  1095. End.  { TGBackup }