unit logfile; interface uses sysutils,windows,classes; type tlogentry = record date : Tdatetime; artist : string; album : string; track : string; end; type tcounter = record entry : tlogentry; count : integer; end; type tlogfile = class(TThread) private tc : dword; fconfigfile : string; s : string; function readentry(ln : string; var res: tlogentry) : boolean; protected procedure Execute; override; public property configfile : string read fconfigfile write fconfigfile; procedure writeentry(Artist,Album,Track : string); procedure cleanlogfile; procedure ladditem; procedure sendmessage(m : string); procedure lclearitems; procedure lshownumbers; procedure ldontshownumbers; procedure refreshlist; end; implementation uses jukeboxform; procedure tlogfile.refreshlist; begin jukebox.CmTop100.Repaint; end; procedure tlogfile.ladditem; begin jukebox.CmTop100.items.Add(s); end; procedure tlogfile.lclearitems; begin jukebox.CmTop100.clear; end; procedure tlogfile.sendmessage(m : string); begin if (gettickcount-tc)<200 then exit; synchronize(lclearitems); s:=m; synchronize(ladditem); tc:=gettickcount; end; procedure tlogfile.lshownumbers; begin jukebox.CmTop100.showlabels:=true; end; procedure tlogfile.ldontshownumbers; begin jukebox.Cmtop100.showlabels:=false; end; procedure tlogfile.execute; procedure swap(var a,b : tcounter); var c:tcounter; begin c:=b; b:=a; a:=c; end; function compare(a,b : tlogentry) : boolean; begin result:=false; if (uppercase(trim(a.artist))=uppercase(trim(b.artist))) and (uppercase(trim(a.album))=uppercase(trim(b.album))) and (uppercase(trim(a.track))=uppercase(trim(b.track))) then result:=true; end; const MES = 'Calculating top 100, please wait for results'; MES2 = 'Sorting Results'; var n : integer; fli1,fli2 : textfile; c : tlogentry; counter : array of tcounter; scounter : array of tcounter; x: Integer; r : boolean; ms : string; sss : string; begin synchronize(ldontshownumbers); cleanlogfile; sendmessage(MES); copyfile(pwidechar(fconfigfile),pwidechar(fconfigfile+'.$$$'),false); assignfile(fli1,fconfigfile); try reset(fli1); except sendmessage('Error opening log file, aborting chart compilation'); exit; end; ms:=MES; assignfile(fli2,fconfigfile+'.$$$'); setlength(counter,0); setlength(scounter,0); n:=0; while(not eof(fli1)) and (Terminated=false) do begin readln(fli1,sss); if readentry(sss,c) then begin //check to see if already handled r:=false; for x := 0 to length(counter)-1 do begin if compare(counter[x].entry,c) then r:=true; end; if r=true then continue; //if handled then try next entry in fli1 //otherwise add to list... inc(n); setlength(counter,n+1); counter[n].entry:=c; //..open file try reset(fli2); except sendmessage('Error opening log temporary file, aborting chart compilation'); exit; end; //.. and start looping through file counting matches while(not eof(fli2)) and (Terminated=false) do begin readln(fli2,sss); if readentry(sss,c) then begin if compare(c,counter[n].entry) then inc(counter[n].count); end; end; end; //Show we're doing something ms:=ms+'.'; if length(ms)>length(MES)+25 then ms:=MES; sendmessage(ms); end; closefile(fli1); closefile(fli2); deletefile(pwidechar(fconfigfile+'.$$$')); setlength(scounter,length(counter)); for n := 0 to length(counter)-1 do begin scounter[(length(counter)-1)-n]:=counter[n]; end; setlength(counter,0); r:=true; while (r=true) and (Terminated=false) do begin r:=false; ms:=MES2; ms:=ms+'.'; x:=length(scounter)-1; setlength(scounter,x+1); if length(ms)>length(MES2)+25 then ms:=MES2; sendmessage(MES2); for n := 0 to x-1 do begin if scounter[n].count<scounter[n+1].count then begin swap(scounter[n],scounter[n+1]); r:=true; end; end; end; if terminated=true then exit; lshownumbers; lclearitems; setlength(scounter,100); x:=length(scounter)-1; if x>=100 then x:=100; for n := 0 to x do begin if scounter[n].entry.artist='' then continue; s:=(scounter[n].entry.artist+' - '+scounter[n].entry.album+' : '+scounter[n].entry.track+' ('+inttostr(scounter[n].count)+')'); ladditem; end; setlength(counter,0); setlength(scounter,0); synchronize(refreshlist); end; procedure tlogfile.writeentry(Artist: string; Album: string; Track: string); var fl : textfile; begin if fconfigfile='' then exit; assignfile(fl,fconfigfile); try if fileexists(fconfigfile) then append(fl) else rewrite(fl); except exit; end; writeln(fl,datetimetostr(now)+#9'"'+Artist+'"'#9'"'+Album+'"'#9'"'+Track+'"'); try closefile(fl); except; end; end; function tlogfile.readentry(ln : string; var res : tlogentry) : boolean; var n,p,lp : integer; tln: string; x: Integer; sq : string; begin //remove quotes sq:=''; for x := 1 to length(ln) do begin if ln[x]<>'"' then sq:=sq+ln[x]; end; ln:=sq; lp:=1; p:=pos(#9,ln); n:=0; while(p<>0) do begin tln:=copy(ln,lp,p-1); ln:=copy(ln,length(tln)+2,length(ln)-(length(tln))); if n=0 then begin try res.date:=strtodatetime(tln); except; result:=false; exit; end; end; if n=1 then res.artist:=tln; if n=2 then begin res.album:=tln; res.track:=ln; break; end; p:=pos(#9,ln); inc(n); end; if n<>2 then result:=false else result:=true; end; procedure tlogfile.cleanlogfile; const MES = 'Calculating top 100, please wait for results: Cleaning Log File'; var fli,flo : textfile; ln : string; le : tlogentry; y,m,d : word; comp : tdatetime; ms : string; begin ln:=fconfigfile+'.$$$'; deletefile(pwidechar(ln)); if renamefile(fconfigfile,fconfigfile+'.$$$') =false then exit; assignfile(flo,fconfigfile); try rewrite(flo); except exit; end; assignfile(fli,fconfigfile+'.$$$'); try reset(fli); except closefile(flo); renamefile(fconfigfile+'.$$$',fconfigfile); exit; end; if filesize(fli)>1024 then begin sysutils.beep; end; ms:=MES; while(not eof(fli)) do begin ms:=ms+'.'; sendmessage(ms); if length(mes)>length(mes)+25 then ms:=MES; readln(fli,ln); readentry(ln,le); decodedate(now,y,m,d); if m=1 then begin m:=12; y:=y-1; end else m:=m-1; comp:=encodedate(y,m,d); if (le.date>=comp) then begin writeln(flo,ln); end; end; closefile(flo); closefile(fli); ln:=fconfigfile+'.$$$'; deletefile(pansichar(ln)); end; end.