---- **About** A program to identify possible duplicates in the filesystem. For now the only criterias are (of course) the '''filename, the modification time and the size'''. Later on I could add a crc-check and other goodies (if I find the time...). As usual, the whole thing is eventually unreadable for non-german speakers... The script listed here has now grown very large because I included modules which are in normale cases loaded via package require. The reason is : the user could simply download and run or invoke '''sdx qwrap...'''. So no modularization here! ---- **Example** % dupfind d:/pgm/tcl/usr -x "*.lnk *.tcl* *.html" -xd "d:/pgm/tcl/usr/tst d:/pgm/tcl/usr/src" gives something like Ordner : d:/pgm/tcl/usr Suchmaske : * Pruefzeit(Start) : 21.07.2006-11:10:33 Dateien gefunden : 11146 Datei : asmarm.h Anzahl: 3 - Groesse: 487 - Zeit: 29.05.1999-08:45:52 - Ordner: D:/PGM/tcl/usr/prog/ffidl-0.5/ffcall-1.6/avcall D:/PGM/tcl/usr/prog/ffidl-0.5/ffcall-1.6/vacall D:/PGM/tcl/usr/prog/ffidl-0.5/ffcall-1.6/callback/vacall_r Datei : asmarm.sh Anzahl: 3 - Groesse: 854 - Zeit: 29.05.1999-10:56:38 - Ordner: D:/PGM/tcl/usr/prog/ffidl-0.5/ffcall-1.6/avcall D:/PGM/tcl/usr/prog/ffidl-0.5/ffcall-1.6/vacall D:/PGM/tcl/usr/prog/ffidl-0.5/ffcall-1.6/callback/vacall_r : : : Anzahl mehrfache : 69 (d.h., Dateien, von denen mehrere Kopien existieren) Anzahl Duplikate : 90 Duplikate belegen: 3573814 Bytes = 3.41 MB on stdout. ---- **Usage** Here's an example of the command line help: dupfind 0.2 MHo Auffinden von mehrfach gespeicherten Dateien: Name, Groesse und Modifikations- zeit muessen identisch sein (Dateien identischen Inhalts mit abweichendem Namen werden nicht gefunden!). Die Suche wird rekursiv durchgefuehrt, beginnend in dem oder den angegebenen Ordner(n). (Erweiterung durch CRC-Check und weitere Optionen wie Ausschluss anhand Datum, Groesse sind denkbar ;-) Syntax: dupfind dir [dir [...]] [Schalter] Schalter (teilweise kombinierbar): -? Diese Hilfe anzeigen. -h Diese Hilfe anzeigen. -i: Einzuschliessende Datei(en) [*]. -x: Auszuschliessende Datei(en) []. -xd: Auszuschliessende Ordner [] (alles unterhalb ausschliessen). ACHTUNG: *.* findet nur Dateien, die eine Namenserweiterung besitzen! Suchmasken sind in glob-style-Syntax anzugeben, siehe http://www.purl.org/tcl/home/man/tcl8.4/TclCmd/glob.htm. Beispiele: dupfind c:/programme dupfind e:/work d:/pgm/tcl -i "*.exe *.dll" dupfind d:/pgm/tcl/usr/tst -x "*.lnk *.tcl* *.html" dupfind d:/pgm/tcl/usr -x "*.lnk *.tcl* *.html" -xd "d:/pgm/tcl/usr/tst d:/pgm/tcl/usr/src" ---- **Script** ################################################################################ # Skript : dupfind.tcl # Stand : 03.10.2008 # Status : stable # Autor : M.Hoffmann # Sprache : Tcl # Zweck : Erkennen mehrfach vorhandener Dateien anhand Name, Grösse, Zeit # Aufruf : dupfind (startdir) [(suchmaske)|*] # Notizen : - CRC-Bildung sollte nach Eingrenzung durchgeführt werden # - Dateigrössen auch sauber formatiert ausgeben (b,k,m,g) # - Optional verschiedene Ausgabeformate (Sort, Spalten etc.) # - Optional nur Summenzeilen # - Verstrichene Zeit anzeigen, etc. etc. # - >>> Gesamtgrösse pro Duplikatblock ausgeben (je Datei) # Es wird rel. viel Hauptspeicher benötigt. Würde glob -tailes verwendet, # wären schon mal die mittels -directory angegebenen Prefixe weg. Da aber in # globx rekursiv gearbeitet wird, geht das nicht. # # v0.5 140207 - Bugfix: Verzeichnisse mit '$' am Anfang führten zum Abbruch...; # maxDupCount. # v0.6 031008 - Neue Runtime. Alternatives Ausgabeformat. Optimierung. # ################################################################################ # aus (WebServer)/custom/hamue_init.tcl und abgewandelt proc fSizeFormat {temp} { set aus "" if {$temp > 1023999} { set aus "= [format %-.2f [expr {$temp / 1048576.0}]] MB" } elseif {$temp > 99999} { set aus "= [format %-.1f [expr {$temp / 1024.0}]] KB" } return $aus } #******************************************************************************* # Direkt aus Modul eingefügt (und abgestrippt), damit sdx qwrap möglich # schlecht: MITTLERER Parameter ist wahlfrei... #******************************************************************************* #****h* Library/globx.tcl # # NAME # # globx.tcl - Erweiterter Globbefehl (bearbeitet Verzeichnisbäume) # v0.04, 21.07.2006 # # AUTHOR # # M.Hoffmann, © 2004-2006 # # PORTABILITY # # Siehe TCL; getestet nur Win2000/XP # # USAGE # # -- package require globx # ALLE ORDNER INKL. ALLEN SUBORDNERN UND DATEIEN, DIE SUCHMASKE ENTSPRECHEN: # -- set files [globx startDir patterns] # oder # proc callback fileName {...} # -- set numFiles [globx startDir patterns callback] # ALLE ORDNER INKL. SUBORDNERN: # -- set dirs [globx2 startDir] # oder # proc callback dirName {...} # -- set numDirs [globx2 startDir callback] # # NOTES # # -- Nicht-rekursive Variante # -- Bei Benutzung eines Callbacks kommen die Namen unsortiert herein # -- Verzeichnisse werden IMMER ALLE durchsucht (*), Dateien JE NACH SUCHMASKE # -- HIDDEN Entries müssen im Quelltext leider gesondert behandelt werden # -- Tests mit globx_test.tcl, globx2_test.tcl # -- ACHTUNG: Um die selben Ergebnisse wie unter DOS zu erreichen, muss * # anstelle von *.* als Suchmaske angegeben werden! # # TODO # # -- Namespace # # HISTORY # # v0.01 06.02.2004 - Erste dokumentierte, einsatzfähige Version # v0.02 21.10.2004 - Überarbeitung gemäss Wiki-Änderung-Empfehlung # v0.03 09.12.2004 - Nur Ordnerbäume verarbeiten mit globx2 # v0.04 21.07.2006 - Mehrere patterns für glob ermöglichen (parsing) # # SOURCE proc globx {startDir {search *} {cb ""}} { set dirStack [list [file normalize $startDir]] set files {} set fc 0 while {[llength $dirStack]} { set newStack {} foreach dir $dirStack { # temporary var's only because eventually using CallBack set c [list glob -noc -typ f -dir $dir --]; eval lappend c $search; set fn [eval $c] set c [list glob -noc -typ {f hidden} -dir $dir --]; eval lappend c $search; set fh [eval $c] if {[string equal $cb ""]} { eval lappend files $fn $fh } else { foreach f [concat $fn $fh] { incr fc uplevel [list $cb $f] } } set dn [glob -noc -typ d -dir $dir *] set dh [glob -noc -typ {d hidden} -dir $dir *] # eval lappend newStack $dn $dh; # v0.01 # Wikipatch Start v0.02 --- foreach newDir [concat $dn $dh] { set theDir [file tail $newDir] if {[string equal $theDir "." ] || \ [string equal $theDir ".."]} { # Don't push this, otherwise entering an endless # loop (on UNIX, at least) } else { lappend newStack $newDir } } # Wikipatch Ende --- } set dirStack $newStack update; # keep Background alive } if {[string equal $cb ""]} { return [lsort $files] } else { return $fc } } #******************************************************************************* # Aus Modul spar #******************************************************************************* # Simple ParameterParsing (SPar) SPAR.TCL # (C) M.Hoffmann 2004-2006 # # 26.03.2005: Erweiterung: Hilfetexte mit übergeben, formatierte Hilfeausgabe # 05.07.2005: ReView, Ergänzungen # 09.07.2005: endgültige Hilfeformatierung festgelegt # 11.07.2005: Leere pos. Args überschreiben nicht Default; Hilfe integriert; # package # 01.09.2005: BUG-Fix (alle %v's erhielten den selben Inhalt.....) -> WIKI!!! # 15.11.2005: Fehlerrückgabe geändert: Fehler immer in (_error) & Abbruch! # Vereinfacht übergeordnete Benutzung! Testroutine noch anpassen! # Hilferückgabe in _help. Hilferückgabe aufgetrennt in (_sytx) und # (_help) zwecks besserer Aufbereitbarkeit im Mainprog. Rückgabe # überzähliger Elemente als (_argsuper), Element ist sonst leer. # 08.02.2006: Bugfix. _argcount statt argcount enthält Anzahl pos.Args. # Syntaxhilfe-Format geändert. # # ToDo: # - namespace # - Testcase # - Wiki Update # # Unterstützte Sonderzeichen in Hilfezeilen: # %s - ergibt den Switchnamen selbst (bei Pos.args nicht sinnvoll!) # %v - ergibt [Vorgabewert] # %n - Spaltengerechter manueller Zeilenumbruch proc spar {tpl cmd} { if {[catch {array set a $tpl}]} { return -code error {invalid template}; # we could'nt handle this error }; # don't stop with other errors - give pgmr the chance to decide later # Help extension, formerly in separate proc set col 0 set sntx {} set help {} set a(_argsuper) "" foreach name [lsort [array names a]] { set lCol [lindex $a($name) 1]; # left side of help set rCol [lrange $a($name) 2 end]; # right side of help set a($name) [lindex $a($name) 0]; # the value ifself set rCol [string map [list %v \\\[$a($name)\\\]] $rCol]; # Bugfix 01.09. set lCol [string map "%s $name" $lCol]; # 'switch' replaces %s if {[string length $lCol]} { append sntx "$lCol " append help " \[format %-\${col}s \"$lCol\"\]$rCol\n" set l [string length $lCol] ; # determine begin of set col [expr {$l > $col ? $l : $col}]; # right side of help } } incr col set nl "\n[string repeat " " $col]" set a(_sytx) $sntx set a(_help) [string map [list %n $nl] [subst $help]] # Help extension End set needmore {} set count 0 set seeopts 1 foreach item $cmd { if {[string equal $item "--"]} { set seeopts 0; # end of -flag-processing } elseif {[string length $needmore]} { set a($needmore) $item set needmore {} } elseif {$seeopts == 1 && [string range $item 0 0] == "-"} { set matches [array names a -glob $item*]; # allows shortening if {[llength $matches]} { set match [lindex [lsort $matches] 0] if {[string index $match end] == ":"} { set needmore $match; # -f: means: 'value follows' } else { set a($match) 1; # otherwise simply return 'true' } } else { return -code error "Unbekannter Schalter: $item" } } else { incr count; # each arg counts, even if there are too much if {[info exists a($count)]} { if {[string length $item]} { # Defaults can only be overridden by 'real' values set a($count) $item; # empty string causes skip } set a(_argcount) $count } else { lappend a(_argsuper) $item; # das ist KEIN Fehler! } } } if {[string length $needmore]} { # missing value after -switch: at the very end return -code error "Wert fehlend: $needmore" } return [array get a]; # double conversion is the price for using arrays... } #******************************************************************************* proc processCmdLine {} { set tpl " -? {0 %s Diese Hilfe anzeigen.} -h {0 %s Diese Hilfe anzeigen.} -t {0 %s Kurze tabellarische Ausgabe.} -i: {* %s Einzuschliessende Datei(en) %v.} -x: {{} %s Auszuschliessende Datei(en) %v.} -xd: {{} %s Auszuschliessende Ordner %v%n (alles unterhalb ausschliessen).} " if {![catch {array set _args [spar $tpl $::argv]} rc]} { # schlecht: unbekannte Schalter usw. tauchen nicht direkt als # Fehler in spar auf; sie müssen daher HIER gesondert ausgefiltert werden! if {$_args(-?) || $_args(-h) || [string equal $::argv ""] || \ [string equal $_args(-i:) ""] || \ [string equal $_args(_argsuper) ""]} { puts { dupfind 0.6 MHo Auffinden von mehrfach gespeicherten Dateien: Name, Groesse und Modifikations- zeit muessen identisch sein (Dateien identischen Inhalts mit abweichendem Namen werden nicht gefunden!). Die Suche wird rekursiv durchgefuehrt, beginnend in dem oder den angegebenen Ordner(n). (Erweiterung wie CRC-Check und weitere Optionen wie Ausschluss anhand Datum, Groesse sind denkbar ;-) } puts "Syntax: dupfind dir \[dir \[...\]\] \[Schalter\]"; # fehlerhafter Blank am Ende von $_args(_sytx) puts "\nSchalter (teilweise kombinierbar):\n" puts $_args(_help) puts { ACHTUNG: *.* findet nur Dateien, die eine Namenserweiterung besitzen! Suchmasken sind in glob-style-Syntax anzugeben, siehe http://www.purl.org/tcl/home/man/tcl8.4/TclCmd/glob.htm. Beispiele: dupfind c:/programme dupfind e:/work d:/pgm/tcl -i "*.exe *.dll" dupfind d:/pgm/tcl/usr/tst -x "*.lnk *.tcl* *.html" dupfind d:/pgm/tcl/usr -x "*.lnk *.tcl* *.html" -xd "d:/pgm/tcl/usr/tst d:/pgm/tcl/usr/src" } exit 255 } } else { # oder alternativ Ausgabe der kompletten Hilfe auf Stdout?! puts stderr "Fehler beim Parsen der Kommandozeile:\n$rc" exit 255; } return [array get _args] } #******************************************************************************* proc callBack {ff} { global f global infos global v global d #global chars #global charIx global exe global Y global YL global dirIx global maxDupCount global maxDupFile set fn [string tolower [string trim [file tail $ff]]] set fd [file dirname $ff] # # Ausschlüsse bearbeiten # # 1. Dateisuchmaskenausschlüsse (-x) # foreach x $::_args(-x:) { if {[string match -nocase $x $fn]} { return; } } # # 2. Directoryausschlüsse (-xd) # foreach x $::_args(-xd:) { if {[string match -nocase $x* $fd]} { return; } } # # 3. Sonderbehandlung wg. Fehlern, wenn EIGENES VFS eingelesen wird... # if {[string match -nocase $exe* $ff]} { return; } # CATCH doch erforderlich, wie die Praxis zeigt... catch { set size [file size $ff] set info [list $fn $size [file mtime $ff]] # etwas umständlich: da globx mit glob -tails nicht funktioniert, # wird hier das ursprünglich einmal angegebene Directory durch eine Indexnummer ersetzt, # um etwas Speicher zu sparen. # Jedes Vorkommen der Datei, die durch $info eindeutig gekennzeichnet ist, festhalten, # in Form des Ordners (relativ zum Startordner) lappend f($info) [list $dirIx [string range $fd $YL end]] set dl [llength $f($info)] if {$dl > 1} { if {$dl == 2} { # merken, welche später auszugeben sind, aber nur 1x lappend infos $info puts -nonewline stderr . flush stderr } # verschwendete GesamtBytes hier mitzählen, spart Mult später... incr v $size incr d if {$dl > $maxDupCount} { set maxDupCount $dl set maxDupFile $fn } } } ### ### wann könnte schon Speicher freigegeben werden (f(info), etc.)?????? ### # Gimmick deaktiviert # incr charIx; if {$charIx > 3} {set charIx 0} # puts -nonewline stderr [lindex $chars $charIx]\b; # flush stderr } #******************************************************************************* #******************************************************************************* # # MAIN # #******************************************************************************* #******************************************************************************* array set _args [processCmdLine] # parray _args; exit #******************************************************************************* # Globale Variablen #******************************************************************************* set infos [list ] array set f {} set v 0 set d 0 #set chars {\\ | / - } #set charIx -1 set numFiles 0 set exe [info nameofexe] set dirIx 0 set maxDupCount 0 set maxDupFile "" #******************************************************************************* puts {} puts "Ordner : $_args(_argsuper)" puts "Suchmaske : $_args(-i:)" puts "Pruefzeit(Start) : [clock format [clock seconds] -format %d.%m.%Y-%T]\n" foreach dir $_args(_argsuper) { set Y($dirIx) [file normalize $dir]; # sonst klappt's nicht mit ./ etc. set YL [string length $Y($dirIx)] incr numFiles [globx $dir $_args(-i:) callBack] incr dirIx } puts stderr \n\n; puts "Dateien gefunden : $numFiles\n" if {$numFiles == 0} { exit 1; } #******************************************************************************* ##### parray f; # exit; ############################################### if {$_args(-t)} { foreach info [lsort $infos] { foreach dir $f($info) { puts "[lindex $info 0]\t[file join $Y([lindex $dir 0])[lindex $dir 1]]" } } } else { foreach info [lsort $infos] { puts "Datei : [lindex $info 0]\nAnzahl: [llength $f($info)] -\ Groesse: [lindex $info 1] -\ Zeit: [clock format [lindex $info 2] -format %d.%m.%Y-%T] - Ordner:\n" foreach dir $f($info) { puts " $Y([lindex $dir 0])[lindex $dir 1]" # * ACHTUNG: AUF KEINEN FALL hier irgendwelche automatischen Substitutionen # * vornehmen (subst, eval), denn: wir wissen absolut nichts über den Aufbau # * der Dateinamen -- es können [] oder $'s enthalten sein! } puts {}; } } puts "\nAnzahl mehrfache : [llength $infos] (d.h., Dateien, von denen mehrere Kopien existieren)" puts "Anzahl Duplikate : $d" puts "Duplikate belegen: $v Bytes [fSizeFormat $v]" puts "Max. Duplikatzahl: $maxDupCount ($maxDupFile)\n" exit 0; ---- **Miscellaneous** To compile, use something like sdx qwrap -runtime tclkitsh.exe ---- **History** * v'''0.5''', 14 Feb 2007: Fixed a big bug which caused aborts when foldernames begin with '$'. No more SUBSTing involved, so no possibility to execute code between [] in filenames... ---- !!!!!! %| [Category File] |% !!!!!!