CloneKiller

Anwendungen, Tools, Userlibs und anderes nützliches.
Benutzeravatar
dllfreak2001
Beiträge: 2925
Registriert: 07.09.2004 23:44
Wohnort: Bayern

CloneKiller

Beitrag von dllfreak2001 »

Hab letztens mit ein paar Prozeduren
ein Mini-Tool produziert. Es sortiert doppelte MP3-Dateien
aus. Aber Achtung! Das Ding ist extrem langsam.

Anleitung:
Wählt das Verzeichnis aus das nach doppelten Dateien untersucht werden
soll. Es werden immer auch die Unterordner durchsucht.
Dann erscheinen im linken Listicongadget die gefundenen Dateien und im rechten Gadget die doppelten Dateien.
Wenn man jetzt auf löschen klickt werden die Dateien im rechten gadget komplett gelöscht.
Die Konstante #acu setzt die genaugkeit des Vergleichs fest.
Bei einem Wert von 1 - 100%

Code: Alles auswählen

#acu = 10

Procedure.l searchfile(path.s,type.s,gadgetid.l,startnum.l)
    If Right(path,1) = "\"
        path = Left(path,Len(path)-1)
    EndIf
    count.l = 0
    If ExamineDirectory(startnum,path,"*.*") <> 0
        Repeat
            UseDirectory(startnum)
            rturn.b = NextDirectoryEntry()
            ;Wenn eine Datei gefunden wurde
            If rturn = 1 And GetExtensionPart(DirectoryEntryName()) = Right(type,Len(type)-2)
                AddGadgetItem(gadgetid,-1,DirectoryEntryName()+Chr(10)+path+"\"+DirectoryEntryName())
                count = count + 1
            EndIf
            ;Wenn ein Pfad gefunden wurde
            If rturn = 2 And Right(DirectoryEntryName(),1) <> "." And Right(DirectoryEntryName(),2) <> ".."
                rsult.l = searchfile( path+"\"+DirectoryEntryName(),type,gadgetid,startnum +1) 
                If rsult = -1
                    rturn = 0
                Else
                    count = count + rsult
                EndIf
            EndIf
        Until rturn = 0
        ;Anzahl der Dateien die gefunden wurden zurückgeben
        ProcedureReturn count
    Else
        ;Fehlermeldung zurückgeben
        ProcedureReturn -1
    EndIf
EndProcedure

Procedure.b checkclnfiles(filea.s,fileb.s,accuracy.l)
    ra.b = ReadFile(0,filea)
    rb.b = ReadFile(1,fileb)
    
    If ra <>0 And rb <>0
        count.l = 0 
        gtback.b = 0
        UseFile(0)
        lena.l = Lof()
        UseFile(1)
        lenb.l = Lof()
        If lena <> lenb
            gtback = 0
            Goto lenfail
        EndIf
        If accuracy < 1 Or accuracy > 100
            Debug "Error 1 Accuracy to high or low!"
            End
        EndIf
        maxlen.l = (lena/100)*accuracy
        Repeat
            count + 1
            
            
            UseFile(0)
            tbytea.b = ReadByte()
            UseFile(1)
            tbyteb.b = ReadByte()

            If tbytea = tbyteb
                gtback = 1
            Else
                gtback = 0
                Break
            EndIf
            
            If count => maxlen 
                gtback = 1
                Break
            EndIf      
                  
        Until Eof(0) And Eof(1)
        
        lenfail:
        CloseFile(0)
        CloseFile(1)
        ProcedureReturn gtback
    Else
        ProcedureReturn -1
    EndIf
     
EndProcedure

OpenWindow(0,0,0,600,400,#PB_Window_MinimizeGadget|#PB_Window_ScreenCentered|#PB_Window_MaximizeGadget|#PB_Window_SizeGadget,"Clonekiller v1.0")
    
    CreateGadgetList(WindowID(0))
        Frame3DGadget(0,5,5,590,40,"Quellverzeichnis")
        ButtonGadget(1,10,20,70,20,"Wählen")
        ButtonGadget(2,85,20,70,20,"Start")
        ButtonGadget(3,160,20,70,20,"Löschen")
        StringGadget(4,235,20,350,20,"C:\",#PB_String_ReadOnly)
        ListIconGadget(5,5,50,200,345,"Datei",100)
        AddGadgetColumn(5, 1, "Pfad",500)
        ListIconGadget(6,5,310,200,345,"Datei",100)
        AddGadgetColumn(6, 1, "Pfad",500)
        SplitterGadget(7, 5, 50, 590, 345, 5, 6 ,#PB_Splitter_Separator | #PB_Splitter_Vertical ) 
        SetGadgetAttribute(7, #PB_Splitter_FirstMinimumSize, 50)
        SetGadgetAttribute(7, #PB_Splitter_SecondMinimumSize,50)
        
Global winevent.l, gadgetevent.l, menuevent.l


Repeat
    winevent = WaitWindowEvent()
    gadgetevent = EventGadgetID() 
    menuevent = EventMenuID()

    If winevent = #PB_Event_SizeWindow And IsWindow(1) = 0
        UseWindow(0)
        ResizeGadget(7,5,50,WindowWidth()-10,WindowHeight()-55)
    EndIf

    If gadgetevent = 1 And winevent = #PB_Event_Gadget 
        OpenWindow(1,0,0,250,400,#PB_Window_ScreenCentered,"Ordner wählen...",WindowID(0))
            CreateGadgetList(WindowID(1))
                ExplorerTreeGadget(8, 5, 5,240, 365, GetGadgetText(4), #PB_Explorer_NoFiles|#PB_Explorer_AlwaysShowSelection)
                ButtonGadget(9,5,375,70,20,"Ok")
    EndIf
    
    If gadgetevent = 9 And winevent = #PB_Event_Gadget 
        SetGadgetText(4,GetGadgetText(8))
        CloseWindow(1)
    EndIf
    
    If gadgetevent = 2 And winevent = #PB_Event_Gadget 
        MessageRequester("Information!","Das durchsuchen der Festplatte kann je nach Ordnerstruktur und Grösse mehrere Minuten dauern!")
        EnableWindow_(WindowID(0),0)
        searchfile(GetGadgetText(4),"*.mp3",5,0) 
        EnableWindow_(WindowID(0),1)
        Dim check.b(CountGadgetItems(5)-1)
        For x = 0 To CountGadgetItems(5)-1
            If check(x) = 0
                check(x) = 1
                For y = 0 To CountGadgetItems(5)-1
                    If check(y) = 0
                        
                        If checkclnfiles(GetGadgetItemText(5, x, 1),GetGadgetItemText(5, y, 1),#acu) = 1
                            check(y) = 1
                            AddGadgetItem(6,-1,GetGadgetItemText(5, y, 0)+Chr(10)+GetGadgetItemText(5, y, 1))
                        EndIf
                    EndIf
                Next
            EndIf
        Next
        MessageRequester("Fertig...","Das durchsuchen der Dateien wurde beendet!")
    EndIf
    
    If gadgetevent = 3 And winevent = #PB_Event_Gadget 
        For x = 0 To CountGadgetItems(6)
            DeleteFile(GetGadgetItemText(6,x,1))
        Next
        ClearGadgetItemList(6)
    EndIf
Until winevent = #PB_Event_CloseWindow 
CloseWindow(0)
End

I´a dllfreak2001
Benutzeravatar
NicTheQuick
Ein Admin
Beiträge: 8809
Registriert: 29.08.2004 20:20
Computerausstattung: Ryzen 7 5800X, 64 GB DDR4-3200
Ubuntu 24.04.2 LTS
GeForce RTX 3080 Ti
Wohnort: Saarbrücken

Beitrag von NicTheQuick »

Such mal in diesem Board oder im Archiv nach dem Thread, wo ellenlang darüber diskutiert wurde, wie man einen Dateivergleich am schnellsten machen könnte und bau das so in dein Programm ein.

Da Diskussionen hier nicht reingehören, sollten diese deswegen auch in diesem alten Thread fortgeführt, oder falls dieser Thread im Archiv liegt, ein neuen dafür aufgemacht werden.
Benutzeravatar
dllfreak2001
Beiträge: 2925
Registriert: 07.09.2004 23:44
Wohnort: Bayern

Beitrag von dllfreak2001 »

werd ich machen...

Hab da auch was von Lebostein gefunden!
I´a dllfreak2001
Benutzeravatar
Lebostein
Beiträge: 674
Registriert: 13.09.2004 11:31
Wohnort: Erzgebirge

Beitrag von Lebostein »

Meinst du das hier? Die einzige Bremse könnte der PB Befehl CompareMemory() sein, keine Ahnung wie der optimiert ist. Aber es scheint trotzdem schnell zu gehen.

Code: Alles auswählen

FileName1$ = "datei1"
FileName2$ = "datei2"

FileNumber1 = ReadFile(#PB_Any, FileName1$)
FileLength1 = Lof()
FileAdress1 = AllocateMemory(FileLength1)
ReadData(FileAdress1, FileLength1)
CloseFile(FileNumber1)

FileNumber2 = ReadFile(#PB_Any, FileName2$)
FileLength2 = Lof()
FileAdress2 = AllocateMemory(FileLength2)
ReadData(FileAdress2, FileLength2)
CloseFile(FileNumber2)

If FileLength1 <> FileLength2
  Debug "Dateien sind nicht gleich, da unterschiedlich groß"
ElseIf CompareMemory(FileAdress1, FileAdress2, FileLength1) = 0
  Debug "Dateien sind nicht gleich, obwohl die gleiche Größe"
Else
  Debug "Dateien sind identisch"
EndIf

FreeMemory(FileAdress1)
FreeMemory(FileAdress2)
Vielleicht kann auch in diesem Zusammenhang der Befehl "MD5FileFingerprint()" nützlich sein.
Benutzeravatar
dllfreak2001
Beiträge: 2925
Registriert: 07.09.2004 23:44
Wohnort: Bayern

Beitrag von dllfreak2001 »

Genau das meint ich
I´a dllfreak2001
Benutzeravatar
NicTheQuick
Ein Admin
Beiträge: 8809
Registriert: 29.08.2004 20:20
Computerausstattung: Ryzen 7 5800X, 64 GB DDR4-3200
Ubuntu 24.04.2 LTS
GeForce RTX 3080 Ti
Wohnort: Saarbrücken

Beitrag von NicTheQuick »

Also ich hätte für sowas jetzt mal folgende Procedure vorgeschlagen:

Code: Alles auswählen

Enumeration 1
  #CF_File1_False
  #CF_File2_False
  #CF_Files_Identic
  #CF_Files_Different
EndEnumeration

;#Buffer = 2 * 1024 * 1024 ; 2 MB
#Buffer = 50 * 1024 * 1024 ; 50 MB

Procedure CompareFiles(File1.s, File2.s)
  Protected FileID1.l, FileID2.l, Length1.l, Length2.l
  Protected Mem1.l, Mem2.l, Pos.l, Rest.l
  
  FileID1 = ReadFile(#PB_Any, File1)
  If FileID1 = 0 : ProcedureReturn #CF_File1_False : EndIf
  Length1 = Lof()
  
  FileID2 = ReadFile(#PB_Any, File2)
  If FileID2 = 0 : CloseFile(FileID1) : ProcedureReturn #CF_File2_False : EndIf
  Length2 = Lof()
  
  If Length1 <> Length2
    CloseFile(FileID1)
    CloseFile(FileID2)
    ProcedureReturn #CF_Files_Different
  EndIf
  
  Mem1 = AllocateMemory(#Buffer)
  Mem2 = AllocateMemory(#Buffer)
  Pos = 0
  
  Repeat
    Rest = #Buffer
    If Length1 - Pos < #Buffer : Rest = Length1 - Pos : EndIf
    UseFile(FileID1) : FileSeek(Pos) : ReadData(Mem1, Rest)
    UseFile(FileID2) : FileSeek(Pos) : ReadData(Mem2, Rest)
    Pos + Rest
    If CompareMemory(Mem1, Mem2, Rest) = 0
      CloseFile(FileID1)
      CloseFile(FileID2)
      ProcedureReturn #CF_Files_Different
    EndIf
    Debug Str(Pos) + "/" + Str(Length1)
 Until Pos = Length1
  
  CloseFile(FileID1)
  CloseFile(FileID2)
  ProcedureReturn #CF_Files_Identic
EndProcedure

File1.s = OpenFileRequester("Erste Datei auswählen...", "C:\", "Alle Dateien (*.*)|*.*|", 0)
If File1 = "" : End : EndIf
File2.s = OpenFileRequester("Erste Datei auswählen...", GetPathPart(File1), "Alle Dateien (*.*)|*.*", 0)
If File2 = "" : End : EndIf
v.l = CompareFiles(File1, File2)
Select  v
  Case #CF_File1_False     : Text.s = "'" + File1 + "' kann nicht gelesen werden."
  Case #CF_File2_False     : Text.s = "'" + File2 + "' kann nicht gelesen werden."
  Case #CF_Files_Different : Text.s = "Beide Dateien haben verschiedene Inhalte."
  Case #CF_Files_Identic   : Text.s = "Beide Dateien haben den selben Inhalt."
EndSelect

MessageRequester("Compare Files", Text)
Man muss allerdings noch ein bisschen mit dem Buffer spielen. Wenn man ihn größer macht, dann brauchen Dateien, die wirklich gleich sind, nicht so lange zum Vergleichen. Wenn man ihn aber kleiner macht, werden Dateien, die nicht gleich sind und die gleiche Dateigröße haben, schneller aufgedeckt.
Benutzeravatar
dllfreak2001
Beiträge: 2925
Registriert: 07.09.2004 23:44
Wohnort: Bayern

Beitrag von dllfreak2001 »

Was ich fragen wollte...
Würde euch so ein Clonekiller interessieren oder ist das eine sinnlose Entwicklung wie zB. tausend Mediaplayer.

Ich hab schon einige Situationen erlebt wo ich meinen Clonekiller benutzt habe.
Hab schon mal vor einigen Jahren eine Version fertiggestellt die alles konnte und sogar eine Wiederherstellungsroutine hatte. War aber auch mit ordentlicher Oberfläche, multiplen Quellordnern und Dateitypen.

Gebt mir paar Vorschläge... (der Code oben ist natürlich völlig veraltet und ich habe auch schon ein Konzept zur drastischen Beschleunigung des Kramms)
I´a dllfreak2001
tyty
Beiträge: 52
Registriert: 28.03.2008 22:39
Wohnort: Tokyo
Kontaktdaten:

Beitrag von tyty »

Interessieren wuerde ich mich sehr dafuer, aber wie sieht das mit der Geschwindigkeit aus - ist das Vergleichen von 30-50k Dateien innerhalb ertragbarer Zeit realistisch?
Benutzeravatar
dllfreak2001
Beiträge: 2925
Registriert: 07.09.2004 23:44
Wohnort: Bayern

Beitrag von dllfreak2001 »

Die erste fassung von dem Programm brauchte auch seine 15Min um ca. 20k Dateien abzuarbeiten. Ich möchte durch inteligentere Vergleiche und Preview-funktionen das ganze Beschleunigen. Insbesondere große Dateien haben den Kramm dann verlangsamt, die werden erstmal garnicht voll verglichen, es wird stattdessen nur eine Stichprobe entnommen. Wenn die erst identisch mit den anderen Dateien der selben Größe ist, dann wird eine vollständige Untersuchung durchgeführt. Oder auch nicht....
I´a dllfreak2001
sibru
Beiträge: 265
Registriert: 15.09.2004 18:11
Wohnort: hamburg

Beitrag von sibru »

Hab´ hier was hyper-schnelles (basierend auf MD5FileFingerprint()),
Jedenfalls unter PB3.80 hyperschenll, unter PB4.20 speedmäßig nicht getestet...

Code: Alles auswählen

Structure FileEntryType
  FileName$
  Check$
  DublettCnt.l
EndStructure

Global NewList FileEntry.FileEntryType()

Pfad$=PathRequester("Dubletten-Such-Pfad","")

;If ExamineDirectory(1,Pfad$,"*.*")=0 : MessageRequester("Fehler !!!!","kann Verzeichniss nicht öffnen"+Chr(10)+Pfad$) : End : EndIf <-- updated by PB_SrcUpd Vers. 8A22a
PB4_DirNr = 1
If ExamineDirectory(1,Pfad$,"*.*") =0 : MessageRequester("Fehler !!!!","kann Verzeichniss nicht öffnen"+Chr(10)+Pfad$) : End : EndIf
Repeat
  ;FileType=NextDirectoryEntry() <-- updated by PB_SrcUpd Vers. 8A22a
  If NextDirectoryEntry(PB4_DirNr)
    FileType= DirectoryEntryType(PB4_DirNr)
  If FileType = 1 ;hier nur Dateien, keine SubDir´s....
    Files+1
    ;Dateiname$=DirectoryEntryName() <-- updated by PB_SrcUpd Vers. 8A22a
    Dateiname$=DirectoryEntryName(PB4_DirNr)
    Check$= MD5FileFingerprint(Pfad$+Dateiname$)
    ResetList(FileEntry())
    While NextElement(FileEntry())
      If Check$=FileEntry()\Check$
        FileEntry()\DublettCnt+1
        DeleteFile(Pfad$+Dateiname$)
        Check$=""
        DublettCnt+1
      EndIf
    Wend
    If Check$>""
      AddElement(FileEntry())
      FileEntry()\FileName$=Dateiname$
      FileEntry()\Check$=Check$
    EndIf
  EndIf
  EndIf
Until FileType=0
End

Gruss Siggi
Bild Bild
Antworten