home *** CD-ROM | disk | FTP | other *** search
/ Beijing Paradise BBS Backup / PARADISE.ISO / software / BBSDOORW / MFM_119C.ZIP / SAVEKILL.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-06-03  |  4.6 KB  |  150 lines
  1. Unit SaveKill;
  2. {========================================================================}
  3. Interface
  4.   Uses
  5.     Dos, MfmDefs;
  6.   Function SizeOfFilesBbs(FileArea : String) : LongInt;
  7.   Function InMainList(TempEntry : ListPtr) : Boolean;
  8.   Procedure EraseKillList;
  9.   Procedure Mfm2Bbs2Bak(InString : PathStr);
  10.   Procedure SaveList;
  11. {========================================================================}
  12. Implementation
  13.   Uses
  14.     MfmStr, Screen;
  15. {========================================================================}
  16. Function SizeOfFilesBbs(FileArea : String) : LongInt;
  17.   Var
  18.     FilesBbs : File Of Byte;
  19.     SizeOfFile : LongInt;
  20.   Begin
  21.     Assign(FilesBbs,FileArea+'FILES.BBS');
  22.     {$I-} Reset(FilesBbs); {$I+}
  23.     If IOresult = 0 Then
  24.     Begin
  25.       SizeOfFilesBbs := FileSize(FilesBbs);
  26.       Close(FilesBbs);
  27.     End
  28.     Else
  29.     Begin
  30.       SizeOfFilesBbs := 0;
  31.     End;
  32.   End;
  33. {========================================================================}
  34. Function InMainList(TempEntry : ListPtr) : Boolean;
  35.   Begin
  36.     NextPrintEntry := FirstEntry; InMainList := False;
  37.     While NextPrintEntry^.NextEntry <> NIL Do
  38.     Begin
  39.       If NextPrintEntry^.FileName = TempEntry^.FileName Then InMainList := True;
  40.       NextPrintEntry := NextPrintEntry^.NextEntry;
  41.     End;
  42.   End;
  43. {========================================================================}
  44. Procedure EraseKillList;
  45.   Var
  46.     FileToErase : File;
  47.   Begin
  48.     While KillEntry <> NIL Do
  49.     Begin
  50.       FindFirst(FileAreaPath+KillEntry^.FileName,Archive,DirInfo);
  51.       If DosError = 0 Then
  52.       Begin
  53.         If (Not InMainList(KillEntry)) Then
  54.         Begin
  55.           If UpperString(KillEntry^.FileName) <> 'FILES.BBS' Then
  56.           Begin
  57.             Assign(FileToErase,FileAreaPath+KillEntry^.FileName);
  58.             Erase(FileToErase);
  59.           End;
  60.         End;
  61.       End;
  62.       OldEntry := KillEntry;
  63.       If KillEntry^.PrevEntry = KillEntry Then
  64.       Begin
  65.         Dispose(KillEntry);
  66.         KillEntry := NIL;
  67.       End
  68.       Else
  69.       Begin
  70.         KillEntry^.PrevEntry^.NextEntry := KillEntry^.NextEntry;
  71.         KillEntry^.NextEntry^.PrevEntry := KillEntry^.PrevEntry;
  72.         KillEntry := KillEntry^.NextEntry;
  73.       End;
  74.       If KillEntry <> NIL Then Dispose(OldEntry);
  75.     End;
  76.   End;
  77. {========================================================================}
  78. Procedure Mfm2Bbs2Bak(InString : PathStr);
  79.   Var
  80.     TmpFilVar : Text;
  81.   Begin
  82.     FindFirst(InString+'FILES.BAK',AnyFile,DirInfo);
  83.     If DosError = 0 Then
  84.     Begin
  85.       Assign(TmpFilVar,InString+'FILES.BAK');
  86.       Erase(TmpFilVar);
  87.     End;
  88.     FindFirst(InString+'FILES.BBS',AnyFile,DirInfo);
  89.     If DosError = 0 Then
  90.     Begin
  91.       Assign(TmpFilVar,InString+'FILES.BBS');
  92.       Rename(TmpFilVar,InString+'FILES.BAK');
  93.     End;
  94.     Assign(TmpFilVar,InString+'FILES.MFM');
  95.     Rename(TmpFilVar,InString+'FILES.BBS');
  96.   End;
  97. {========================================================================}
  98. Procedure SaveList;
  99.   Var
  100.     Slc : Char;
  101.   Begin
  102.     AnsiGotoXY(25,1); AnsiClearToEOL;
  103.     Write('This will DELETE killed files and update FILES.BBS, Are you sure? ');
  104.     Repeat
  105.       Gbx := GetInput;
  106.       Slc := Upcase(Chr(Gbx));
  107.     Until Slc In ['N','Y'];
  108.     Write(Slc);
  109.     If Slc = 'Y' Then
  110.     Begin
  111.       Assign(FileList,FileAreaPath+'FILES.MFM');
  112.       {$I-} ReWrite(FileList); {$I+}
  113.       If IOresult = 0 Then
  114.       Begin
  115.         NextPrintEntry := FirstEntry;
  116.         While NextPrintEntry^.NextEntry <> NIL Do
  117.         Begin
  118.           If NextPrintEntry^.TypeOfRecord <> Orphan Then
  119.           Begin
  120.             If NextPrintEntry^.TypeOfRecord <> Comment Then
  121.             Begin
  122.               Write(FileList,NextPrintEntry^.FileName);
  123.               Write(FileList,Copy('         ',1,13-Length(NextPrintEntry^.FileName))+' ');
  124.             End;
  125.             WriteLn(FileList,NextPrintEntry^.Description);
  126.           End;
  127.           NextPrintEntry := NextPrintEntry^.NextEntry;
  128.         End;
  129.         If NextPrintEntry^.TypeOfRecord <> Orphan Then
  130.         Begin
  131.           Write(FileList,NextPrintEntry^.FileName);
  132.           Write(FileList,' ');
  133.           WriteLn(FileList,NextPrintEntry^.Description);
  134.         End;
  135.         Close(FileList);
  136.         Mfm2Bbs2Bak(FileAreaPath);
  137.         EraseKillList;
  138.         AnsiGotoXY(25,1); AnsiClearToEOL;
  139.       End;
  140.       AreaChanged := True;
  141.       Altered := False;
  142.     End
  143.     Else Write('N');
  144.     AnsiGotoXY(24,80);
  145.   End;
  146. {========================================================================}
  147. Begin
  148. End.
  149. {========================================================================}
  150.