--- /dev/null
+Option Explicit \r
+\r
+' vbslib ver2.00 2008/8/17\r
+' Copyright (c) 2008, T's-Neko\r
+' All rights reserved. 3-clause BSD license.\r
+\r
+\r
+Dim g_debug_vbs_inc\r
+Dim g_debug, g_vbslib_path, g_IncludePathes, g_IncludeType, g_CommandPrompt\r
+Dim g_b_cscript_exe\r
+Dim g_sh, g_fs\r
+Dim g_f, g_i, g_err, g_path\r
+\r
+Set g_sh = WScript.CreateObject("WScript.Shell")\r
+If Not IsEmpty( WScript.Arguments.Named("debug_main") ) Then g_debug = True\r
+g_debug_vbs_inc = Not IsEmpty( WScript.Arguments.Named("debug") )\r
+\r
+Dim g_vbslib_folder\r
+If IsEmpty(g_fs) Then Set g_fs = CreateObject( "Scripting.FileSystemObject" )\r
+If IsEmpty(g_vbslib_path) Then\r
+ Err.Raise 1,,"vbs_inc needs other script using vbslib header"\r
+ g_vbslib_path = WScript.ScriptFullName\r
+Else\r
+ g_f = g_sh.CurrentDirectory : g_sh.CurrentDirectory = g_fs.GetParentFolderName( WScript.ScriptFullName )\r
+ g_vbslib_path = g_fs.GetAbsolutePathName( g_vbslib_path )\r
+ g_sh.CurrentDirectory = g_f\r
+End If\r
+g_vbslib_folder = g_fs.GetParentFolderName( g_vbslib_path ) + "\"\r
+\r
+\r
+'//=== Debug print command line parameters ....\r
+If (g_debug or g_debug_vbs_inc ) And (LCase( Right( WScript.FullName, 11 ) ) = "cscript.exe") Then\r
+ WScript.Echo "ScriptingHostFullName = " + WScript.FullName\r
+ WScript.Echo "CurrentDirectory = " + g_sh.CurrentDirectory\r
+ WScript.Echo "ScriptFullName = " + WScript.ScriptFullName\r
+ For i = 0 to WScript.Arguments.Count - 1\r
+ WScript.Echo "Arguments("&i&") = """+ WScript.Arguments(i) + """"\r
+ Next\r
+ WScript.Echo "g_vbslib_path = " + g_vbslib_path\r
+End If\r
+\r
+\r
+'//=== change to command prompt ...\r
+ChangeScriptMode\r
+\r
+\r
+'//=== Load system global functions\r
+g_path = g_vbslib_folder + "setting_default"\r
+If g_fs.FolderExists( g_path ) Then\r
+ Set g_i = g_fs.GetFolder( g_path )\r
+ For Each g_f in g_i.Files\r
+ If g_debug or g_debug_vbs_inc Then WScript.Echo "include: " + g_f.Path\r
+ include g_f.Path\r
+ Next\r
+End If\r
+g_path = "%ProgramFiles%\vbslib\%USERNAME%\setting"\r
+If g_fs.FolderExists( g_path ) Then\r
+ Set g_i = g_fs.GetFolder( g_path )\r
+ For Each g_f in g_i.Files\r
+ If g_debug or g_debug_vbs_inc Then WScript.Echo "include: " + g_f.Path\r
+ include g_f.Path\r
+ Next\r
+End If\r
+g_path = g_vbslib_folder + "setting"\r
+If g_fs.FolderExists( g_path ) Then\r
+ Set g_i = g_fs.GetFolder( g_path )\r
+ For Each g_f in g_i.Files\r
+ If g_debug or g_debug_vbs_inc Then WScript.Echo "include: " + g_f.Path\r
+ include g_f.Path\r
+ Next\r
+End If\r
+g_i = Empty\r
+\r
+\r
+'//=== variables of innitialize/finalize\r
+Dim g_InitializeModule\r
+Redim g_InitializeModules(-1)\r
+Redim g_InitializeModules_VBSPath(-1)\r
+\r
+Dim g_FinalizeModule\r
+Dim g_FinalizeLevel\r
+Redim g_FinalizeModules(-1)\r
+Redim g_FinalizeLevels(-1)\r
+Redim g_FinalizeModules_VBSPath(-1)\r
+\r
+\r
+'//=== read and execute vbs_inc_setting.vbs\r
+If not IsDefined( "Setting_getIncludePathes" ) Then _\r
+ Err.Raise 1,,"Not defined ""Setting_getIncludePathes"" in SettingDefault.vbs or Setting.vbs"\r
+\r
+g_IncludePathes = Setting_getIncludePathes( g_IncludeType )\r
+\r
+\r
+'//=== read and execute g_IncludePathes( )\r
+For g_i = 0 To UBound( g_IncludePathes )\r
+ If Not IsEmpty( g_IncludePathes(g_i) ) Then\r
+\r
+ If g_debug or g_debug_vbs_inc Then WScript.Echo "include: " + g_IncludePathes(g_i)\r
+\r
+ '//=== set default value\r
+ g_InitializeModule = Empty\r
+ g_FinalizeModule = Empty\r
+ g_FinalizeLevel = 100\r
+\r
+\r
+ '//=== read and execute g_IncludePathes(g_i)\r
+ On Error Resume Next\r
+ Set g_f = g_fs.OpenTextFile( g_fs.GetAbsolutePathName( g_vbslib_folder + g_IncludePathes(g_i) ) )\r
+ g_err = Err.Number : On Error Goto 0\r
+\r
+ If g_err <> 0 Then\r
+ If g_err = &h35 Then\r
+ Err.Raise g_err, "Include path " + _\r
+ g_fs.GetAbsolutePathName( g_vbslib_folder + g_IncludePathes(g_i) ) + _\r
+ " is not found. See " + g_vbslib_folder + "vbs_inc_setting.vbs"\r
+ Else\r
+ Err.Raise g_err\r
+ End If\r
+ End If\r
+\r
+ If not g_debug Then On Error Resume Next\r
+ Execute g_f.ReadAll()\r
+ g_err = Err.Number : On Error Goto 0\r
+\r
+ If g_err <> 0 Then\r
+ If g_err = &h411 Then\r
+ Err.Raise g_err, "Class, Member, Const name is duplicated in " + _\r
+ g_fs.GetAbsolutePathName( g_vbslib_folder + g_IncludePathes(g_i) )\r
+ ElseIf g_err = &h3f7 Or g_err = &h400 Then\r
+ Err.Raise g_err, "Syntax Error. Please double click " + _\r
+ g_fs.GetAbsolutePathName( g_vbslib_folder + g_IncludePathes(g_i) )\r
+ Else\r
+ Err.Raise g_err, "Error in including " + _\r
+ g_fs.GetAbsolutePathName( g_vbslib_folder + g_IncludePathes(g_i) )\r
+ End If\r
+ End If\r
+\r
+\r
+ '//=== g_InitializeModules( ) <= g_InitializeModule\r
+ '//=== g_InitializeModules_VBSPath( ) <= g_IncludePathes(g_i)\r
+ If Not IsEmpty( g_InitializeModule ) Then\r
+ Redim Preserve g_InitializeModules( UBound( g_InitializeModules ) + 1 )\r
+ Set g_InitializeModules( UBound( g_InitializeModules ) ) = g_InitializeModule\r
+ g_InitializeModule = Empty\r
+\r
+ Redim Preserve g_InitializeModules_VBSPath( UBound( g_InitializeModules_VBSPath ) + 1 )\r
+ g_InitializeModules_VBSPath( UBound( g_InitializeModules_VBSPath ) ) = g_IncludePathes(g_i)\r
+ End If\r
+\r
+\r
+ '//=== g_FinalizeModules( ) <= g_FinalizeModule\r
+ If Not IsEmpty( g_FinalizeModule ) Then\r
+ Redim Preserve g_FinalizeModules( UBound( g_FinalizeModules ) + 1 )\r
+ Set g_FinalizeModules( UBound( g_FinalizeModules ) ) = g_FinalizeModule\r
+ g_FinalizeModule = Empty\r
+\r
+ Redim Preserve g_FinalizeModules_VBSPath( UBound( g_FinalizeModules_VBSPath ) + 1 )\r
+ g_FinalizeModules_VBSPath( UBound( g_FinalizeModules_VBSPath ) ) = g_IncludePathes(g_i)\r
+\r
+ Redim Preserve g_FinalizeLevels( UBound( g_FinalizeLevels ) + 1 )\r
+ g_FinalizeLevels( UBound( g_FinalizeLevels ) ) = g_FinalizeLevel\r
+ End If\r
+\r
+ End If\r
+Next\r
+\r
+\r
+CallInitializeInModules\r
+\r
+g_f = Empty\r
+\r
+\r
+ \r
+'********************************************************************************\r
+' <<< [ChangeScriptMode] >>> \r
+'********************************************************************************\r
+Sub ChangeScriptMode\r
+ Dim c_debug, c_debug_main\r
+ Dim cmd, host, host_opt, script, params, opt, exit_cmd\r
+ Dim b_close_finish, i, key\r
+\r
+ '//=== Set default\r
+ If IsEmpty(g_debug) Then g_debug = False\r
+ If IsEmpty(g_CommandPrompt) Then g_CommandPrompt = True\r
+\r
+ '//=== Get status\r
+ g_b_cscript_exe = (LCase( Right( WScript.FullName, 11 ) ) = "cscript.exe")\r
+ c_debug = Not IsEmpty( WScript.Arguments.Named("debug") )\r
+ ' g_debug\r
+ If Not IsEmpty( WScript.Arguments.Named("debug_main") ) Then g_debug=True:c_debug=True\r
+ If g_debug=1 Then g_debug=True\r
+ If g_debug=0 Then g_debug=False\r
+ ' b_close_finish\r
+ If g_CommandPrompt=2 Then b_close_finish = False\r
+ If g_CommandPrompt=1 Then b_close_finish = True\r
+ If g_CommandPrompt=0 Then b_close_finish = False\r
+\r
+ '//=== Make command line\r
+ If g_CommandPrompt > 0 Then\r
+ host = "cmd /K cd """ + g_fs.GetParentFolderName( WScript.ScriptFullName ) + """ &" + _\r
+ "cscript //nologo"\r
+ Else\r
+ host = "wscript"\r
+ End If\r
+\r
+ If g_debug Then\r
+ host_opt = " //x"\r
+ Else\r
+ host_opt = ""\r
+ End If\r
+\r
+ If g_CommandPrompt > 0 Then\r
+ script = " """ + g_fs.GetFileName( WScript.ScriptFullName ) + """"\r
+ Else\r
+ script = " """ + WScript.ScriptFullName + """"\r
+ End If\r
+\r
+ params=""\r
+ For i=0 To WScript.Arguments.Count - 1\r
+ If InStr( WScript.Arguments(i), " " ) = 0 Then\r
+ params=params+" "+WScript.Arguments(i)\r
+ Else\r
+ params=params+" """+WScript.Arguments(i)+""""\r
+ End If\r
+ Next\r
+\r
+ If g_debug Then\r
+ opt = " /debug:1"\r
+ Else\r
+ opt = ""\r
+ End If\r
+\r
+ If b_close_finish Then\r
+ exit_cmd = " & if errorlevel 9 exit"\r
+ Else\r
+ exit_cmd = ""\r
+ End If\r
+\r
+ '//=== Start\r
+ If g_b_cscript_exe<>(g_CommandPrompt>0) Or c_debug<>g_debug Then\r
+ cmd = host + host_opt + script + params + opt + exit_cmd\r
+ Stop\r
+ CreateObject("WScript.Shell").Run cmd, 1, Not IsEmpty(WScript.Arguments.Named.Item("waitfin"))\r
+ WScript.Quit 0\r
+ End If\r
+End Sub\r
+\r
+\r
+ \r
+'********************************************************************************\r
+' <<< [CallInitializeInModules] >>> \r
+'********************************************************************************\r
+Sub CallInitializeInModules\r
+ Dim i\r
+\r
+ For i = 0 To UBound( g_InitializeModules )\r
+ g_InitializeModules( i )( g_InitializeModules_VBSPath( i ) )\r
+ Next\r
+End Sub\r
+\r
+\r
+ \r
+'********************************************************************************\r
+' <<< [CallFinalizeInModules] >>> \r
+'********************************************************************************\r
+Sub CallFinalizeInModules\r
+ Dim i, min_lv, min_over_lv\r
+ Const limit=999999999\r
+\r
+ min_over_lv = -limit\r
+ Do\r
+ min_lv = limit\r
+ For i = 0 To UBound( g_FinalizeModules )\r
+ If g_FinalizeLevels( i ) < min_lv And g_FinalizeLevels( i ) > min_over_lv Then _\r
+ min_lv = g_FinalizeLevels( i )\r
+ Next\r
+ If min_lv = limit Then Exit Do\r
+\r
+ For i = 0 To UBound( g_FinalizeModules )\r
+ If g_FinalizeLevels( i ) = min_lv Then _\r
+ g_FinalizeModules( i )( g_FinalizeModules_VBSPath( i ) )\r
+ Next\r
+ min_over_lv = min_lv\r
+ Loop\r
+End Sub\r
+\r
+\r
+ \r
+'********************************************************************************\r
+' <<< [ResumePush] >>> \r
+'********************************************************************************\r
+Function ResumePush ' This will be overriden\r
+ ResumePush = False\r
+End Function\r
+\r
+\r
+ \r
+'********************************************************************************\r
+' <<< [ResumePop] >>> \r
+'********************************************************************************\r
+Function ResumePop ' This will be overriden\r
+ CallFinalizeInModules\r
+ If g_CommandPrompt = 1 Then WScript.Quit 21 '// Err_TestPass\r
+End Function\r
+\r
+\r
+ \r
+'********************************************************************************\r
+' <<< [IsDefined] >>> \r
+'********************************************************************************\r
+Function IsDefined( Symbol )\r
+ Dim en\r
+\r
+ On Error Resume Next\r
+ Call GetRef( Symbol )\r
+ en = Err.Number : On Error GoTo 0\r
+\r
+ IsDefined = ( en <> 5 )\r
+End Function\r
+\r
+\r
+ \r
+'********************************************************************************\r
+' <<< [GetExistPathInSetting] >>> \r
+'********************************************************************************\r
+Function GetExistPathInSetting( Pathes, SettingFuncName )\r
+ Dim i, t\r
+ For i=0 To UBound( Pathes )\r
+ If g_fs.FileExists( Pathes(i) ) Then GetExistPathInSetting = Pathes(i) : Exit Function\r
+ Next\r
+ t = "" : For i=0 To UBound( Pathes ) : t = t + vbCrLf + Pathes(i) : Next\r
+ Err.Raise 1,, SettingFuncName + " \82Å\90Ý\92è\82µ\82Ä\82¢\82é\83t\83@\83C\83\8b\82ª\8c©\82Â\82©\82è\82Ü\82¹\82ñ\81B" + _\r
+ "\8eQ\8dl : vbslib \82Ì\90à\96¾\8f\91\82Ì SystemGlobal.vbs" + t\r
+End Function\r
+\r
+\r
+ \r
+'********************************************************************************\r
+' <<< [include] >>> \r
+'********************************************************************************\r
+Sub include( ByVal path )\r
+ Dim f, en,ed, current\r
+\r
+ path = g_sh.ExpandEnvironmentStrings( path )\r
+ current = g_sh.CurrentDirectory\r
+ If path <> g_fs.GetFileName( path ) Then _\r
+ g_sh.CurrentDirectory = g_fs.GetParentFolderName( path )\r
+\r
+ On Error Resume Next\r
+ Set f = g_fs.OpenTextFile( g_fs.GetFileName( path ) )\r
+ en = Err.Number : ed = Err.Description : On Error GoTo 0\r
+ If en <> 0 Then Err.Raise en,,ed + " in include( " + path + " )"\r
+ If g_debug=0 Then\r
+ On Error Resume Next\r
+ ExecuteGlobal f.ReadAll()\r
+ g_sh.CurrentDirectory = current\r
+ en = Err.Number : ed = Err.Description : On Error GoTo 0\r
+ If en=&h411 Then en = 0 '// &h411=Symbol Overrided\r
+ If en <> 0 Then Err.Raise en,,ed + " in include( " + path + " )." + _\r
+ " Please double click the vbs file, if syntax error occured."\r
+ Else\r
+ ExecuteGlobal f.ReadAll()\r
+ g_sh.CurrentDirectory = current\r
+ End If\r
+End Sub\r
+ \r
OSDN Git Service
