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
+' vbs_inc.vbs of vbs_inc.vbs\r
\r
+' vbslib ver3.00 Sep.22, 2009\r
+' Copyright (c) 2008-2009, T's-Neko at Sage Plaisir 21 (Japan)\r
+' All rights reserved. Based on 3-clause BSD license.\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
+'// Set g_vbslib_path=(this script full path) before including this script.\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
+Dim g_vbslib_path, g_vbslib_folder\r
+Dim g_sh :If IsEmpty(g_sh) Then Set g_sh=WScript.CreateObject("WScript.Shell")\r
+Dim g_fs :If IsEmpty(g_fs) Then Set g_fs=CreateObject( "Scripting.FileSystemObject" )\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
+If IsEmpty(g_vbslib_path) Then _\r
+ Err.Raise 1,,"vbs_inc needs other script using vbslib header"\r
+g_vbslib_folder = g_fs.GetParentFolderName( g_vbslib_path ) + "\"\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
+Dim g_Vers\r
+Const g_vbslib_default_ver = 2.0\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
+If IsEmpty( g_Vers ) Then _\r
+ Set g_Vers = CreateObject("Scripting.Dictionary") : g_Vers.Add "vbslib", g_vbslib_default_ver\r
+If not g_Vers.Exists("vbslib") Then g_Vers.Add "vbslib", g_vbslib_default_ver\r
\r
- End If\r
-Next\r
\r
+If g_Vers.Item("vbslib") = 3.0 Then g_vbslib_path = g_vbslib_folder + "vbslib300\vbs_inc_300.vbs"\r
+If g_Vers.Item("vbslib") = 2.0 Then g_vbslib_path = g_vbslib_folder + "vbs_inc_200.vbs"\r
+If g_Vers.Item("vbslib") = 0.0 Then g_vbslib_path = g_vbslib_folder + "vbslib000\vbs_inc_000.vbs"\r
+If not g_fs.FileExists( g_vbslib_path ) Then Err.Raise 1,,"[ERROR] Not found " + g_vbslib_path\r
\r
-CallInitializeInModules\r
\r
+Dim g_f : Set g_f = g_fs.OpenTextFile( g_vbslib_path )\r
+Execute g_f.ReadAll()\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
