0/5 (29 avis)
Snippet vu 13 446 fois - Téléchargée 23 fois
' Author : Jean-Michel BRASSEUR ' date : 23 May 2007 ' copyright: lestwins59 ' language : English ' Import the required Libraries Imports system ' Imports system.IO ' Imports System.Math ' ' Main module Module ConsCopyFile Sub Main() Console.Title = "Files Copy Management Utility, Console Application, Visual Basic" ' required elements ' sourcefile name : parameter Dim strPriSourceFileName As String = "FileSource.txt" ' to save all of the files names of a directory, without their fullpath: ' C:\Documents and Settings\infdev13>dir \\Srvssedriis\GESTDOC\SUD_EST\Commercial\Photothèque\CBM_Batiment /B > "C:\Documents and Settings\infdev13\My Documents\ESPACE_TRAVAIL\listeImgCBMBatiment.txt" Dim strPriSourceFileFolderPath As String '= "C:\Documents and Settings\infdev13\My Documents\ESPACE_TRAVAIL\" ' sourcefolder's path : parameter Dim strPriSourceFolderPath As String '= "\\Srvssedriis\GESTDOC\SUD_EST\Commercial\Photothèque\CBM_Batiment\" ' destination's path : parameter Dim strPriDestinationFolderPath As String '= "C:\Documents and Settings\infdev13\My Documents\ESPACE_TRAVAIL\Test\" ' number of rows of the sourcefile Dim intPriNbrRowsTextFile As Integer = 0 ' maximum length of caracters within the text file Dim intPriMaxLengthFileNameTextFile As Integer = 0 ' the file parameters are being keyed in prominently Console.WriteLine("To enable Quick Edit Mode ") Console.WriteLine("1. Open a command prompt/command console") Console.WriteLine("2. Right-click on the title bar") Console.WriteLine("3. Select(properties)") Console.WriteLine("4. Select QuickEdit Mode") Console.WriteLine("5. Select Save Properties for future windows with same title if you want to keep this change forever. " & Chr(13) _ & " Select Apply Properties for current window only if you only want to enable QuickEdit for this session.") Console.WriteLine("6. Click(OK)") Do Console.WriteLine("_____") Console.WriteLine("Parameters:") Console.Write("Path towards the Filenames Source Text File Folder :") strPriSourceFileFolderPath = Console.ReadLine() Console.Write("Filenames Source Text File (*.txt):") strPriSourceFileName = Console.ReadLine() Console.Write("Path towards the Source Folder :") strPriSourceFolderPath = Console.ReadLine() Console.Write("Path towards the Destination Folder :") strPriDestinationFolderPath = Console.ReadLine() Console.WriteLine("_____") ' get the number of rows of the sourcefile intPriNbrRowsTextFile = FunPriGetNbrRowsTextFile(strPriSourceFileFolderPath, strPriSourceFileName) ' enables to check if the filenames source text file has been found Loop Until intPriNbrRowsTextFile > 0 ' loop : from the starting row number row within the text file up to reach the finishing row number or the end of file Dim intPriRowNberToStartAt As Integer '= 1 Dim intPriRowNberToFinishAt As Integer '= 20 Dim boolTestAnswerCopyAllWishedFiles As Boolean = False Do Dim ckiCopyAllWishedFiles As ConsoleKeyInfo Dim strCopyAllWishedFiles As String Console.WriteLine("Do you want to copy a certain numbers of files (N) or copy all of them (A)?") ckiCopyAllWishedFiles = Console.ReadKey(True) strCopyAllWishedFiles = StrConv(ckiCopyAllWishedFiles.KeyChar(), VbStrConv.Uppercase) Select Case strCopyAllWishedFiles Case Is = "N" Console.Write("Start Line Number :") intPriRowNberToStartAt = Console.ReadLine() Console.Write("End Line Number :") intPriRowNberToFinishAt = Console.ReadLine() boolTestAnswerCopyAllWishedFiles = True Case Is = "A" intPriRowNberToStartAt = 1 intPriRowNberToFinishAt = FunPriGetNbrRowsTextFile(strPriSourceFileFolderPath, strPriSourceFileName) boolTestAnswerCopyAllWishedFiles = True Case Else Console.WriteLine("You did have key in a wrong value") End Select Loop While boolTestAnswerCopyAllWishedFiles = False 'the subprocedure bound to the copy core function of the program is being processed Console.WriteLine("_____") Console.WriteLine("Processing :") Call SubPriCopyCurrentFileWithinTextFile(strPriSourceFileFolderPath, _ strPriSourceFileName, _ strPriSourceFolderPath, _ strPriDestinationFolderPath, _ intPriRowNberToStartAt, _ intPriRowNberToFinishAt) Console.WriteLine("_____") Console.WriteLine("Press any key to quit") Console.ReadLine() End Sub Private Function FunPriGetNbrRowsTextFile(ByVal strPriSourceFileFolderPath As String, _ ByVal strPriSourceFileName As String) As Integer Try Dim sr As StreamReader Dim intPriCounterOfRowsWithinTextFile As Integer = 0 Dim strPriFileName As String = "" Console.WriteLine("") Console.WriteLine("Unfolding of the Task:") sr = File.OpenText(strPriSourceFileFolderPath & "\" & strPriSourceFileName) Do While sr.Peek() >= 0 strPriFileName = sr.ReadLine() intPriCounterOfRowsWithinTextFile += 1 Loop sr.Close() Console.WriteLine("The source File contains : " & intPriCounterOfRowsWithinTextFile & " Filenames.") Return (intPriCounterOfRowsWithinTextFile) Catch Console.WriteLine("The Source File containing the Filenames to be copied from has not been found..") Return (0) End Try End Function Private Function funPriMaxLengthFileNameTextFile(ByVal strPriSourceFileFolderPath As String, _ ByVal strPriSourceFileName As String) As Integer Try Dim sr As StreamReader Dim intPriMaxLengthFileNameTextFile As Integer = 0 Dim strPriFileName As String = "" sr = File.OpenText(strPriSourceFileFolderPath & "\" & strPriSourceFileName) Do While sr.Peek() >= 0 strPriFileName = sr.ReadLine() If Len(strPriFileName) > intPriMaxLengthFileNameTextFile Then intPriMaxLengthFileNameTextFile = Len(strPriFileName) Loop sr.Close() Return (intPriMaxLengthFileNameTextFile) Catch Return (0) End Try End Function Private Function strPriAddSpacesOnDisplay(ByVal strPriFileName As String, ByVal strPriSourceFileFolderPath As String, ByVal strPriSourceFileName As String) As String Dim intMaxLengthFileNameTextFile As Integer = 0 Dim strAddOneSpaceToStringValue = "" Dim intAddOneSpaceToStringValue As Integer = 0 intMaxLengthFileNameTextFile = funPriMaxLengthFileNameTextFile(strPriSourceFileFolderPath, strPriSourceFileName) strPriAddSpacesOnDisplay = "" Do strPriAddSpacesOnDisplay += " " intAddOneSpaceToStringValue += 1 Loop Until intAddOneSpaceToStringValue > (intMaxLengthFileNameTextFile - Len(strPriFileName)) Return (strPriAddSpacesOnDisplay) End Function Private Sub SubPriCopyCurrentFileWithinTextFile(ByVal strPriSourceFileFolderPath As String, _ ByVal strPriSourceFileName As String, _ ByVal strPriSourceFolderPath As String, _ ByVal strPriDestinationFolderPath As String, _ ByVal intPriRowNberToStartAt As Integer, _ ByVal intPriRowNberToFinishAt As Integer) Dim strPriFileName As String = "" Dim intPriCurrentRowNberWithinTextFile As Integer = 1 Dim sr As StreamReader Dim floPriPctOfTaskDone As Single = 0 Dim intPriNbrOfFilesToBeCopied As Integer = 0 intPriNbrOfFilesToBeCopied = intPriRowNberToFinishAt - intPriRowNberToStartAt + 1 Console.WriteLine(intPriNbrOfFilesToBeCopied & " Files to be copied. From the row number : " & intPriRowNberToStartAt & " to the row number : " & intPriRowNberToFinishAt) sr = File.OpenText(strPriSourceFileFolderPath & "\" & strPriSourceFileName) ' Do Do While sr.Peek() >= 0 Try strPriFileName = sr.ReadLine() ' get the filename Select Case intPriCurrentRowNberWithinTextFile Case intPriRowNberToStartAt To intPriRowNberToFinishAt ' the file is being copied only if intPriCurrentRowNberWithinText is in between > intPriNbrRowsTextFile ' copy the corresponding file Select Case File.Exists(strPriDestinationFolderPath & "\" & strPriFileName) Case Is = True Console.WriteLine("The file :" & strPriFileName & " has been already copied") ' increment intPriCurrentRowNberWithinText intPriCurrentRowNberWithinTextFile += 1 Case Else 'Console.WriteLine("{0} already exists.", strFileA) File.Copy(strPriSourceFolderPath & "\" & strPriFileName, strPriDestinationFolderPath & "\" & strPriFileName) ' udpate the progress rate floPriPctOfTaskDone = (intPriCurrentRowNberWithinTextFile / intPriNbrOfFilesToBeCopied) * 100 Console.WriteLine(strPriFileName & _ strPriAddSpacesOnDisplay(strPriFileName, strPriSourceFileFolderPath, strPriSourceFileName) & _ " has been copied," & Format(Round(floPriPctOfTaskDone, 1), "#0.0") & "% of job processed") subPriFilesDealtReports(strPriSourceFileFolderPath, strPriFileName, True) End Select Case Else End Select ' increment intPriCurrentRowNberWithinText intPriCurrentRowNberWithinTextFile += 1 Catch ' exit in case a file exception has been caught Console.WriteLine("The File :" & strPriFileName & " to be copied from has not been found..") subPriFilesDealtReports(strPriSourceFileFolderPath, strPriFileName, False) Select Case intPriCurrentRowNberWithinTextFile Case intPriRowNberToStartAt To intPriRowNberToFinishAt ' increment intPriCurrentRowNberWithinText intPriCurrentRowNberWithinTextFile += 1 Case Else End Select End Try Loop ' end of loop sr.Close() End Sub Public Sub subPriFilesDealtReports(ByVal strPriSourceFileFolderPath As String, ByVal strPriFileName As String, ByVal BooPriFileStatus As Boolean) Select Case BooPriFileStatus Case Is = True ' if the file has been found, its name is being copied within the SavedFiles text file Using sw As StreamWriter = File.AppendText(strPriSourceFileFolderPath & "\" & "SavedFiles.txt") ' Add some text to the file. sw.WriteLine(strPriFileName) ' Arbitrary objects can also be written to the file. sw.Close() End Using Case Is = False ' if the file has not been found, its name is being copied within the NotFoundFiles text file Using sw As StreamWriter = File.AppendText(strPriSourceFileFolderPath & "\" & "NotFoundFiles.txt") ' Add some text to the file. sw.WriteLine(strPriFileName) ' Arbitrary objects can also be written to the file. sw.Close() End Using End Select End Sub End Module
10 juin 2007 à 14:20
10 juin 2007 à 13:44
10 juin 2007 à 12:17
ALLTHEW3 : Je crois que c'est plutôt toi qui est de mauvaise fois mais si tu sais toujours pas à quoi sert le GOTO tant pis pour toi.
10 juin 2007 à 11:03
pire que de la mauvaise foi ^^
Goto End (jamais utilisé de goto de ma vie : je sais même pas si c'est bon)
10 juin 2007 à 10:43
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.