See Also  edit

ycl::dir::duplicates and ycl::dir::deduplicate

Download  edit

dupfind.zip

Mho 2017-03-23: dead-link. Working on this...

Example  edit

% dupfind d:/pgm/tcl/usr -x "*.lnk *.tcl* *.html" -xd "d:/pgm/tcl/usr/tst d:/pgm/tcl/usr/src"

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

Usage  edit

 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"

Code  edit

# 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
            }
        }
    }
    # 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;
}

#*******************************************************************************


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  edit

sdx qwrap -runtime tclkitsh.exe

History  edit

v0.6, 2008-10-03

Fixed a bug if given dirspecs are relative; two little optimizations; added short tabular output format which is a little more readable and could be easier turned in to a batch file (for deleting duplicates, e.g.).

v0.5, 2007-02-14

Fixed a big bug which caused aborts when foldernames begin with '$'. No more SUBSTing involved, so no possibility to execute code between g in filenames...

• Home
• Recent changes
• Help
• WhoAmI/Logout
• Create new page
• Random page
• Previous page
• Next page
• 
  
• Add comments
• Edit
• History
• Edit summary
• References