1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133
|
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Const TristateUseDefault = -2
Const TristateTrue = -1
Const TristateFalse = 0
Const dbgFilename = "out.txt"
Const inputDirectory = "./in"
Const outputDirectory = "./out"
' pour le debug
Const dbg_printLine = true
Dim lineCount_out
lineCount_out = 0
run()
Function run()
Dim fso, textStreamDbg
Set fso = CreateObject("Scripting.FileSystemObject")
' *********************************
' Nettoyage du dossier de sortie
If FolderExists(outputDirectory) = true Then
fso.DeleteFolder outputDirectory, True
End If
fso.CreateFolder outputDirectory
Set folderOut = fso.GetFolder(outputDirectory)
' *********************************
Set fso = CreateObject("Scripting.FileSystemObject")
Set textStreamDbg = fso.CreateTextFile(dbgFilename, true)
ParcourDossier textStreamDbg, inputDirectory, folderOut
textStreamDbg.Close
End Function
Function FolderExists(strFolderPath)
Dim fileObject
Set fileObject = CreateObject("Scripting.FileSystemObject")
On Error Resume Next ' Si erreur, continuer
FolderExists = fileObject.FolderExists(strFolderPath)
If Err.number <> 0 Then
FolderExists = False
Call Err.Clear()
End If
On Error Goto 0
Set fileObject = Nothing
End Function
Function ParcourDossier(textStreamDbg, directoryIn, folderOut)
Dim fso, folder, subfolders, subfiles
Dim subfolderOut, subfolderOut_name, fileOut_path
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(directoryIn)
Set subfolders = folder.SubFolders
Set subfiles = folder.Files
for each objFolder in subfolders
'textStreamDbg.WriteLine(objFolder.Name)
subfolderOut_name = folderOut.Path & "\" & objFolder.Name
fso.CreateFolder subfolderOut_name
Set subfolderOut = fso.GetFolder(subfolderOut_name)
ParcourDossier textStreamDbg, objFolder, subfolderOut
next
for each objFile in subfiles
'textStreamDbg.WriteLine(" " & objFile.Path)
'textStreamDbg.WriteLine(" " & objFile.Name)
fileOut_path = folderOut.Path & "\" & objFile.Name
parseFile textStreamDbg, objFile, fileOut_path
next
End Function
Function parseFile(textStreamDbg, objFile, fileOut_path)
Set fso = CreateObject("Scripting.FileSystemObject")
textStreamDbg.WriteLine("***** [File] " & objFile.Path & " *****")
parseTextFile textStreamDbg, objFile, fileOut_path
End Function
Function parseTextFile(textStreamDbg, objFile, fileOut_path)
Dim textStreamIn, textStreamOut
Set fso = CreateObject("Scripting.FileSystemObject")
Set textStreamIn = fso.OpenTextFile(objFile.Path, ForReading, TristateTrue)
textStreamDbg.WriteLine(fileOut_path)
Set textStreamOut = fso.CreateTextFile(fileOut_path, true)
'Do While textStreamIn.AtEndOfStream = false
Do Until textStreamIn.AtEndOfStream
parseTextZone textStreamDbg, objFile, textStreamIn, textStreamOut
Loop ' textStreamIn
textStreamOut.Close
textStreamIn.Close
End Function
Function parseTextZone(textStreamDbg, objFile, textStreamIn, textStreamOut)
Dim line
'Do While textStreamIn.AtEndOfStream = false
Do Until textStreamIn.AtEndOfStream
line = textStreamIn.ReadLine
If dbg_printLine = true Then
textStreamDbg.WriteLine("Get New Line (" & objFile.Name & "): " & line)
End If
' test for last line (if it is an empty line)
If(lineCount_out > 0) Then
textStreamOut.WriteLine("")
End If
lineCount_out = lineCount_out + 1
textStreamOut.Write(line)
Loop ' textStreamIn
End Function |
Partager