Option Explicit 

' vbslib  ver3.00  Sep.22, 2009
' Copyright (c) 2008-2009, T's-Neko at Sage Plaisir 21 (Japan)
' All rights reserved. Based on 3-clause BSD license.


'// Set g_vbslib_path=(this script full path) and  g_vbslib_folder=(vbslib folder full path)  before including this script.


Dim  g_vbslib_path, g_vbslib_folder
Dim  g_vbslib_ver_folder
Dim  g_debug_vbs_inc, g_debug_params
Dim  g_debug, g_debug_or_test, g_IncludePathes, g_CommandPrompt
Dim  g_b_cscript_exe, g_admin, g_curdir
Dim  g_sh, g_fs
Dim  g_f, g_i, g_err, g_path
Dim  g_ExitCode
Dim  g_cut_old
Dim  g_SrcPath : g_SrcPath = g_vbslib_path
Dim  g_vbslib_var, g_vbslib_var_break_symbol
Dim  g_FinalizeInModulesCaller
Dim  g_CUI

If IsEmpty(g_vbslib_path) Then _
  Err.Raise  1,,"vbs_inc needs other script using vbslib header"

If IsEmpty(g_vbslib_folder) Then _
  g_vbslib_folder = g_fs.GetParentFolderName( g_vbslib_path )
g_vbslib_ver_folder = g_fs.GetParentFolderName( g_vbslib_path ) + "\"
g_curdir = g_sh.CurrentDirectory

'If IsEmpty(g_fs) Then  Set g_fs = CreateObject( "Scripting.FileSystemObject" )
'If IsEmpty(g_sh) Then  Set g_sh = WScript.CreateObject("WScript.Shell")

If Not IsEmpty( WScript.Arguments.Named("g_debug") ) Then  g_debug = True
g_debug_vbs_inc = Not IsEmpty( WScript.Arguments.Named("debug") )
If IsEmpty( g_debug_or_test ) Then  g_debug_or_test = g_debug

Set  g_vbslib_var = CreateObject("Scripting.Dictionary")


