Forum Liberty Basic France
• Index
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 :
Voilà un exemple d'utilisation en JB :
Code VB :
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
• Index
1 Utilisateur en ligne : 0 Administrateur, 0 Modérateur, 0 Membre et 1 Visiteur
Utilisateur en ligne : Aucun membre connecté
Utilisateur en ligne : Aucun membre connecté
Répondre
Vous n'êtes pas autorisé à écrire dans cette catégorie