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!
As of October 2008, you can download the source and the executable as one .ZIP file here: http://home.arcor.de/hoffenbar/prog/dupfind.zip
% 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 MBon stdout.
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: <maske(n)> Einzuschliessende Datei(en) [*].
-x: <maske(n)> Auszuschliessende Datei(en) [].
-xd: <maske(n)> 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" ################################################################################
# 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 <maske(n)> Einzuschliessende Datei(en) %v.}
-x: {{} %s <maske(n)> Auszuschliessende Datei(en) %v.}
-xd: {{} %s <maske(n)> 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;To compile, use something like
sdx qwrap -runtime tclkitsh.exe