forked from fdbozzo/foxbin2prg
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathNormalize_FileNames.vbs
109 lines (97 loc) · 3.88 KB
/
Normalize_FileNames.vbs
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
'---------------------------------------------------------------------------------------------------
' Normalize_FileNames.vbs (VFPx: https://vfpx.codeplex.com/wikipage?title=FoxBin2Prg)
' 06/01/2014 - Fernando D. Bozzo (fdbozzo@gmail.com - Blog: http://fdbozzo.blogspot.com.es/)
'---------------------------------------------------------------------------------------------------
' ENGLISH:
' Create a shortcut on user's "SendTo" folder and configure CAPS on filename_caps.cfg
'
' ESPAÑOL:
' Cree un acceso directo en la carpeta "SendTo" del usuario y configure las Capitalizaciones en filename_caps.cfg
'---------------------------------------------------------------------------------------------------
Const ForReading = 1
Dim WSHShell, FileSystemObject
Dim oVFP9, nExitCode, cEXETool, cCMD, nDebug, cConvertType, aExtensions(8), filename_caps_log, nRet
Dim i, x, str_cfg, aConf
Set WSHShell = WScript.CreateObject("WScript.Shell")
Set FileSystemObject = WScript.CreateObject("Scripting.FileSystemObject")
Set oVFP9 = CreateObject("VisualFoxPro.Application.9")
filename_caps_log = Replace(WScript.ScriptFullName, WScript.ScriptName, "filename_caps.log")
nExitCode = 0
'---------------------------------------------------------------------------------------------------
nDebug = 13 'Cumulative Flags: 0=OFF, 1=Create filename_caps LOG, 2=Only show script calls, 4=Don't show filename_caps error modal messages, 8=Show end of process message
'---------------------------------------------------------------------------------------------------
If WScript.Arguments.Count = 0 Then
nExitCode = 1
cErrMsg = "nDebug = " & nDebug
If GetBit(nDebug, 1) Then
cErrMsg = cErrMsg & Chr(13) & "Bit 0 ON: (1) Create filename_caps LOG"
End If
If GetBit(nDebug, 2) Then
cErrMsg = cErrMsg & Chr(13) & "Bit 1 ON: (2) Only show script calls"
End If
If GetBit(nDebug, 3) Then
cErrMsg = cErrMsg & Chr(13) & "Bit 2 ON: (4) Don't show filename_caps error modal messages"
End If
If GetBit(nDebug, 4) Then
cErrMsg = cErrMsg & Chr(13) & "Bit 3 ON: (8) Show End of Process message"
End If
MsgBox cErrMsg, 64, "No parameters - Debug Status"
Else
cEXETool = Replace(WScript.ScriptFullName, WScript.ScriptName, "filename_caps.exe")
If GetBit(nDebug, 1) And Not GetBit(nDebug, 2) And Not FileSystemObject.FileExists( filename_caps_log ) Then
FileSystemObject.CreateTextFile( filename_caps_log )
End If
For i = 0 To WScript.Arguments.Count-1
scanDirs( WScript.Arguments(i) )
Next
If GetBit(nDebug, 4) Then
If nExitCode = 0 Then
MsgBox "End of Process!", 64, WScript.ScriptName
Else
MsgBox "End of Process!", 48, WScript.ScriptName
End If
End If
End If
WScript.Quit(nExitCode)
Private Sub scanDirs( tcArgument )
Dim omFolder, oFolder
If FileSystemObject.FolderExists( tcArgument ) Then
'-- Es un directorio
Set omFolder = FileSystemObject.GetFolder( tcArgument )
For Each oFile IN omFolder.Files
evaluateFile( oFile.Path )
Next
For Each oFolder IN omFolder.SubFolders
scanDirs( oFolder.Path )
Next
Else
'-- Es un archivo
evaluateFile( tcArgument )
End If
End Sub
Private Sub evaluateFile( tcFile )
cFlagGenerateLog = "'0'"
cFlagDontShowErrMsg = "'0'"
cFlagShowCall = "'0'"
If GetBit(nDebug, 1) Then
cFlagGenerateLog = "'1'"
End If
If GetBit(nDebug, 2) Then
cFlagJustShowCall = "1"
End If
If GetBit(nDebug, 3) Then
cFlagDontShowErrMsg = "'1'"
End If
cCMD = "DO '" & cEXETool & "' WITH '" & tcFile & "','','F','',.F.," & cFlagDontShowErrMsg
If cFlagJustShowCall = "1" Then
MsgBox cCMD, 0, "PARAMETERS"
Else
nRet = oVFP9.DoCmd( cCMD )
nExitCode = oVFP9.Eval("_SCREEN.ExitCodeFNC")
End If
End Sub
Function GetBit(lngValue, BitNum)
Dim BitMask
If BitNum < 32 Then BitMask = 2 ^ (BitNum - 1) Else BitMask = "&H80000000"
GetBit = CBool(lngValue AND BitMask)
End Function