4k - Minitool DesktopArranger

    Diese Seite verwendet Cookies. Durch die Nutzung unserer Seite erklären Sie sich damit einverstanden, dass wir Cookies setzen. Weitere Informationen

    Unsere Datenschutzerklärung wurde aktualisiert. Mit der Nutzung unseres Forums akzeptierst Du unsere Datenschutzerklärung. Du bestätigst zudem, dass Du mindestens 16 Jahre alt bist.

    • 4k - Minitool DesktopArranger

      Hi mal ein kleines nützliches Tool "desktoparranger" welches aus Langeweile entstand.

      Was macht es ?
      -erstellt und Kopiert dateien in Verzeichnisse anhand der Dateimaske.

      Warum ?
      - Die Grundidee war ein Tool zu schreiben welches den Desktop aufräumt ;-)

      bsp.
      *.txt > Ordner "txt" < alle *.txt dateien.

      Beispielbilder:
      vorher:
      [Blockierte Grafik: http://s4.imgload.info/15zu329kg782u15.png]
      nachher:
      [Blockierte Grafik: http://s4.imgload.info/4cweksdc848dgek.png]



      Achtung und todo:
      .................................................................................
      fixed.



      Quellcode

      1. WindowTitle "desktoparranger"
      2. WindowStyle 24
      3. Declare K%,pfad$,l&,origfilename$
      4. l&=@Create("List",1)
      5. origfilename$="desktoparranger.prf"
      6. Proc finddesk
      7. Declare TestPath$
      8. TestPath$ = GetEnv$("USERPROFILE") + "\\Desktop"
      9. Case DirExists(TestPath$) = 1 : pfad$ = TestPath$
      10. EndProc
      11. Proc Findfiles
      12. declare file$,newdir$
      13. IfNot pfad$ = ""
      14. ChDir pfad$
      15. @FindFirst$("*.*")
      16. WhileNot %IOResult
      17. File$ = @FindNext$()
      18. @AddString(l&,File$)
      19. EndWhile
      20. WhileLoop @GetCount(l&)
      21. File$ = GetString$(l&,&loop)
      22. If @Left$(File$,1) = "['
      23. @DeleteString(l&,&loop)
      24. Else
      25. ifNot ((File$ = origfilename$) Or (File$ = ''))
      26. Assign #1,File$
      27. If GetFAttr(#1) & $04 = 4
      28. @DeleteString(l&,&loop)
      29. Else
      30. Newdir$ = @SubStr$(File$,2,'.')
      31. Case DirExists(Newdir$) = 0 : MkDir Newdir$
      32. Copy File$ > Newdir$+'\'+File$
      33. Assign #1, File$
      34. Erase #1
      35. EndIf
      36. EndIf
      37. EndIf
      38. EndWhile
      39. EndIf
      40. EndProc
      41. Proc Clean
      42. finddesk()
      43. findfiles()
      44. EndProc
      45. K% = @MessageBox('Desktop neu anordnen ?','Frage',292)
      46. Case K% = 6 : Clean()
      47. End
      Alles anzeigen
      ansonsten Trotzdem viel Spaß damit ;-)
      Sollten noch Fehler auftreten bitte bescheid sagen.
      Gruß,
      Johannes



      Programmiert in Profan X2
      Gravity 2
    • Deine Proc finddesk ist ja auch ... :-D
      Hier eine Möglichkeit:

      Quellcode

      1. Declare pfad$
      2. Proc finddesk
      3. Declare TestPath$
      4. TestPath$ = GetEnv$("USERPROFILE") + "\\Desktop"
      5. Case DirExists(TestPath$) = 1 : pfad$ = TestPath$
      6. EndProc
      7. Cls
      8. finddesk
      9. Print pfad$
      10. WaitKey
      Alles anzeigen
      Gruß Thomas

      "Die deutsche Rechtschreibung ist Freeware, du darfst sie kostenlos nutzen – Aber sie ist nicht Open Source, d. h. du darfst sie nicht verändern oder in veränderter Form veröffentlichen."
      ComputerInfo für PPF