-
Notifications
You must be signed in to change notification settings - Fork 35
/
Convert_VFP9_PRG_2_BIN.vbs
201 lines (180 loc) · 8.23 KB
/
Convert_VFP9_PRG_2_BIN.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
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
'---------------------------------------------------------------------------------------------------
' Convert_VFP9_PRG_2_BIN.vbs (VFPx: https://vfpx.codeplex.com/wikipage?title=FoxBin2Prg)
' 03/01/2014 - Fernando D. Bozzo ([email protected] - Blog: http://fdbozzo.blogspot.com.es/)
'---------------------------------------------------------------------------------------------------
' ENGLISH:
' - Copy this file in the same directory of FoxBin2prg and create a shortcut
' on user's "SendTo" folder
' - Now you can select files or directories, right click and "SendTo" FoxBin2prg for batch conversion
'
' ESPAÑOL:
' - Copie este archivo en el mismo directorio que FoxBin2prg y cree un acceso directo
' en la carpeta "SendTo" del usuario
' - Ahora puede seleccionar archivos o directorios, pulsar click derecho y "Enviar a" FoxBin2prg para conversiones batch
'---------------------------------------------------------------------------------------------------
Const ForReading = 1
Dim WSHShell, FileSystemObject, cEndOfProcessMsg, cWithErrorsMsg, cConvCancelByUserMsg, nProcessedFilesCount
Dim oVFP9, nExitCode, cEXETool, cCMD, nDebug, lcExt, foxbin2prg_cfg, aFiles(), nFile_Count
Dim i, x, str_cfg, aConf, cErrMsg, cFlagGenerateLog, cFlagDontShowErrMsg, cFlagJustShowCall, cFlagRecompile, cFlagNoTimestamps, cErrFile
'' 2016.04.05 DH: added next line
dim fileToProcess
Set WSHShell = WScript.CreateObject("WScript.Shell")
Set FileSystemObject = WScript.CreateObject("Scripting.FileSystemObject")
Set oVFP9 = CreateObject("VisualFoxPro.Application.9")
foxbin2prg_cfg = Replace(WScript.ScriptFullName, WScript.ScriptName, "foxbin2prg.cfg")
nExitCode = 0
'---------------------------------------------------------------------------------------------------
'Cumulative Flags:
' 0=OFF
' 1=Create FoxBin2prg LOG
' 2=Only show script calls (for testing without executing)
' 4=Don't show FoxBin2prg error modal messages
' 8=Show end of process message
' 16=Empty timestamps
nDebug = 1+0+4+8+16
'---------------------------------------------------------------------------------------------------
If WScript.Arguments.Count = 0 Then
'SIN PARÁMETROS
nExitCode = 1
cErrMsg = "nDebug = " & nDebug
If GetBit(nDebug, 1) Then
cErrMsg = cErrMsg & Chr(13) & "Bit 0 ON: (1) Create FoxBin2prg 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 FoxBin2prg 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
If GetBit(nDebug, 5) Then
cErrMsg = cErrMsg & Chr(13) & "Bit 4 ON: (16) Empty timestamps"
End If
MsgBox cErrMsg, 64, "No parameters - Debug Status"
Else
'CON PARÁMETROS
cEXETool = Replace(WScript.ScriptFullName, WScript.ScriptName, "foxbin2prg.exe")
nFile_Count = 0
oVFP9.DoCmd( "SET PROCEDURE TO '" & cEXETool & "'" )
oVFP9.DoCmd( "PUBLIC oFoxBin2prg" )
oVFP9.DoCmd( "oFoxBin2prg = CREATEOBJECT('c_foxbin2prg')" )
oVFP9.DoCmd( "oFoxBin2prg.loadProgressbarForm()" )
oVFP9.DoCmd( "oFoxBin2prg.o_frm_avance.Caption = '" & FileSystemObject.GetBaseName( WScript.ScriptName ) & " - ' + oFoxBin2Prg.c_loc_process_progress" )
For i = 0 To WScript.Arguments.Count-1
scanDirs( WScript.Arguments(i) )
Next
If WScript.Arguments.Count = 1 AND FileSystemObject.FolderExists( WScript.Arguments(0) ) Then
'-- Es un solo directorio. Lo tomo como origen de compilación
cFlagRecompile = "'" & WScript.Arguments(0) & "'"
Else
cFlagRecompile = "'1'"
End If
cFlagGenerateLog = "'0'"
cFlagDontShowErrMsg = "'0'"
'' 2016.04.05 DH: fixed incorrectly named variable
cFlagJustShowCall = "'0'"
'' 2016.04.05 DH: added missing assignment
cFlagNoTimestamps = "'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
If GetBit(nDebug, 5) Then
cFlagNoTimestamps = "'1'"
End If
oVFP9.DoCmd( "oFoxBin2prg.o_frm_avance.Caption = '" & FileSystemObject.GetBaseName( WScript.ScriptName ) & " - ' + oFoxBin2Prg.c_loc_process_progress + ' (Press Esc to Cancel)'" )
For i = 1 To nFile_Count
'' 2016.04.05 DH: put double quotes around path in case in contains single quote
fileToProcess = Chr(34) + aFiles(i) + Chr(34)
oVFP9.DoCmd( "oFoxBin2Prg.updateProgressbar(oFoxBin2Prg.c_loc_processing_file + " & fileToProcess & ", " & i & ", " & nFile_Count & ", 0)" )
cFlagRecompile = Chr(34) + FileSystemObject.GetParentFolderName( aFiles(i) ) + Chr(34)
'' 2016.04.05 DH: end of change
If nDebug = 0 Or nDebug = 2 Then
'' 2016.04.05 DH: use new variable
cCMD = "oFoxBin2prg.execute(" & fileToProcess & ")"
Else
'' 2016.04.05 DH: use new variable
cCMD = "oFoxBin2prg.execute(" & fileToProcess & ",'PRG2BIN','0','0'," _
& cFlagDontShowErrMsg & "," & cFlagGenerateLog & ",'1','','',.F.,''," _
& cFlagRecompile & "," & cFlagNoTimestamps & " )"
End If
If cFlagJustShowCall = "1" Then
MsgBox cCMD, 64, "PARAMETERS"
Else
nExitCode = oVFP9.Eval(cCMD)
End If
If nExitCode = 1799 Then 'Conversion cancelled by user
Exit For
End If
Next
If GetBit(nDebug, 4) Then
cEndOfProcessMsg = oVFP9.Eval("_SCREEN.o_FoxBin2Prg_Lang.C_END_OF_PROCESS_LOC")
cWithErrorsMsg = oVFP9.Eval("_SCREEN.o_FoxBin2Prg_Lang.C_WITH_ERRORS_LOC")
cConvCancelByUserMsg = oVFP9.Eval("_SCREEN.o_FoxBin2Prg_Lang.C_CONVERSION_CANCELLED_BY_USER_LOC")
nProcessedFilesCount = oVFP9.Eval("oFoxBin2prg.n_ProcessedFilesCount")
If nExitCode = 1799 Then
MsgBox cConvCancelByUserMsg & "! [p:" & nProcessedFilesCount & "]", 48+4096, WScript.ScriptName & " (" & oVFP9.Eval("oFoxBin2prg.c_FB2PRG_EXE_Version") & ")"
oVFP9.DoCmd("oFoxBin2prg.writeErrorLog_Flush()")
cErrFile = oVFP9.Eval("oFoxBin2prg.c_ErrorLogFile")
WSHShell.run cErrFile,3
ElseIf oVFP9.Eval("oFoxBin2prg.l_Error") Then
MsgBox cEndOfProcessMsg & "! (" & cWithErrorsMsg & ") [p:" & nProcessedFilesCount & "]", 48+4096, WScript.ScriptName & " (" & oVFP9.Eval("oFoxBin2prg.c_FB2PRG_EXE_Version") & ")"
oVFP9.DoCmd("oFoxBin2prg.writeErrorLog_Flush()")
cErrFile = oVFP9.Eval("oFoxBin2prg.c_ErrorLogFile")
WSHShell.run cErrFile,3
Else
MsgBox cEndOfProcessMsg & "! [p:" & nProcessedFilesCount & "]", 64+4096, WScript.ScriptName & " (" & oVFP9.Eval("oFoxBin2prg.c_FB2PRG_EXE_Version") & ")"
End If
End If
oVFP9.DoCmd( "oFoxBin2prg = NULL" )
oVFP9.DoCmd( "CLEAR ALL" )
Set oVFP9 = Nothing
End If
WScript.Quit nExitCode
Private Sub scanDirs( tcArgument )
Dim omFolder, oFolder
If FileSystemObject.FolderExists( tcArgument ) Then
'-- Es un directorio
oVFP9.DoCmd( "oFoxBin2Prg.updateProgressbar('Scanning file and directory information on " & tcArgument & "...', 0, 0, 0)" )
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 )
'lcExt = UCase( FileSystemObject.GetExtensionName( tcFile ) )
'lcFileName = FileSystemObject.GetFileName( tcFile )
'laPoints = Split( lcFileName, "." )
'lnPoints = UBound(laPoints)
'-- No proceso los archivos con más de un punto (clases en archivos individuales) por performance
'If lnPoints = 1 Then
'PROCEDURE evaluateConfiguration
' LPARAMETERS tcDontShowProgress, tcDontShowErrors, tcFlagNoTimestamps, tcDebug, tcRecompile, tcExtraBackupLevels ;
' , tcClearUniqueID, tcOptimizeByFilestamp, tc_InputFile
'oVFP9.DoCmd( "oFoxBin2prg.evaluateConfiguration( '1', '1', '', '', '', '', '', '', '" & tcFile & "' )" )
'If oVFP9.Eval("oFoxBin2prg.hasSupport_Prg2Bin('" & lcExt & "')") Then
nFile_Count = nFile_Count + 1
ReDim Preserve aFiles(nFile_Count)
aFiles(nFile_Count) = tcFile
'End If
'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