Re: Developpement d'utilitaires à la demande

Publié par Gerome le 10/01/2008 22:20:05
Citation :

godel1649 a écrit:

Autre demande
j ai parfois de nombreux fichiers à trier (des photos)
leur nom comporte une partie fixe et une variable
exemple
abc001
abc002
..
abc999
abd001
abd002
abd003
...
zaa0001
zaa0002

j aimerais que "automatiquement" ces fichiers soirent rangés dans des sous répertoires nommés par la partie "fixe" de leur nom (la création de ces répertoires devant être auto aussi)
ie. ici abc/abd/zaa

Bon ce ne sont que des idées...


Voici la réalisation de cette idée ci-dessous :
#Option Strict
#AppType CONSOLE

#Define     SEP ""
#DllDeclare MSVCRT( mkdir )
#DllDeclare KERNEL32( CopyFile, DeleteFile )


Dim e, sName, sFolder, sNumber, vtPics[]

Color(11, 0): Cls
'Test()

? "        // ***************** //"
? "       //    RANGEUR 1.0    //"
? "      // ***************** //"
?.
sFolder = Curdir()
If Right(sFolder, 1) <> SEP Then sFolder = sFolder & SEP
GetFiles( sFolder, "*.jpg" )

ForEach e In vtPics: CutFile(e, sName, sNumber): Next e
? "< The End :)"
?.
Pause

Sub CutFile(sSource_, sName_, sNumber_)
Static %i, %j
    For i = 1 To StrLen(sSource_)
        If sSource_{i} >= "0" AndAlso sSource_{i} <= "9" Then
                sNumber_ = Mid(sSource_, i)
                sName_   = Left(sSource_, i-1)
                If NOT FileExist(sName_) Then
                    mkDir(sName_)
                    ? "> Creation du repertoire '", sName_, "'"
                End If
                If CopyFile(sSource_, sName_ & SEP & sSource_, FALSE) Then
                    ? "> " & sSource_, " file copied to ", sName_ & SEP & sSource_
                    DeleteFile(sSource_)
                End If
            Exit For
        End If
    Next i
End Sub

Sub GetFiles(sPath, sJoker)
Dim x
    If FindFirst( sPath & sJoker ) <> "" Then
        vtPics[] = FindFirst
        x = FindNext()
        While x <> ""
            vtPics[] = x: x = FindNext()
        Wend
    End If
    ? "> " & Count(vtPics), " '" & sJoker & "' files found!"
End Sub

Sub Test()
    ? "Test..."
    vtPics = { "abc001.jpg", "abc002.jpg", "abd001.jpg", "abd002.jpg", "zaa0001.jpg" }
    ForEach e In vtPics: FileClose( FileOpen(e, BINARY_NEW) ): Next e
    Pause
End Sub


Il suffit de telecharger FBSL ici et ensuite de récupérer le code qui est cité ci-dessus, de l'enregistrer avec l'extension .FBS et de placer ce script dans le répertoire où tu as tes .JPG
Si tu veux donner d'autres noms d'extension, il suffit de changer la ligne 20 du script : GetFiles( sFolder, "*.jpg" )
par les jokers voulus :)

Voilà, c'est ce que j'appelle une éalisation honnête et rapide pour moi à développer!

A noter que ce script peut etre compilé en EXEcutable 100% autonaume

Enjoy FBSL!

Cette contribution était de : http://www.gratilog.net/xoops/newbb/viewtopic.php?forum=2&topic_id=3002&post_id=15611