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 will add a crc-check and other goodies (if I find the time...). The script listed here has now grown very large because I included modules which are in normale cases loaded via package require. The reasons are: I hate to download several required modules if I only want to test the actual script; the user should procude an exe simply invoking sdx qwrap.... So no modularization here!
Example:
dupfind d:/pgm/tcl/usr/tst > report.txt
A report (output) 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 MBon stdout.
Usage
Here's 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"Script:
################################################################################
#
# Skript : dupfind.tcl
# Stand : 21.07.2006
# Status : Entwurf, lauffähig
# 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 sauber formatiert ausgeben (b,k,m,g) - der Code ist
# irgendwo schon vorhanden)
# - Optional verschiedene Ausgabeformate (Sort, Spalten etc.)
#
################################################################################
# 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.} (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.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 ;-)
}
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
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
}
# doch erforderlich, wie die Praxis zeigt...
catch {
set size [file size $ff]
set info [list $fn $size [file mtime $ff]]
lappend f($info,dirs) $fd
set dl [llength $f($info,dirs)]
if {$dl == 2} {
# merken, welche später auszugeben sind, aber nur 1x
lappend infos $info
puts -nonewline stderr .
flush stderr
}
if {$dl > 1} {
# verschwendete GesamtBytes hier mitzählen, spart Mult später...
incr v $size
incr d
}
}
# 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 {}
array set f {}
set v 0
set d 0
#set chars {\\ | / - }
#set charIx -1
set numFiles 0
set exe [info nameofexe]
#*******************************************************************************
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) {
incr numFiles [globx $dir $_args(-i:) callBack]
}
puts stderr \n\n;
puts "Dateien gefunden : $numFiles\n"
if {$numFiles == 0} {
exit 1;
}
#*******************************************************************************
foreach info [lsort $infos] {
puts "Datei : [lindex $info 0]\nAnzahl: [llength $f($info,dirs)] -\
Groesse: [lindex $info 1] -\
Zeit: [clock format [lindex $info 2] -format %d.%m.%Y-%T] - Ordner:\n"
foreach dir $f($info,dirs) {
puts " $dir"
}
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]\n"
exit 0;To compile, use something like
sdx qwrap -runtime tclkitsh.exe
More infos follow later ;-)