home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / BBS / RA / MOVEAREA.ZIP / MOVEAREA.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1991-07-10  |  4.1 KB  |  135 lines
  1. Uses Crt;
  2.  
  3. Type
  4.  
  5.   FILESrecord    = record
  6.                      Name           : String[30];
  7.                      Attrib         : Byte;
  8.                      FilePath       : String[40];
  9.                      FreeSpace      : Array[1..41] of Byte;
  10.                      Security       : Word;
  11.                      Flags          : Array[1..4] of Byte;
  12.                      PrivateSecurity: Word;
  13.                      PrivateFlags   : Array[1..4] of Byte;
  14.                    end;
  15.  
  16. Var
  17.   FILES                    : Array[1..200] of FILESrecord;
  18.   InFile, OutFile, OldFile : File of FILESrecord;
  19.   X                        : Word;
  20.   streg                    : String[80];
  21.   Txt                      : Text;
  22.  
  23. Function BlankAfter(Txt : String; Lgd : Byte): String;
  24. Begin
  25.   Txt:=Copy(Txt,1,Lgd);
  26.   While Length(Txt)<Lgd Do Txt:=Txt+' ';
  27.   BlankAfter:=Txt;
  28. End;
  29.  
  30. Function StIntRight(Tal: LongInt; Felt: Byte): String;
  31. Var
  32.   Streng         : String;
  33. Begin
  34.   Str(Tal: Felt, Streng);
  35.   If Length(Streng) > Felt Then Streng:='*'+
  36.     Copy(Streng,Length(Streng)-Felt+2,Length(Streng));
  37.   StIntRight:=Streng;
  38. End;
  39.  
  40. Procedure FilesRaTxt(Tekst : String);
  41. Begin
  42.   If Tekst<>'' Then WriteLn(Txt,Tekst);
  43.   WriteLn(Txt,Streg);
  44.   WriteLn(Txt,'  # │ RemoteAccess area              │ FilePath                       │ Sec. ');
  45.   WriteLn(Txt,Streg);
  46.   For x:=1 to 200 Do
  47.   If (Files[x].Name<>'') Or (Files[x].filepath<>'') Then
  48.     WriteLn(Txt,StIntRight(x,3)+' │ '+BlankAfter(Files[x].name,30)+' │ '+
  49.                 Copy(BlankAfter(Files[x].filepath,40),1,30)+' │ '+StIntRight(FILES[x].security,5));
  50.   WriteLn(Txt,streg);
  51.   WriteLn(Txt);
  52. End;
  53.  
  54. Function StrToInt(S: String) : LongInt;
  55. Var
  56.   Kode : Integer;
  57.   i    : LongInt;
  58. Begin
  59.   If Length(S) = 0 Then StrToInt := 0 Else Begin
  60.     Val(S,i,Kode);
  61.     If Kode = 0 Then StrToInt := i Else StrToInt := 0;
  62.   End;
  63. End;
  64.  
  65. Procedure MoveAreas(s,st,m : String);
  66. Var  start, stop, moveto : Word;
  67. Begin
  68.   Start:=StrToInt(s);
  69.   Stop:=StrToInt(st);
  70.   MoveTo:=StrToInt(m);
  71.   If (Start < 1) or (Start > 200) or (Stop < 1) or (Stop > 200) or
  72.      (MoveTo < 1) or (MoveTo > 200) Then
  73.   Begin
  74.     WriteLn('Start, Stop and MoveTo must be in the range of 1-200');
  75.     Halt(1);
  76.   End;
  77.   If Stop < Start Then
  78.   Begin
  79.     WriteLn('Stop must be => than Start');
  80.     Halt(1);
  81.   End;
  82.   WriteLn(#10'Moving areas ',start,'-',stop,' to areas ',moveto,'-',moveto+stop-start);
  83.   For x:=Start to Stop Do
  84.   Begin
  85.     Move(FILES[x],FILES[MoveTo+x-Start],Sizeof(FILES[x]));
  86.     Fillchar(FILES[x],sizeof(FILES[x]),0);
  87.   End;
  88.   Assign(OutFile,'FILES.NEW');
  89.   Rewrite(OutFile);
  90.   For x:=1 to 200 Do Write(OutFile,FILES[x]);
  91.   Close(OutFile);
  92.   Assign(OldFile,'FILES.OLD');
  93.   {$I-}
  94.   Erase(OldFile);
  95.   {$I+}
  96.   x:=IOResult;
  97.   Rename(InFile,'FILES.OLD');
  98.   Rename(OutFile,'FILES.RA');
  99. End;
  100.  
  101. Begin
  102.   Streg:='─────────────────────────────────────────────────────────────────────────────';
  103.   TextAttr:=15;
  104.   ClrScr;
  105.   TextAttr:=7*16;
  106.   WriteLn(Streg);
  107.   WriteLn('        BBC''s MOVEAREAS for FILES.RA (RemoteAccess) version 1.00             ');
  108.   WriteLn('                    Thanks for using one of my tools                         ');
  109.   WriteLn(Streg);
  110.   TextAttr:=15;
  111.   FillChar(Files,Sizeof(Files),0);
  112.   Assign(InFile, 'FILES.RA');
  113.   Reset(InFile);
  114.   For x:=1 to 200 Do Read(InFile,FILES[x]);
  115.   Close(InFile);
  116.   Assign(Txt,'FILESRA.TXT');
  117.   Rewrite(Txt);
  118.   WriteLn(Txt,'Thanx for using my RA tool made by Bo Bendtsen 2:231/111, Date 10-jul-91');
  119.   WriteLn(#10#10'FILESRA.TXT has been made in current directory');
  120.   If paramcount <> 3 Then
  121.   Begin
  122.     WriteLn(#10#10#13'Syntax is:  MOVEAREA Start Stop MoveTo');
  123.     WriteLn('            MOVEAREA 20 30 100   <- Move areas 20-30 to 100-110');
  124.     WriteLn('            DONT use overlapping 20 30 25, use instead 20 30 180 & 180 190 25');
  125.     WriteLn('            or change the sourcekode to you needs');
  126.     FilesRaTxt('');
  127.   End
  128.   Else Begin
  129.     FilesRaTxt('Before Moving any areas');
  130.     MoveAreas(ParamStr(1), ParamStr(2), ParamStr(3));
  131.     FilesRaTxt('After Moving areas');
  132.   End;
  133.   Close(Txt);
  134.  
  135. End.