'//=== Debug print command line parameters ....
If (g_debug or g_debug_vbs_inc ) And (LCase( Right( WScript.FullName, 11 ) ) = "cscript.exe") Then
  echo_c_in_vbs_inc  ">" + g_fs.GetFileName( WScript.FullName ) + " """ + WScript.ScriptFullName + """"
  echo_c_in_vbs_inc  "CurrentDirectory = " + g_sh.CurrentDirectory
  For i = 0 to WScript.Arguments.Count - 1
    echo_c_in_vbs_inc  "Arguments("&i&") = """+ WScript.Arguments(i) + """"
  Next
  echo_c_in_vbs_inc  "g_vbslib_path = " + g_vbslib_path
End If


'//=== change to command prompt ...
ChangeScriptMode




'//=== Load setting script
If g_debug or g_debug_vbs_inc Then  echo_c_in_vbs_inc ">include setting folders"
g_path = g_vbslib_ver_folder + "setting_default"
If g_fs.FolderExists( g_path ) Then
  Set g_i = g_fs.GetFolder( g_path )
  For Each g_f in g_i.Files
    include  g_f.Path
  Next
End If
g_path = g_sh.ExpandEnvironmentStrings( "%myhome_mem%\prog\vbslib\setting_mem" )
If g_path <> "%myhome_mem%\prog\vbslib\setting_mem" Then
  If g_fs.FolderExists( g_path ) Then
    Set g_i = g_fs.GetFolder( g_path )
    For Each g_f in g_i.Files
      include  g_f.Path
    Next
  End If
End If
g_path = g_sh.ExpandEnvironmentStrings( "%ProgramFiles%\vbslib\%USERNAME%\setting" )
If g_fs.FolderExists( g_path ) Then
  Set g_i = g_fs.GetFolder( g_path )
  For Each g_f in g_i.Files
    include  g_f.Path
  Next
End If
g_path = g_vbslib_ver_folder + "setting"
If g_fs.FolderExists( g_path ) Then
  Set g_i = g_fs.GetFolder( g_path )
  For Each g_f in g_i.Files
    include  g_f.Path
  Next
End If
g_i = Empty


'//=== variables of innitialize/finalize
Dim    g_InitializeModule
Redim  g_InitializeModules(-1)
Redim  g_InitializeModules_VBSPath(-1)

Dim    g_FinalizeModule
Dim    g_FinalizeLevel
Redim  g_FinalizeModules(-1)
Redim  g_FinalizeLevels(-1)
Redim  g_FinalizeModules_VBSPath(-1)


'//=== read and execute g_IncludePathes( )
If not IsDefined( "Setting_getIncludePathes" ) Then _
  Err.Raise  1,,"Not defined ""Setting_getIncludePathes"" in SettingDefault.vbs or Setting.vbs"

g_IncludePathes = Setting_getIncludePathes( Empty )

If g_debug or g_debug_vbs_inc Then  echo_c_in_vbs_inc ">include libraries by g_IncludePathes in vbs_inc_setting.vbs"
For g_i = 0 To UBound( g_IncludePathes )
  If Not IsEmpty( g_IncludePathes(g_i) ) Then

    If g_debug or g_debug_vbs_inc Then  echo_c_in_vbs_inc ">include  """ + g_vbslib_ver_folder + g_IncludePathes(g_i) + """"

    '//=== set default value
    g_InitializeModule = Empty
    g_FinalizeModule = Empty
    g_FinalizeLevel = 100


    '//=== read and execute g_IncludePathes(g_i)
    On Error Resume Next
      Set  g_f = g_fs.OpenTextFile( g_fs.GetAbsolutePathName( g_vbslib_ver_folder + g_IncludePathes(g_i) ) )
    g_err = Err.Number : On Error Goto 0

    If g_err <> 0 Then
      If g_err = 53 or g_err = 76 Then
        Err.Raise g_err, "Include path " + _
          g_fs.GetAbsolutePathName( g_vbslib_ver_folder + g_IncludePathes(g_i) ) + _
          " is not found. See " + g_vbslib_ver_folder + "vbs_inc_setting.vbs"
      Else
        Err.Raise g_err
      End If
    End If

    g_SrcPath = g_fs.GetAbsolutePathName( g_vbslib_ver_folder + g_IncludePathes(g_i) )

    If not g_debug Then
      On Error Resume Next
        Execute  g_f.ReadAll()
      g_err = Err.Number : On Error Goto 0
    Else
      Execute  "'// " + g_SrcPath +vbCRLF+ g_f.ReadAll()
    End If

    g_SrcPath = g_vbslib_path

    If g_err <> 0 Then
      If g_err = &h411 Then
        Err.Raise g_err, "Class, Member, Const name is duplicated in " + _
          g_fs.GetAbsolutePathName( g_vbslib_ver_folder + g_IncludePathes(g_i) )
      ElseIf g_err = &h3f7 Or g_err = &h400 Then
        Err.Raise g_err, "Syntax Error. Please double click " + _
          g_fs.GetAbsolutePathName( g_vbslib_ver_folder + g_IncludePathes(g_i) )
      Else
        Err.Raise g_err, "Error in including " + _
          g_fs.GetAbsolutePathName( g_vbslib_ver_folder + g_IncludePathes(g_i) )
      End If
    End If


    '//=== g_InitializeModules( ) <= g_InitializeModule
    '//=== g_InitializeModules_VBSPath( ) <= g_IncludePathes(g_i)
    If Not IsEmpty( g_InitializeModule ) Then
      Redim Preserve  g_InitializeModules( UBound( g_InitializeModules ) + 1 )
      Set  g_InitializeModules( UBound( g_InitializeModules ) ) = g_InitializeModule
      g_InitializeModule = Empty

      Redim Preserve  g_InitializeModules_VBSPath( UBound( g_InitializeModules_VBSPath ) + 1 )
      g_InitializeModules_VBSPath( UBound( g_InitializeModules_VBSPath ) ) = g_IncludePathes(g_i)
    End If


    '//=== g_FinalizeModules( ) <= g_FinalizeModule
    If Not IsEmpty( g_FinalizeModule ) Then
      Redim Preserve  g_FinalizeModules( UBound( g_FinalizeModules ) + 1 )
      Set  g_FinalizeModules( UBound( g_FinalizeModules ) ) = g_FinalizeModule
      g_FinalizeModule = Empty

      Redim Preserve  g_FinalizeModules_VBSPath( UBound( g_FinalizeModules_VBSPath ) + 1 )
      g_FinalizeModules_VBSPath( UBound( g_FinalizeModules_VBSPath ) ) = g_IncludePathes(g_i)

      Redim Preserve  g_FinalizeLevels( UBound( g_FinalizeLevels ) + 1 )
      g_FinalizeLevels( UBound( g_FinalizeLevels ) ) = g_FinalizeLevel
    End If

  End If
Next


CallInitializeInModules

Set g_FinalizeInModulesCaller = new FinalizeInModulesCaller


g_SrcPath = Empty
g_f = Empty


 
'********************************************************************************
'  <<< [echo_c_in_vbs_inc] >>> 
'********************************************************************************
Sub  echo_c_in_vbs_inc( Message )
  If g_CommandPrompt <> 0 Then  WScript.Echo  Message
End Sub
 
'********************************************************************************
'  <<< [ChangeScriptMode] >>> 
'********************************************************************************
Sub  ChangeScriptMode
  Dim  c_debug, c_admin, b_vista_admin
  Dim  cmd, exe, host, host_opt, script, params, opt, exit_cmd, host_end
  Dim  b_close_finish, i, key, directory, window_style

  '//=== Set default
  If IsEmpty(g_debug) Then  g_debug = False
  If IsEmpty(g_CommandPrompt) Then  g_CommandPrompt = True
  window_style = 1

  '//=== Get status
  g_b_cscript_exe = (LCase( Right( WScript.FullName, 11 ) ) = "cscript.exe")
  c_debug = Not IsEmpty( WScript.Arguments.Named("debug") )
  c_admin = Not IsEmpty( WScript.Arguments.Named("admin") )
  ' g_debug
  If Not IsEmpty( WScript.Arguments.Named("g_debug") ) Then  g_debug=True:c_debug=True
  If g_debug=1 Then g_debug=True
  If g_debug=0 Then g_debug=False
  ' b_close_finish
  If (g_CommandPrompt and 4) = 4 Then window_style = 7
  If (g_CommandPrompt and 3) = 2 Then b_close_finish = False
  If (g_CommandPrompt and 3) = 1 Then b_close_finish = True
  If (g_CommandPrompt and 3) = 0 Then b_close_finish = False
  g_admin = ( g_admin <> 0 )


  '//=== Make command line
  directory = g_sh.CurrentDirectory
  If g_CommandPrompt > 0 Then
    If g_admin Then
      exe  = "cmd"
      host = "cmd /K (cd /d """ + directory + """ & cscript //nologo"
      host_end = ")"
    Else
      exe  = "cmd"
      host = "cmd /K (cscript //nologo"
      host_end = ")"
    End If
  Else
    '//If IsEmpty( g_curdir ) Then  directory = g_sh.CurrentDirectory  Else  directory = g_curdir
    exe  = "wscript"
    host = "wscript"
    host_end = ""
  End If

  If g_debug Then
    host_opt = " //x"
  Else
    host_opt = ""
  End If

'//  If g_CommandPrompt > 0 Then
'//    script = " """ + g_fs.GetFileName( WScript.ScriptFullName ) + """"
'//  Else
    script = " """ + WScript.ScriptFullName + """"
'//  End If

  params=""
  For i=0 To WScript.Arguments.Count - 1
    If InStr( WScript.Arguments(i), " " ) = 0 Then
      params=params+" "+WScript.Arguments(i)
    Else
      params=params+" """+WScript.Arguments(i)+""""
    End If
  Next
  If not IsEmpty( g_debug_params ) Then
    params=params+" "+g_debug_params
  End If

  If g_debug Then
    opt = " /debug:1"
  Else
    opt = ""
  End If

  If g_admin Then
    opt = opt + " /admin:1"
  End If

  If b_close_finish Then
    exit_cmd = " & if errorlevel 21 exit"
  Else
    exit_cmd = ""
  End If


  '//=== Start
  If g_b_cscript_exe<>(g_CommandPrompt>0) or c_debug<>g_debug or c_admin<>g_admin Then

    cmd = host + host_opt + script + params + opt + exit_cmd + host_end

    If g_admin and ( GetOSVersion() >= 6.0 ) Then

      '// Run as administrator on Windows Vista
      Dim  sh_ap
      Set  sh_ap = CreateObject( "Shell.Application" )
      sh_ap.ShellExecute  exe, Mid( cmd, Len(exe)+2 ), directory, "runas", window_style
    Else

      '// Change to runas command
      If g_admin Then
        i = g_sh.ExpandEnvironmentStrings("%ProgramFiles%\vbslib\%USERNAME%\setting\account_setting.vbs")
        If g_fs.FileExists( i ) Then  include  i
        If IsDefined( "Setting_getAdminUserName" ) Then
          i = Setting_getAdminUserName()
          If MsgBox( "Do you start as Administrator user?" + vbCRLF + "user: " + i + vbCRLF +_
            "command: " +WScript.ScriptFullName + " " + params,_
            vbOKCancel, "Warning: " & WScript.ScriptName ) <> vbOK Then  WScript.Quit 1
          If not IsEmpty( i ) Then  cmd = "runas /user:" + i + " """ + Replace( cmd, """", "\""" )+""""
        End If
      End If

      '// Run the command
      '// g_sh.CurrentDirectory = directory
      Stop
'//      g_sh.Run  cmd, window_style, Not IsEmpty(WScript.Arguments.Named.Item("waitfin"))
      g_sh.Run  cmd, window_style, True
    End If

    WScript.Quit 0
  End If
End Sub


 
'********************************************************************************
'  <<< [CallInitializeInModules] >>> 
'********************************************************************************
Sub  CallInitializeInModules
  Dim  i

  For i = 0 To UBound( g_InitializeModules )
    g_InitializeModules( i )( g_InitializeModules_VBSPath( i ) )
  Next
End Sub


 
'********************************************************************************
'  <<< [CallFinalizeInModules] >>> 
'********************************************************************************
Sub  CallFinalizeInModules( Reason )
  Dim  i, min_lv, min_over_lv, b
  Const  limit=999999999

  min_over_lv = -limit
  Do
    min_lv = limit
    For i = 0 To UBound( g_FinalizeModules )
      If g_FinalizeLevels( i ) < min_lv And  g_FinalizeLevels( i ) > min_over_lv Then _
        min_lv = g_FinalizeLevels( i )
    Next
    If min_lv = limit Then Exit Do

    For i = 0 To UBound( g_FinalizeModules )
      If g_FinalizeLevels( i ) = min_lv Then _
        Call  g_FinalizeModules( i )( g_FinalizeModules_VBSPath( i ), Reason )
    Next
    min_over_lv = min_lv
  Loop
  g_FinalizeInModulesCaller.m_bDisableCall = True


  Const  Pass_Num = 21, Skip_Num = 22
  Dim  exit_code

  If Err.Number = Pass_Num Then
    exit_code = Pass_Num
  ElseIf Err.Number <> 0 Then
    If Left( Err.Description, 1 ) = "<" or Err.Number = Skip_Num Then
      WScript.Echo  Err.Description
    Else
      WScript.Echo  GetErrStr( Err.Number, Err.Description )
    End If
    If g_CommandPrompt = 1 Then

      If not IsEmpty( g_CUI ) Then
        While  Left( g_CUI.m_Auto_Keys, 1 ) <> ""  and _
               Left( g_CUI.m_Auto_Keys, 1 ) <> "."
          g_CUI.m_Auto_Keys = Mid( g_CUI.m_Auto_Keys, 2 )
        WEnd
      End If

      b = False
      If not IsEmpty( g_CUI ) Then
        If Left( g_CUI.m_Auto_Keys, 1 ) = "." Then
          If not IsEmpty( WScript.Arguments.Named.Item("GUI_input") ) Then _
            WScript.StdOut.WriteLine  "<WARNING msg='エラーが発生したプロセスは起動したときのプロセスと異なります' current_vbs='" + _
               WScript.ScriptFullName +"'/>"
          WScript.StdOut.Write  "終了するには Enter キーを押してください . . . "
          g_CUI.m_Auto_Keys = Mid( g_CUI.m_Auto_Keys, 2 )
          b = True
        End If
      End If
      If not b Then
        If IsEmpty( WScript.Arguments.Named.Item("GUI_input") ) Then
          WScript.StdOut.Write  "終了するには Enter キーを押してください . . . "
          Wscript.StdIn.ReadLine
        Else
          WScript.StdOut.WriteLine  "<WARNING msg='エラーが発生したプロセスは起動したときのプロセスと異なります' current_vbs='" + _
               WScript.ScriptFullName +"'/>"
          WScript.StdOut.Write  "終了するには Enter キーを押してください . . . "
          MsgBox  "終了するには Enter キーを押してください . . . "
        End If
      End If
    End If
    exit_code = Err.Number
  Else
    exit_code = Pass_Num
    If not IsEmpty( g_ExitCode ) Then  exit_code = g_ExitCode
  End If

  If g_debug Then
    WScript.Echo  "exit code = " & exit_code & vbCRLF & _
                  "(but now exit code = 0 with debugger.)"
    Exit Sub  '// WScript.Quit occurs unknown error with debugger
  Else
    WScript.Quit  exit_code  ' If error was raised here, WSH-exe return is zero only.
  End If
End Sub


 
'********************************************************************************
'  <<< [FinalizeInModulesCaller] >>> 
'********************************************************************************
Class  FinalizeInModulesCaller
  Public  m_bDisableCall
  Private Sub  Class_Terminate()
    If IsEmpty( m_bDisableCall ) and Err.Number <> &h8004FFFD Then 'h8004FFFD=WScript.Quit
      Const  Pass_Num = 21, Skip_Num = 22
      If Err.Number = Pass_Num or Err.Number = Skip_Num  Then  CallFinalizeInModules  0 _
      Else  CallFinalizeInModules  1
    End If
  End Sub
End Class

 
'********************************************************************************
'  <<< [ResumePush] >>> 
'********************************************************************************
Function  ResumePush
  ResumePush = ( g_debug = 0 )
    '// If error occured, WSH process returns 0.
    '// ResumePop catches error for returning error code.
End Function


 
'********************************************************************************
'  <<< [ResumePop] >>> 
'********************************************************************************
Function  ResumePop
  Const  Pass_Num = 21
  If Err.Number = 0 or Err.Number = Pass_Num Then
    CallFinalizeInModules  0
  Else
    CallFinalizeInModules  1
  End If
End Function


 
'********************************************************************************
'  <<< [GetErrStr] >>> 
'********************************************************************************
Function  GetErrStr( en, ed )
  If en = 0 Then
    GetErrStr = "no error"
  ElseIf en = 21 Then
    GetErrStr = "[Pass]"
  ElseIf en > 0 And en <= &h7FFF Then
    GetErrStr = "<ERROR err_number='" & en & "' err_description='" & ed & "'/>"
  Else
    GetErrStr = "<ERROR err_number='0x" & Hex(en) & "' err_description='" & ed & "'/>"
  End If
End Function


 
'********************************************************************************
'  <<< [SetVar] >>> 
'********************************************************************************
Sub  SetVar( Symbol, Value )
  echo  ">SetVar  """ + Symbol + """, """ & Value & """"
  If Symbol = g_vbslib_var_break_symbol Then  Stop  '// Look at then caller function using watch window of debugger
  g_vbslib_var.Item( Symbol ) = Value
End Sub


 
'********************************************************************************
'  <<< [GetVar] >>> 
'********************************************************************************
Function  GetVar( Symbol )
  GetVar = g_vbslib_var.Item( Symbol )
  If IsEmpty( GetVar ) Then  GetVar = g_sh.ExpandEnvironmentStrings( "%"+Symbol+"%" )
  If InStr( GetVar, "%" ) > 0 Then  GetVar = Empty

  If Symbol = g_vbslib_var_break_symbol Then  Stop  '// Look at then caller function using watch window of debugger
End Function


 
'********************************************************************************
'  <<< [SetVarBreak] >>> 
'********************************************************************************
Sub  SetVarBreak( Symbol, Opt )
  g_vbslib_var_break_symbol = Symbol

  Dim  sym2 : sym2 = "%"+Symbol+"%"
  Dim  value : value = g_sh.ExpandEnvironmentStrings( sym2 )
  If value <> sym2 Then _
    Stop  '// (Symbol) OS environment variable is already defined.

  value = g_vbslib_var.Item( Symbol )
  If not IsEmpty( value ) Then _
    Stop  '// (Symbol) vbslib variable is already defined.
End Sub


 
'********************************************************************************
'  <<< [IsDefined] >>> 
'********************************************************************************
Function  IsDefined( Symbol )
  Dim en

  On Error Resume Next
    Call GetRef( Symbol )
  en = Err.Number : On Error GoTo 0

  IsDefined = ( en <> 5 )
End Function


 
'********************************************************************************
'  <<< [GetOSVersion] >>> 
'********************************************************************************
Function  GetOSVersion()

  '// Get OS Version from cimv2 of WMI
  Dim  cimv2 : Set cimv2 = GetObject( "winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
  Dim  os : Set os = cimv2.ExecQuery( "SELECT * FROM Win32_OperatingSystem" )
  Dim  v, ver
  For Each v in os
    ver = v.Version
  Next
  cimv2 = Empty : os = Empty : v = Empty

  '// Cut build number
  Dim  i
  i = InStr( ver, "." )
  i = InStr( i+1, ver, "." )
  GetOSVersion = CDbl( Left( ver, i-1 ) )
End Function


 
'********************************************************************************
'  <<< [GetExistPathInSetting] >>> 
'********************************************************************************
Function  GetExistPathInSetting( Pathes, SettingFuncName )
  Dim  i, t
  For i=0 To UBound( Pathes )
    If g_fs.FileExists( Pathes(i) ) Then
      GetExistPathInSetting = g_fs.GetAbsolutePathName(Pathes(i))  '// set to same as Big/Little case
      Exit Function
    End If
  Next
  t = "" :  For i=0 To UBound( Pathes ) : t = t + vbCrLf + "  " + Pathes(i) : Next
  Err.Raise 1,, SettingFuncName + " で設定している以下のいずれかのファイルが見つかりません。" + _
   " （参考：vbslib の説明書の setting フォルダ）" + t
End Function


 
'********************************************************************************
'  <<< [include] >>> 
'********************************************************************************
Sub  include( ByVal path )
  Dim f, en,ed, current

  If g_debug or g_debug_vbs_inc Then  echo_c_in_vbs_inc ">include  """ + path + """"

  path = g_sh.ExpandEnvironmentStrings( path )

  If InStr( path, "*" ) > 0    Then  include_objs  path, Empty, Empty : Exit Sub
  If g_fs.FolderExists( path ) Then  include_objs  path, Empty, Empty : Exit Sub

  current = g_sh.CurrentDirectory
  g_SrcPath = g_fs.GetAbsolutePathName( path )
  If path <> g_fs.GetFileName( path ) Then
    if not g_fs.FileExists( path ) Then _
      Err.Raise 2,, "include: Not found """ + path + """ current=""" + g_sh.CurrentDirectory +""""
    g_sh.CurrentDirectory = g_fs.GetParentFolderName( g_fs.GetAbsolutePathName( path ) )
  End If

  On Error Resume Next
    Set f = g_fs.OpenTextFile( g_fs.GetFileName( path ) )
  en = Err.Number : ed = Err.Description : On Error GoTo 0
  If en <> 0 Then  Err.Raise en,,ed + " in include( " + path + " )"
  If g_debug=0 Then
    On Error Resume Next
      ExecuteGlobal  f.ReadAll()
      g_sh.CurrentDirectory = current
    en = Err.Number : ed = Err.Description : On Error GoTo 0
    If en=&h411 Then  en = 0  '// &h411=Symbol Overrided
    If en <> 0 Then  Err.Raise en,,ed + " in include( " + path + " )." + _
      " Please double click the vbs file, if syntax error occured."
  Else
    Dim  t : t = "'// " + g_SrcPath +vbCRLF+ f.ReadAll() : f.Close : ExecuteGlobal t
    g_sh.CurrentDirectory = current
  End If
  g_SrcPath = Empty
End Sub