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
| Option Explicit
Const Titre = "Conversion fichiers (.reg) Profiles Outlook"
Const ForReading = 1
Const ForWriting = 2
Const TriStateUseDefault = -2
Dim sInfile,sOutfileREG,oFSO,Ws,Folder,Contents,TypeEncoding
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set Ws = CreateObject("Wscript.Shell")
If (WScript.Arguments.Count > 0) Then
sInfile = WScript.Arguments(0)
If LCase(oFSO.GetExtensionName(sInfile)) <> "reg" Then
MsgBox "ATTENTION ! ! !" & vbcr &_
"Pour utiliser ce programme il faut glisser et déposer un fichier avec l'extension (.reg ) sur ce script pour le convertir ",vbExclamation,Titre
Wscript.Quit()
End If
Else
MsgBox "ATTENTION ! ! !" & vbcr &_
"Pour utiliser ce programme il faut glisser et déposer un fichier avec l'extension (.reg ) sur ce script pour le convertir ",vbExclamation,Titre
WScript.Quit
End If
'Nom du dossier de la conversion
Folder = GetFilenameWithoutExtension(sInfile) & "_Office-Conversion"
'Création du dossier de la conversion
If Not oFSO.FolderExists(Folder) Then
oFSO.CreateFolder(Folder)
End If
sOutfileREG = Folder & "\" & GetName(sInfile) & ".reg"
If oFSO.FileExists(sOutfileREG) Then
oFSO.DeleteFile(sOutfileREG)
End If
TypeEncoding = CheckEncoding(sInfile)
Contents = ReadFile(sInfile,TypeEncoding)
Contents = Replace(Contents,"15.0","16.0")
Contents = Replace(Contents,"Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles","Office\16.0\Outlook\Profiles")
Call WriteFile(Contents,sOutfileREG)
'*********************************************************************
Function CheckEncoding(filename)
Dim fso,ts,char1,char2
set fso = createobject("scripting.filesystemobject")
set ts = fso.opentextfile(filename)
char1 =ts.read(1)
char2 =ts.read(1)
ts.close
if asc(char1) = 255 and asc(char2) = 254 then
CheckEncoding = "unicode"
else
CheckEncoding = "ascii"
end if
End Function
'*********************************************************************
Function ReadFile(path,mode)
Const ForReading = 1
Const TriStateUseDefault = -2
Dim objFSO,objFile,i,contents
Set objFSO = CreateObject("Scripting.FileSystemObject")
If mode = "unicode" Then
Set objFile = objFSO.opentextfile(path,,,true)
contents = objFile.ReadAll
ReadFile = contents
objFile.Close
End If
If mode = "byline" then
Set objFile = objFSO.OpenTextFile(path,ForReading)
Dim arrFileLines()
i = 0
Do Until objFile.AtEndOfStream
Redim Preserve arrFileLines(i)
strLine = objFile.ReadLine
strLine = Trim(strLine)
If Len(strLine) > 0 Then
arrFileLines(i) = strLine
i = i + 1
ReadFile = arrFileLines
End If
Loop
objFile.Close
End If
If mode = "all" Then
contents = objFile.ReadAll
ReadFile = contents
objFile.Close
End If
End Function
'*****************************************************************
'Fonction pour écrire le résultat dans un fichier texte
Sub WriteFile(strText,File)
Dim fs,ts
Const ForAppending = 8
Const TriStateUseDefault = -2 'Unicode
Set fs = CreateObject("Scripting.FileSystemObject")
Set ts = fs.OpenTextFile(File,ForAppending,True,TriStateUseDefault)
ts.WriteLine strText
ts.Close
End Sub
'**********************************************************************************************
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'**********************************************************************************************
Function GetFilenameWithoutExtension(ByVal FileName)
Dim Result, i
Result = FileName
i = InStrRev(FileName, ".")
If ( i > 0 ) Then
Result = Mid(FileName, 1, i - 1)
End If
GetFilenameWithoutExtension = Result
End Function
'**********************************************************************************************
Function GetName(Path)
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
GetName = fso.GetBaseName(path)
End Function
'********************************************************************************************** |
