uses crt,dos;
label nofiles;
const
buffsize=5000;
var
f:file;
nameonly,nameonlyfix,origname,t2,errorlog:text;
filsiz,fontidx,l1,l2,l3,l4,ltot,tocstart,tocend,namepos:longint;
i,idx,buffread,toclength,namelength,w1,w2,w3,w4,
fontfamily,fontnamestyle,fontnameused,fonterror:word;
sr:searchrec;
ch:char;
dir,origfontname,fontname,s,fontnamefix:string;
b,fontpos,maxren,erroridx:byte;
buffer:array[1..buffsize] of char;
FUNCTION GET2(ch1,ch2:char):word;var gw1,gw2:word;begin
gw1:=ord(ch1);gw2:=ord(ch2);
gw1:=gw1*256+gw2;
get2:=gw1;
end;
PROCEDURE GETNAMES(ext:string);label 1,2,NEXTFONT,INVALID;
begin
findfirst('*'+ext,$3F,sr);
if doserror<>0 then exit;
1:
inc(fontidx);
gotoxy(1,14);write(sr.name);clreol;
assign(f,sr.name);setfattr(f,archive);reset(f,1);
filsiz:=filesize(f);
if filsiz<buffsize then buffread:=filsiz else buffread:=buffsize;
blockread(f,buffer[1],buffread);
idx:=1;
fontname:='';
s:='name';idx:=1;
while (buffer[idx]+buffer[idx+1]+buffer[idx+2]+buffer[idx+3]<>s)
and (idx<buffread) do inc(idx);
if idx=buffread then begin erroridx:=1;goto INVALID;end;
w1:=ord(buffer[idx+8]);
w2:=ord(buffer[idx+9]);
w3:=ord(buffer[idx+10]);
w4:=ord(buffer[idx+11]);
l1:=16777216*w1;
l2:=65536*w2;
l3:=256*w3;
l4:=w4;
tocstart:=l1+l2+l3+l4;
if tocstart>filsiz then begin erroridx:=2;goto INVALID;end;
seek(f,tocstart+5-1);
blockread(f,buffer[1],2);
toclength:=get2(buffer[1],buffer[2]);
if toclength>buffsize then begin erroridx:=5;goto INVALID;end;
tocend:=tocstart+toclength;
if tocend>filsiz then begin erroridx:=3;goto INVALID;end;
seek(f,tocstart-1);
blockread(f,buffer[1],toclength+1);
idx:=5;
while (buffer[idx-3]+buffer[idx]+buffer[idx+1]+buffer[idx+2]<>#3+#4+#9+#0) and (idx<toclength) do inc(idx);
inc(idx,3);
fontfamily:=0;fontnamestyle:=0;
while idx<toclength do begin
if (buffer[idx]=#1) and (fontfamily=0) then fontfamily:=idx;
if (buffer[idx]=#4) and (fontnamestyle=0) then fontnamestyle:=idx;
inc(idx,12);
end;
2:
if fontnamestyle>0 then fontnameused:=fontnamestyle
else if fontfamily>0 then fontnameused:=fontfamily
else begin erroridx:=4;goto INVALID;end;
namelength:=get2(buffer[fontnameused+1],buffer[fontnameused+2]);
namepos:=tocend+get2(buffer[fontnameused+3],buffer[fontnameused+4]);
if namepos+namelength>filsiz then begin
if fontnameused=fontnamestyle then begin fontnamestyle:=0;goto 2;end
else begin erroridx:=4;goto INVALID;end;
end;
seek(f,namepos);
blockread(f,buffer[1],namelength);
for idx:=1 to namelength div 2 do fontname[idx]:=buffer[idx*2];
fontname[0]:=chr(namelength div 2);
while pos(':',fontname)>0 do delete(fontname,pos(':',fontname),255);
writeln;
write('Font name : ');
write(#34+fontname+ext+#34);clreol;
writeln;writeln;
goto NEXTFONT;
INVALID:
inc(fonterror);
if fonterror=1 then begin
writeln(errorlog,'This file is the detailed list of invalid font(s).');
writeln(errorlog);
end;
writeln(errorlog,'File name : ',sr.name);
write(errorlog,'Error : ');
case erroridx of
1:writeln(errorlog,'header ',#34,'name',#34,' not found.');
2:writeln(errorlog,'address of the beginning of font information is out of filesize range.');
3:writeln(errorlog,'address of the ending of font information is out of filesize range.');
4:writeln(errorlog,'address of fontname is out of filesize range.');
5:writeln(errorlog,'length of information addresses is unusual.');
end;
writeln(errorlog);
NEXTFONT:
close(f);
if fontname<>'' then begin
writeln(origname,sr.name);
writeln(nameonly,fontname+ext);
end;
findnext(sr);
if doserror=0 then goto 1;
end;
BEGIN
clrscr;
writeln('???????????????????????????????????????????????');
writeln('? Font Files Renamer v1.0 by Joni Hariyanto ?');
writeln('? mailto: [[Email Removed]] ?');
writeln('???????????????????????????????????????????????');
writeln('? Fight for the Future Freewarez ?');
writeln('???????????????????????????????????????????????');
writeln;
writeln('Do you have tons of poorly named font files ?');
writeln('Rename them ALL now !');
writeln('(only work for TrueType [.TTF] and OpenType [.OTF] fonts.)');
writeln;
dir:=paramstr(0);
b:=length(dir);
while dir[b]<>'\' do dec(b);
delete(dir,b+1,255);
writeln('Searching in : ',dir);
write('Press anykey to proceed.');
repeat until keypressed;
ch:=readkey;
gotoxy(1,13);clreol;
assign(origname,'origname.txt');rewrite(origname);
assign(nameonly,'namelist.txt');rewrite(nameonly);
assign(errorlog,'errorlog.txt');rewrite(errorlog);
fontidx:=0;fonterror:=0;
GETNAMES('.ttf');
GETNAMES('.otf');
close(origname);
close(nameonly);
if fontidx=0 then begin erase(origname);erase(nameonly);goto nofiles;end;
reset(nameonly);
readln(nameonly,fontname);
assign(nameonlyfix,'namefix.txt');rewrite(nameonlyfix);
writeln(nameonlyfix,fontname);
gotoxy(1,14);clreol;
gotoxy(1,15);clreol;
gotoxy(1,14);write('Checking names, please wait....');
{--------renaming the same names---------}
for idx:=2 to fontidx-fonterror do begin
readln(nameonly,fontname);
maxren:=0;
reset(nameonlyfix);
for i:=1 to idx-1 do begin
readln(nameonlyfix,fontnamefix);
if fontname=fontnamefix then maxren:=1;
if (length(fontname)<=length(fontnamefix)) and
(copy(fontname,1,length(fontname)-4)=copy(fontnamefix,1,length(fontname)-4)) then begin
move(fontnamefix[length(fontname)-3],s[1],3);
s[0]:=#3;
if (s[1]='-') and (s[2]>='0') and (s[2]<='9')
and (s[3]>='0') and (s[3]<='9') then begin
val(copy(s,2,2),b,w1);
if b>maxren then maxren:=b;
end;
end;
end;
if maxren>0 then begin
inc(maxren);
str(maxren,s);
if length(s)=1 then s:='0'+s;
s:='-'+s;
insert(s,fontname,length(fontname)-3);
end;
append(nameonlyfix);
writeln(nameonlyfix,fontname);
end;
close(nameonly);
close(nameonlyfix);
{-----writing the batch file------}
assign(t2,'newname.bat');rewrite(t2);
writeln(t2,'@echo off');
writeln(t2,'echo .');
writeln(t2,'echo Changing the names, please wait....');
reset(origname);
reset(nameonlyfix);
for idx:=1 to fontidx-fonterror do begin
readln(origname,origfontname);
readln(nameonlyfix,fontnamefix);
writeln(t2,'ren '+origfontname+#32+#34+fontnamefix+#34);
end;
writeln(t2,'cls');
writeln(t2,'echo .');
writeln(t2,'echo Changing the names, ...DONE !');
writeln(t2,'echo .');
writeln(t2,'pause');
close(t2);
close(errorlog);if fonterror=0 then erase(errorlog);
close(origname);erase(origname);
erase(nameonly);
gotoxy(1,14);clreol;
gotoxy(1,15);clreol;
gotoxy(1,14);
writeln('COMPLETED !');
writeln('Result : ',fontidx,' font files detected.');
if fonterror>0 then begin
textcolor(12);
writeln('WARNING : ',fonterror,' font files are invalid.');
writeln(' Read file ERRORLOG.TXT for detailed information.');
textcolor(7);
end;
writeln('Batch file named NEWNAME.BAT has been created.');
writeln('Run it NOW to actually rename all your font files.');
writeln;
writeln('Thanks for removing nasty names outta your life.');
repeat until keypressed;
ch:=readkey;
repeat until keypressed;
ch:=readkey;
halt(1);
NOFILES:
close(errorlog);if fonterror=0 then erase(errorlog);
writeln;
writeln('Could not find any supported font file types here.');
writeln('Copy FIXFONTS.EXE to your fonts location and try again.');
writeln('Read the documentation files for more information.');
repeat until keypressed;
ch:=readkey;
halt(1);
end.
