home *** CD-ROM | disk | FTP | other *** search
/ Beijing Paradise BBS Backup / PARADISE.ISO / software / BBSDOORW / MFM_119C.ZIP / COPYMOVE.PAS < prev    next >
Pascal/Delphi Source File  |  1993-06-03  |  14KB  |  408 lines
  1. Unit CopyMove;
  2. {========================================================================}
  3. Interface
  4.   Procedure CenterWrite(Row : Byte; CenteredString : String);
  5.   Function FileCopy(FromFileName, ToFileName, ToBbs : String; CopyOrMove : Char) : Boolean;
  6.   Procedure ShowSizeSpace(Drive : Char; Row : Byte);
  7.   Procedure CopyFile;
  8.   Procedure MoveFile;
  9.   Procedure MassMove;
  10.   Procedure MassCopy;
  11. {========================================================================}
  12. Implementation
  13.   Uses
  14.     AdoptIns, Crt, Display, Dos, General, MaxAreas, MfmCopy, MfmDefs, MfmStr,
  15.     PushPop, SaveKill, Screen, Setup;
  16. {========================================================================}
  17. Procedure CenterWrite(Row : Byte; CenteredString : String);
  18.   Begin
  19.     AnsiGotoXY(Row,1); AnsiClearToEOL;
  20.     AnsiGotoXY(Row,40-(Length(CenteredString) Div 2));
  21.     Write(CenteredString);
  22.   End;
  23. {========================================================================}
  24. Function FileCopy(FromFileName, ToFileName, ToBbs : String; CopyOrMove : Char) : Boolean;
  25.   Var
  26.     FromFile, ToFile : File;
  27.     OverWrite : Boolean;
  28.     Fcc : Char;
  29.     TempEntry : ListPtr;
  30.     ToFilesBbs : Text;
  31.   Begin
  32.     FileCopy := False; OverWrite := True;
  33.     FindFirst(FromFileName,AnyFile,DirInfo);
  34.     If DosError = 0 Then
  35.     Begin
  36.       FindFirst(ToFileName,AnyFile,DirInfo);
  37.       If DosError = 0 Then
  38.       Begin
  39.         OverWrite := False;
  40.         AnsiClearScreen; AnsiGotoXY(21,1);
  41.         NewTextColor(Black); NewTextBackground(Cyan);
  42.         Write(Pgmid+'      ^Q=quit ?=help');
  43.         NewTextColor(White); NewTextBackground(Black);
  44.         NextPrintEntry := CurrentEntry; DisplayRecord(22);
  45.         NewTextColor(White);
  46.         CenterWrite(23,'already exists as');
  47.         New(TempEntry);
  48.         TempEntry^.TypeOfRecord := FileRecord;
  49.         TempEntry^.FileName := DirInfo.Name;
  50.         TempEntry^.FileDate := DirInfo.Time;
  51.         TempEntry^.FileSize := DirInfo.Size;
  52.         Assign(ToFilesBbs,ToBbs);
  53.         {$I-} Reset(ToFilesBbs); {$I+}
  54.         If IOresult = 0 Then
  55.         Begin
  56.           FSplit(ToFileName,D,N,E);
  57.           While (Not Eof(ToFilesBbs)) Do
  58.           Begin
  59.             ReadLn(ToFilesBbs,WorkString);
  60.             If Pos(N+E,WorkString) > 0 Then
  61.             Begin
  62.               TempEntry^.Description := AllTrim(Copy(WorkString,Pos(' ',WorkString)+1,255));
  63.             End;
  64.           End;
  65.           Close(ToFilesBbs);
  66.         End
  67.         Else
  68.         Begin
  69.           TempEntry^.Description := '';
  70.         End;
  71.         TempEntry^.Tagged := False;
  72.         NextPrintEntry := TempEntry; DisplayRecord(24);
  73.         Dispose(TempEntry);
  74.         NewTextColor(White);
  75.         CenterWrite(25,'Overwrite? (Y/N) ');
  76.         Repeat
  77.           Gbx := GetInput;
  78.           Fcc := Upcase(Chr(Gbx));
  79.         Until Fcc In ['N','Y'];
  80.         Write(Fcc);
  81.         If Fcc = 'Y' Then OverWrite := True;
  82.       End;
  83.       If OverWrite Then
  84.       Begin
  85.         If (CopyOrMove = 'M') And (Copy(FromFileName,1,1) = Copy(ToFileName,1,1)) Then
  86.         Begin
  87.           CenterWrite(22,'Moving');
  88.           CenterWrite(23,FromFileName);
  89.           CenterWrite(24,'to');
  90.           CenterWrite(25,ToFileName);
  91.           MyRename(FromFileName,ToFileName);
  92.         End
  93.         Else
  94.         Begin
  95.           If CopyOrMove = 'C' Then CenterWrite(22,'Copying ') Else CenterWrite(22,'Moving ');
  96.           CenterWrite(23,FromFileName);
  97.           CenterWrite(24,'to');
  98.           CenterWrite(25,ToFileName);
  99.           DoFileCopy(FromFileName,ToFileName);
  100.           If CopyOrMove = 'M' Then MyErase(FromFileName);
  101.         End;
  102.         FileCopy := True;
  103.       End;
  104.     End;
  105.   End;
  106. {========================================================================}
  107. Procedure ShowSizeSpace(Drive : Char; Row : Byte);
  108.   Begin
  109.     Drive := UpCase(Drive);
  110.     AnsiGotoXY(Row,1);
  111.     NewTextColor(Black);
  112.     NewTextBackground(Cyan);
  113.     AnsiClearToEol;
  114.     Write(CurrentEntry^.FileName+' is ',CurrentEntry^.FileSize Div 1024,'K bytes in size!   There are ');
  115.     Write(DiskFree(Ord(Drive)-64) Div 1024);
  116.     Write('K bytes free on drive '+Drive+'.');
  117.     NewTextColor(White); NewTextBackground(Black);
  118.   End;
  119. {========================================================================}
  120. Procedure AddDescToBbs(ToFilesBbs : PathStr);
  121.   Var
  122.     ToFilesMfm : PathStr;
  123.   Begin
  124.     If Pos('.',ToFilesBbs) > 0 Then
  125.     Begin
  126.       ToFilesMfm := Copy(ToFilesBbs,1,Pos('.',ToFilesBbs)-1)+'.MFM';
  127.     End
  128.     Else
  129.     Begin
  130.       ToFilesMfm := ToFilesBbs+'.MFM';
  131.     End;
  132.     If FileExist(ToFilesBbs) Then
  133.     Begin
  134.       Changed := False;
  135.       Assign(FileList,ToFilesBbs);
  136.       Reset(FileList);
  137.       Assign(NewFileList,ToFilesMfm);
  138.       Rewrite(NewFileList);
  139.       While (Not Eof(FileList)) Do
  140.       Begin
  141.         ReadLn(FileList,WorkString);
  142.         If Pos(CurrentEntry^.FileName,WorkString) = 1 Then
  143.         Begin
  144.           WriteLn(NewFileList,CurrentEntry^.FileName+' '+CurrentEntry^.Description);
  145.           Changed := True;
  146.         End
  147.         Else
  148.         Begin
  149.           WriteLn(NewFileList,WorkString);
  150.         End;
  151.       End;
  152.       If (Not Changed) Then WriteLn(NewFileList,CurrentEntry^.FileName+' '+CurrentEntry^.Description);
  153.       Close(FileList); Close(NewFileList);
  154.       MyRename(ToFilesBbs,Copy(ToFilesMfm,1,Pos('.',ToFilesMfm)-1)+'.BAK');
  155.       MyRename(ToFilesMfm,ToFilesBbs);
  156.     End
  157.     Else
  158.     Begin
  159.       Assign(FileList,ToFilesMfm);
  160.       ReWrite(FileList);
  161.       WriteLn(FileList,CurrentEntry^.FileName+' '+CurrentEntry^.Description);
  162.       Close(FileList);
  163.       MyRename(ToFilesBbs,Copy(ToFilesMfm,1,Pos('.',ToFilesMfm)-1)+'.BAK');
  164.       MyRename(ToFilesMfm,ToFilesBbs);
  165.     End;
  166.   End;
  167. {========================================================================}
  168. Procedure CopyFile;
  169.   Var
  170.     ToAreaPath, ToFilesBbs, ToFilesMfm : PathStr;
  171.     Cfc : Char;
  172.   Begin
  173.     If CurrentEntry^.TypeOfRecord = FileRecord Then
  174.     Begin
  175.       SetupScreen;
  176.       AnsiGotoXY(25,1); AnsiClearToEOL;
  177.       Write(FileAreaPath+CurrentEntry^.FileName);
  178.       Result := SelectArea(AreaPath,ToAreaPath,ToFilesBbs,OldArea);
  179.       If Result = 0 Then
  180.       Begin
  181.         ShowSizeSpace(ToAreaPath[1],24);
  182.         If CurrentEntry^.FileSize < (DiskFree(Ord(UpCase(ToAreaPath[1]))-64)-(SizeOfFilesBbs(ToAreaPath)+2048)) Then
  183.         Begin
  184.           ShowSizeSpace(ToAreaPath[1],21);
  185.           CenterWrite(22,FileAreaPath+CurrentEntry^.FileName);
  186.           CenterWrite(23,'to');
  187.           CenterWrite(24,ToAreaPath+CurrentEntry^.FileName);
  188.           CenterWrite(25,'Proceed with COPY? (Y/N) ');
  189.           Repeat
  190.             Gbx := GetInput;
  191.             Cfc := Upcase(Chr(Gbx));
  192.           Until Cfc In ['N','Y'];
  193.           Write(Cfc);
  194.           If Cfc = 'Y' Then
  195.           Begin
  196.             If FileCopy(FileAreaPath+CurrentEntry^.FileName,ToAreaPath+CurrentEntry^.FileName,ToFilesBbs,'C') Then
  197.             Begin
  198.               AddDescToBbs(ToFilesBbs);
  199.             End;
  200.           End;
  201.           ReDrawScreen;
  202.         End
  203.         Else
  204.         Begin
  205.           ReDrawScreen;
  206.           AnsiGotoXY(25,1); AnsiClearToEOL;
  207.           Write('There is not enough space on drive '+ToAreaPath[1]+' to complete the copy!');
  208.         End;
  209.       End
  210.       Else ReDrawScreen;
  211.     End;
  212.   End;
  213. {========================================================================}
  214. Procedure MoveFile;
  215.   Var
  216.     ToAreaPath, ToFilesBbs : PathStr;
  217.     Mfc : Char;
  218.     FileToErase : File;
  219.   Begin
  220.     If CurrentEntry^.TypeOfRecord = FileRecord Then
  221.     Begin
  222.       SetupScreen;
  223.       AnsiGotoXY(25,1); AnsiClearToEOL;
  224.       Write(FileAreaPath+CurrentEntry^.FileName);
  225.       Result := SelectArea(AreaPath,ToAreaPath,ToFilesBbs,OldArea);
  226.       If Result = 0 Then
  227.       Begin
  228.         ShowSizeSpace(ToAreaPath[1],24);
  229.         If (CurrentEntry^.FileSize < (DiskFree(Ord(UpCase(ToAreaPath[1]))-64))-(SizeOfFilesBbs(ToAreaPath)+2048))
  230.           Or (FileAreaPath[1] = ToAreaPath[1]) Then
  231.         Begin
  232.           ShowSizeSpace(ToAreaPath[1],21);
  233.           CenterWrite(22,FileAreaPath+CurrentEntry^.FileName);
  234.           CenterWrite(23,'to');
  235.           CenterWrite(24,ToAreaPath+CurrentEntry^.FileName);
  236.           CenterWrite(25,'Proceed with MOVE? (Y/N) ');
  237.           Repeat
  238.             Gbx := GetInput;
  239.             Mfc := Upcase(Chr(Gbx));
  240.           Until Mfc In ['N','Y'];
  241.           Write(Mfc);
  242.           If Mfc = 'Y' Then
  243.           Begin
  244.             If FileCopy(FileAreaPath+CurrentEntry^.FileName,ToAreaPath+CurrentEntry^.FileName,ToFilesBbs,'M') Then
  245.             Begin
  246.               AddDescToBbs(ToFilesBbs);
  247.               PushRecord(KillEntry);
  248.               OldEntry := KillEntry;
  249.               If KillEntry^.PrevEntry = KillEntry Then
  250.               Begin
  251.                 Dispose(KillEntry);
  252.                 KillEntry := NIL;
  253.               End
  254.               Else
  255.               Begin
  256.                 KillEntry^.PrevEntry^.NextEntry := KillEntry^.NextEntry;
  257.                 KillEntry^.NextEntry^.PrevEntry := KillEntry^.PrevEntry;
  258.                 KillEntry := KillEntry^.NextEntry;
  259.               End;
  260.               If KillEntry <> NIL Then Dispose(OldEntry);
  261.             End;
  262.           End;
  263.           ReDrawScreen;
  264.         End
  265.         Else
  266.         Begin
  267.           ReDrawScreen;
  268.           AnsiGotoXY(25,1); AnsiClearToEOL;
  269.           Write('There is not enough space on drive '+ToAreaPath[1]+' to complete the move!');
  270.         End;
  271.       End
  272.       Else ReDrawScreen;
  273.     End;
  274.   End;
  275. {========================================================================}
  276. Procedure MassMove;
  277.   Var
  278.     ToAreaPath, ToFilesBbs : PathStr;
  279.     TempEntry : ListPtr;
  280.     Mmc : Char;
  281.     MoveOk : Boolean;
  282.   Begin
  283.     SetupScreen;
  284.     CenterWrite(25,'Select destination for MASS MOVE...');
  285.     Result := SelectArea(AreaPath,ToAreaPath,ToFilesBbs,OldArea);
  286.     If Result = 0 Then
  287.     Begin
  288.       CenterWrite(25,'Proceed with MASS MOVE? (Y/N) ');
  289.       Repeat
  290.         Gbx := GetInput;
  291.         Mmc := Upcase(Chr(Gbx));
  292.       Until Mmc In ['N','Y'];
  293.       Write(Mmc);
  294.       If Mmc = 'Y' Then
  295.       Begin
  296.         TempEntry := CurrentEntry;
  297.  
  298.         CurrentEntry := FirstEntry;
  299.         While CurrentEntry^.NextEntry <> NIL Do
  300.         Begin
  301.           CurrentEntry := CurrentEntry^.NextEntry;
  302.         End;
  303.         If CurrentEntry^.Tagged Then InsertBlank('A');
  304.  
  305.         CurrentEntry := FirstEntry;
  306.         While CurrentEntry^.NextEntry <> NIL Do
  307.         Begin
  308.           MoveOk := False;
  309.           If CurrentEntry^.Tagged Then
  310.           Begin
  311.             ShowSizeSpace(ToAreaPath[1],24);
  312.             If (CurrentEntry^.FileSize < (DiskFree(Ord(UpCase(ToAreaPath[1]))-64))-(SizeOfFilesBbs(ToAreaPath)+2048))
  313.               Or (FileAreaPath[1] = ToAreaPath[1]) Then
  314.             Begin
  315.               ShowSizeSpace(ToAreaPath[1],21);
  316.               If FileCopy(FileAreaPath+CurrentEntry^.FileName,ToAreaPath+CurrentEntry^.FileName,ToFilesBbs,'M') Then
  317.               Begin
  318.                 AddDescToBbs(ToFilesBbs);
  319.                 MoveOk := True;
  320.                 PushRecord(KillEntry);
  321.                 OldEntry := KillEntry;
  322.                 If KillEntry^.PrevEntry = KillEntry Then
  323.                 Begin
  324.                   Dispose(KillEntry);
  325.                   KillEntry := NIL;
  326.                 End
  327.                 Else
  328.                 Begin
  329.                   KillEntry^.PrevEntry^.NextEntry := KillEntry^.NextEntry;
  330.                   KillEntry^.NextEntry^.PrevEntry := KillEntry^.PrevEntry;
  331.                   KillEntry := KillEntry^.NextEntry;
  332.                 End;
  333.                 If KillEntry <> NIL Then Dispose(OldEntry);
  334.               End;
  335.             End
  336.             Else
  337.             Begin
  338.               ReDrawScreen;
  339.               AnsiGotoXY(25,1); AnsiClearToEOL;
  340.               Write('There is not enough space on drive '+ToAreaPath[1]+' to complete the move!');
  341.             End;
  342.           End;
  343.           If (Not MoveOk) Then CurrentEntry := CurrentEntry^.NextEntry;
  344.         End;
  345.       End;
  346.     End;
  347.     CurrentEntry := TopEntry; Row := 1;
  348.     SetupScreen; DisplayScreen;
  349.   End;
  350. {========================================================================}
  351. Procedure MassCopy;
  352.   Var
  353.     ToAreaPath, ToFilesBbs : PathStr;
  354.     TempEntry : ListPtr;
  355.     Mcc : Char;
  356.     CopyOk : Boolean;
  357.   Begin
  358.     SetupScreen;
  359.     CenterWrite(25,'Select area to MASS COPY to...');
  360.     Result := SelectArea(AreaPath,ToAreaPath,ToFilesBbs,OldArea);
  361.     If Result = 0 Then
  362.     Begin
  363.       CenterWrite(25,'Proceed with MASS COPY? (Y/N) ');
  364.       Repeat
  365.         Gbx := GetInput;
  366.         Mcc := Upcase(Chr(Gbx));
  367.       Until Mcc In ['N','Y'];
  368.       Write(Mcc);
  369.       If Mcc = 'Y' Then
  370.       Begin
  371.         TempEntry := CurrentEntry;
  372.         CurrentEntry := FirstEntry;
  373.         While CurrentEntry^.NextEntry <> NIL Do
  374.         Begin
  375.           CopyOk := False;
  376.           If CurrentEntry^.Tagged Then
  377.           Begin
  378.             ShowSizeSpace(ToAreaPath[1],24);
  379.             If (CurrentEntry^.FileSize < (DiskFree(Ord(UpCase(ToAreaPath[1]))-64))-(SizeOfFilesBbs(ToAreaPath)+2048))
  380.               Or (FileAreaPath[1] = ToAreaPath[1]) Then
  381.             Begin
  382.               ShowSizeSpace(ToAreaPath[1],21);
  383.               If FileCopy(FileAreaPath+CurrentEntry^.FileName,ToAreaPath+CurrentEntry^.FileName,ToFilesBbs,'C') Then
  384.               Begin
  385.                 AddDescToBbs(ToFilesBbs);
  386.                 CopyOk := True;
  387.               End;
  388.             End
  389.             Else
  390.             Begin
  391.               ReDrawScreen;
  392.               AnsiGotoXY(25,1); AnsiClearToEOL;
  393.               Write('There is not enough space on drive '+ToAreaPath[1]+' to complete the copy!');
  394.             End;
  395.           End;
  396.           CurrentEntry^.Tagged := False;
  397.           If (Not CopyOk) Then CurrentEntry := CurrentEntry^.NextEntry;
  398.         End;
  399.       End;
  400.     End;
  401.     CurrentEntry := TopEntry; Row := 1;
  402.     SetupScreen; DisplayScreen;
  403.   End;
  404. {========================================================================}
  405. Begin
  406. End.
  407. {========================================================================}
  408.