Delphi & Pascal (česká wiki)
{ 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.