Program BIOSCOPY Version 3

{ A_RENAME.PAS                                                       }
{                                                                    }
{ Soucast programu BIOSCOPY na kopirovani vadnych souboru z diskety  }
{ do aktualniho adresare.                                            }
{                                                                    }
{ Datum:21.06.2002                              http://www.trsek.com }
 
{$D-,E-,G+,I-,L-,N-,P+,Q-,R-,S-,T-,V-,Y- exe}
{B+,D+,L+,I+,Q+,R+,S+,T+,V+,Y+ ladici}
 
{$G+ 80286 a vyssi }
{$N+ podpora koprocesoru }
{$E- emulace koprocesoru }
 
Unit A_ReName;
Interface
Uses A_Norton;
 
	Procedure ReName;
 
Implementation
 
Uses P_Bios,U_Disket;
Const
   MaxHelpReName = 6;      {0+ radky, musi byt mensi nebo rovno MaxHelp}
	Zadejfiltr = 'Filtr: ';
   DelkaZadej = Length(Zadejfiltr);
   Filtr     :String = '[N].[E]';
   MaxIn = MaxSirka - 2;
Var
	ReMain,RePredel:String[MaxIn];
 
 
 
 
 
Function DejNameOnly(Index:Word):String;
Var
	S:String;
Begin
	S := DejName(Index);
	IF Pos('.',S) <> 0 Then While S[Length(S)] <> '.' Do Delete(S,Length(S),1);
   IF S[Length(S)] = '.' Then Delete(S,Length(S),1);
   DejNameOnly := DOSNameFiltr(S);
End;
 
 
Function DejExtensionOnly(Index:Word):String;
Var
	S:String;
Begin
	S := DejName(Index);
   IF Pos('.',S) = 0 Then S := ''
   Else While Pos('.',S) <> 0 Do Delete(S,1,Pos('.',S));
	DejExtensionOnly := DOSNameFiltr(S);
End;
 
 
 
Procedure ReNameTabulka;
Var
   a:Byte;
Begin
	For a := 0 To MaxPoloz Do
		_PisXYAString(NortonX + 1,NortonY+1+a,ColorPoza+ColorAdre,ReMain);
	_PisXYAString(NortonX +             3,NortonY+1,ColorPoza+ColorZvyr,'Old Name');
	_PisXYAString(NortonX + MaxSirka - 11,NortonY+1,ColorPoza+ColorZvyr,'New Name');
	_PisXYAString(NortonX + 1,NortonY + MaxVyska - 4,ColorPoza+ColorAdre,RePredel);
   For a := MaxVyska - 3 To MaxVyska - 2 Do
		_PisXYAString(NortonX + 1,NortonY + a,ColorPoza+ColorNorm,' ' + InEmpty + ' ');
	_PisXYAString(NortonX + 2,NortonY + MaxVyska - 3,ColorPoza+ColorZvyr,Zadejfiltr);
End;
 
 
 
Procedure HelpReName;
Const
	HelpReName:Array[0..MaxHelpReName] of String = (
		'Filtr muze obsahovat:',
      '',
		'A..Z,0..9,~,!,@,#,$,%,^,&,(,),_,-,{,},'',`',
      'ASCII 128..255',
		'[N#-#] kopiruje puvodni nazev, [N]=[N1-8]',
		'[E#-#] kopiruje puvodni priponu, [E]=[E1-3]',
		'[C###] pocitadlo, ### urcuje pocatek a delku');
Var
	a:byte;
Begin
	For a := 1 To MaxVyska - 2 Do
		_PisXYAString(NortonX    ,NortonY + a,ColorPoza+ColorAdre,Empty);
	For a := 0 To MaxHelpReName Do
		_PisXYAString(NortonX + 3,NortonY + 1 + a + Ord(MaxVyska - 3 > MaxHelpReName),ColorPoza+ColorNorm,HelpReName[a]);
	Pause;
   ReNameTabulka;
End;
 
 
 
 
 
 
Function TestReName(Index:Word):Boolean;
Begin
	IF ((Index = Ted) And TestInsert(Ted)) Or Polozky[Index]^.Insert Then
   	TestReName := True Else TestReName := False;
End;
 
 
 
Function ReNameFiltr(Filtr:String;Index,Counter:Word):String;
Type
	TypPrikaz = (prNil,prName,prExtension,prCounter);
Var
   NameIdx:Byte;
   Name:Array[0..1] of String[8];
   Number:Array[0..1] of String;
   Prikaz:TypPrikaz;
   a:Byte;
	First,Last:Word;
Begin
	For NameIdx := 1 DownTo 0 Do Name[NameIdx] := '';
	For a := 1 To Length(Filtr) Do
   Begin
      IF Filtr[a] = '.' Then NameIdx := Ord(NameIdx = 0)
   	Else IF Filtr[a] = '[' Then
      Begin
			For First := 1 DownTo 0 Do Number[First] := '';
         Prikaz := prNil;
         While a < Length(Filtr) Do
         Begin
         	Inc(a);
				Case Filtr[a] of
            	'N': Prikaz := prName;
               'E': Prikaz := prExtension;
               'C': Prikaz := prCounter;
			   	'-': First  := Ord(First = 0);
               ']': Break;
               '0'..'9': Number[First] := Number[First] + Filtr[a];
		         Else Prikaz := prNil;
	         End;
         End;
			Val(Number[0],First,Last);
         IF Last <> 0 Then First := 1;
         IF Number[1] = '' Then Last := 255 Else Val(Number[1],Last,Last);
         Case Prikaz Of
         	prName: {N[#] or N[#-#]}
	         Begin
	            Number[0] := DejNameOnly(Index);
	            For First := First To Last Do
		         IF First <= Length(Number[0]) Then Name[NameIdx] := Name[NameIdx] + Number[0,First];
	         End;
         	prExtension: {N[#] or N[#-#]}
	         Begin
	            Number[0] := DejExtensionOnly(Index);
	            For First := First To Last Do
		         IF First <= Length(Number[0]) Then Name[NameIdx] := Name[NameIdx] + Number[0,First];
	         End;
            prCounter: {[P[##]}
	         Begin
	            Str(Counter+First,Number[1]);
	            While Length(Number[1]) < Length(Number[0]) Do Number[1] := '0' + Number[1];
	            Name[NameIdx] := Name[NameIdx] + Number[1];
	         End;
         End;
      End
      Else IF Filtr[a] = ']' Then {nic}
      Else Name[NameIdx] := Name[NameIdx] + Filtr[a];
   End;
   IF Name[1] = '' Then ReNameFiltr := Name[0]
   Else ReNameFiltr := Name[0] + '.' + Copy(Name[1],1,3);
End;
 
 
 
 
Procedure ReName;
Label Pryc;
Const
   MaxNew = 8 + 1 + 3;
	MaxOld = MaxSirka - 3 - MaxNew;
Var
	Index,     {1+ abs index vsech souboru}
   Count,     {1+ abs index jen oznacenych}
	rMax,      {1+ pocet oznacenych}
	rMin,      {1+ prvni zobrazeny z oznacenych}
	rTed:   	  {1+ kurzor na oznacenem}
		Integer;
   Pis:Char;
   Old:String[MaxOld];
   New:String[MaxNew];
   Inf:String[MaxInfo];
   Color:Byte;
Begin
   rTed := 1;
   rMin := 1;
   rMax := 0;
	For Index := 1 To Max Do IF TestReName(Index) Then Inc(rMax);
   IF rMax = 0 Then Exit;
{}
	ReNameTabulka;
   Repeat
	   Index := 1;
      Count := 1;
      While Count < rMin Do
      Begin
			IF TestReName(Index) Then Inc(Count);
         Inc(Index);
		End;
      While Count < MaxPoloz + rMin Do
      Begin
			IF TestReName(Index) Then
         Begin
				Old := DejName(Index) + InEmpty;
	         New := ReNameFiltr(Filtr,Index,Count-1) + InEmpty;
            IF Count = rTed Then
            Begin
					Color := ColorKurz;
               Inf   := Orez(DejName(Index),MaxInfo);
               While Length(Inf) < MaxInfo Do Inf := ' ' + Inf + ' ';
					_PisXYAString(NortonX + 2,NortonY + MaxVyska - 2,ColorPoza+ColorNorm,Inf);
            End
            Else Color := ColorPoza;
            IF Polozky[Index]^.Insert Then Inc(Color,ColorVybr) Else Inc(Color,ColorNorm);
			   _PisXYAString(NortonX +             1,NortonY+Count-rMin+2,Color,Old);
			   _PisXYAString(NortonX + MaxSirka - 13,NortonY+Count-rMIn+2,Color,New);
	      	Inc(Count);
	      End;
         Inc(Index);
         IF Index > Max Then Break;
		End;
		_PisXYAString(NortonX + 2 + DelkaZadej,NortonY + MaxVyska - 3,ColorPoza+ColorNorm,Filtr + ' ');
      Pis := UpCase(ReadKey);
      Case Pis of
      	#0:
         Begin
         	Pis := ReadKey;
            IF Pis = ';' Then HelpReName
            Else Sipky(Pis,rMin,rTed,rMax,MaxPoloz - 1);
         End;
         #8: IF Filtr <> '' Then Delete(Filtr,Length(Filtr),1);
			#9: DOSname := Not DOSName;
         #13: Break;
         #27: Goto Pryc;
         Else IF Length(Filtr) < MaxInfo - DelkaZadej Then
         Case Pis of
	         '.': IF Pos('.',Filtr) = 0 Then Filtr := Filtr + '.' Else Filtr := Filtr + '_';
	         ']': IF Pos('[',Filtr) <>0 Then Filtr := Filtr + ']' Else Filtr := Filtr + '_';
	         '[': Filtr := Filtr + '[';
	         Else Filtr := Filtr + DOSNameFiltr(Pis);
         End;
		End;
   Until False;
{}
   Count := 0;
	For Index := 1 To Max Do
	IF TestReName(Index) Then
   Begin
		Polozky[Index]^.DOSName := ReNameFiltr(Filtr,Index,Count);
   	Inc(Count);
   End;
Pryc:
	Tabulka;
End;
 
 
 
 
 
Begin
{ReMain}
	FillChar(ReMain   ,    1,MaxIn);
	FillChar(ReMain[1],MaxIn,  ' ');
   ReMain[MaxIn - 12] := 'ł';
{RePredel}
	FillChar(RePredel   ,    1,MaxIn);
	FillChar(RePredel[1],MaxIn,  'Ä');
   RePredel[MaxIn - 12] := 'Á';
End.