Forum Liberty Basic France

• Index
• Subs et Snippets » [JB] [function] Copier l'arborescence d'un dossier
Black Templar
Le 13/04/2011 à 18h22

Administrateur

Groupe: Administrateur

Inscrit le: 24/09/2010
Messages: 203
Voici une fonction "CopyFolder" originalement écrit par McKurt pour LB et modifié pour fonctionner aussi pour JB qui permet de copier un dossier complet ainsi que toute son arborescence dans un autre dossier.

Code VB :
 
function CopyFolder(StartFolder$, EndFolder$)
    dim Info$(1,1)
    call SearchFolders StartFolder$, EndFolder$
end function
 
sub SearchFolders Folder$, Folder2$
    files Folder$, Info$(
    numSubFolders = val(Info$(0,1))
    numFiles = val(Info$(0,0))
    for count = 1 to numSubFolders
        if FoundFolders$ = "" then
            CopyFolders$ = Folder2$;"\"; Info$(numFiles + count,1)
            FoundFolders$ = Info$(0,2); Info$(0,3); Info$(numFiles + count,1)
        else
            FoundFolders$ = FoundFolders$; ";"; Info$(0,2); Info$(0,3); Info$(numFiles + count,1)
            CopyFolders$ = CopyFolders$; ";"; Folder2$ ;"\"; Info$(numFiles + count,1)
        end if
    next
    for count = 1 to numFiles
        if FoundFiles$ = "" then
            CopyFiles$ = Folder2$;"\"; Info$(count,0)
            FoundFiles$ = Info$(0,2); Info$(0,3); Info$(count,0)
        else
            FoundFiles$ = FoundFiles$; ";"; Info$(0,2); Info$(0,3); Info$(count,0)
            CopyFiles$ = CopyFiles$; ";"; Folder2$ ;"\"; Info$(count,0)
        end if
    next
 
    leftFolders = numSubFolders
    while leftFolders > 0
        call SearchFolders word$(FoundFolders$, leftFolders, ";"), word$(CopyFolders$, leftFolders, ";")
        leftFolders = leftFolders - 1
    wend
    call CreateDir Folder2$
    call CopyFile FoundFiles$, CopyFiles$, numFiles
    print "   "; Folder$ ;"  --->  "; Folder2$
end sub
 
sub CreateDir dPath$
[loop]
    result=instr(dPath$,"\",result+1)
    if result<>0 then
        temp$=left$(dPath$,result)
        r=mkdir(temp$)
        goto [loop]
    end if
    r=mkdir(dPath$)
end sub
 
sub CopyFile sFiles$, dFiles$, numF
    while numF > 0
        FileS$ = word$(sFiles$, numF, ";")
        FileD$ = word$(dFiles$, numF, ";")
        call copy FileS$, FileD$
        print FileS$ ;"  --->  "; FileD$
        numF = numF - 1
    wend
end sub
 
sub copy filepath$, newFilepath$
 
    'Ouverture du fichier source
    open filepath$ for input as #source
        file$ = input$(#source, lof(#source))   'Récupère le contenu de l'ensemble du fichier
    close #source
 
    'Ouverture du fichier de destination
    open newFilepath$ for output as #dest
        print #dest, file$ 
    close #dest
 
end sub
 
 





Voilà un exemple d'utilisation en JB :
Code VB :
'//////////////////////////////////////////////////////////'
'                                                          '
'   Function creates by Mc-Kurt for Liberty BASIC France   '
'   Adaptated for JB by Black Templar
'         http://libertybasic.fr        '
'     It is using Stefan Pendl's SearchFolders routine     '
'                                                          '
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'
'----------------------------------------------------------'
' this function copies a specified folder with all its     '
' sub-folders towards another one                          '
'----------------------------------------------------------'

StartFolder$ = ""
EndFolder$ = ""
if StartFolder$ = "" or EndFolder$ = "" then
    print "Specify folders"
    input "Start Folder :"; StartFolder$
    input "End Folder :"; EndFolder$
end if
print "Copy folder in progress..." : print : print
r = CopyFolder(StartFolder$, EndFolder$)
print : print : print "The folder "; StartFolder$ ;" was indeed copied towards "; EndFolder$
end
 
 
 
function CopyFolder(StartFolder$, EndFolder$)
    dim Info$(1,1)
    call SearchFolders StartFolder$, EndFolder$
end function
 
sub SearchFolders Folder$, Folder2$
    files Folder$, Info$(
    numSubFolders = val(Info$(0,1))
    numFiles = val(Info$(0,0))
    for count = 1 to numSubFolders
        if FoundFolders$ = "" then
            CopyFolders$ = Folder2$;"\"; Info$(numFiles + count,1)
            FoundFolders$ = Info$(0,2); Info$(0,3); Info$(numFiles + count,1)
        else
            FoundFolders$ = FoundFolders$; ";"; Info$(0,2); Info$(0,3); Info$(numFiles + count,1)
            CopyFolders$ = CopyFolders$; ";"; Folder2$ ;"\"; Info$(numFiles + count,1)
        end if
    next
    for count = 1 to numFiles
        if FoundFiles$ = "" then
            CopyFiles$ = Folder2$;"\"; Info$(count,0)
            FoundFiles$ = Info$(0,2); Info$(0,3); Info$(count,0)
        else
            FoundFiles$ = FoundFiles$; ";"; Info$(0,2); Info$(0,3); Info$(count,0)
            CopyFiles$ = CopyFiles$; ";"; Folder2$ ;"\"; Info$(count,0)
        end if
    next
 
    leftFolders = numSubFolders
    while leftFolders > 0
        call SearchFolders word$(FoundFolders$, leftFolders, ";"), word$(CopyFolders$, leftFolders, ";")
        leftFolders = leftFolders - 1
    wend
    call CreateDir Folder2$
    call CopyFile FoundFiles$, CopyFiles$, numFiles
    print "   "; Folder$ ;"  --->  "; Folder2$
end sub
 
sub CreateDir dPath$
[loop]
    result=instr(dPath$,"\",result+1)
    if result<>0 then
        temp$=left$(dPath$,result)
        r=mkdir(temp$)
        goto [loop]
    end if
    r=mkdir(dPath$)
end sub
 
sub CopyFile sFiles$, dFiles$, numF
    while numF > 0
        FileS$ = word$(sFiles$, numF, ";")
        FileD$ = word$(dFiles$, numF, ";")
        call copy FileS$, FileD$
        print FileS$ ;"  --->  "; FileD$
        numF = numF - 1
    wend
end sub
 
sub copy filepath$, newFilepath$
 
    'Ouverture du fichier source
    open filepath$ for input as #source
        file$ = input$(#source, lof(#source))   'Récupère le contenu de l'ensemble du fichier
    close #source
 
    'Ouverture du fichier de destination
    open newFilepath$ for output as #dest
        print #dest, file$ 
    close #dest
 
end sub
 
 
Mail MSN Web    
• Subs et Snippets » [JB] [function] Copier l'arborescence d'un dossier  
• Index

 |  |

1 Utilisateur en ligne : 0 Administrateur, 0 Modérateur, 0 Membre et 1 Visiteur
Utilisateur en ligne : Aucun membre connecté
Répondre
Vous n'êtes pas autorisé à écrire dans cette catégorie