_src/_replica/vbslib/vbslib300/vbs_inc_300.vbs

   1 Option Explicit \r
   2 \r
   3 ' vbslib  ver3.00  Sep.22, 2009\r
   4 ' Copyright (c) 2008-2009, T's-Neko at Sage Plaisir 21 (Japan)\r
   5 ' All rights reserved. Based on 3-clause BSD license.\r
   6 \r
   7 \r
   8 '// Set g_vbslib_path=(this script full path) and  g_vbslib_folder=(vbslib folder full path)  before including this script.\r
   9 \r
  10 \r
  11 Dim  g_vbslib_path, g_vbslib_folder\r
  12 Dim  g_vbslib_ver_folder\r
  13 Dim  g_debug_vbs_inc, g_debug_params\r
  14 Dim  g_debug, g_debug_or_test, g_IncludePathes, g_CommandPrompt\r
  15 Dim  g_b_cscript_exe, g_admin, g_curdir\r
  16 Dim  g_sh, g_fs\r
  17 Dim  g_f, g_i, g_err, g_path\r
  18 Dim  g_ExitCode\r
  19 Dim  g_cut_old\r
  20 Dim  g_SrcPath : g_SrcPath = g_vbslib_path\r
  21 Dim  g_vbslib_var, g_vbslib_var_break_symbol\r
  22 Dim  g_FinalizeInModulesCaller\r
  23 Dim  g_CUI\r
  24 \r
  25 If IsEmpty(g_vbslib_path) Then _\r
  26   Err.Raise  1,,"vbs_inc needs other script using vbslib header"\r
  27 \r
  28 If IsEmpty(g_vbslib_folder) Then _\r
  29   g_vbslib_folder = g_fs.GetParentFolderName( g_vbslib_path )\r
  30 g_vbslib_ver_folder = g_fs.GetParentFolderName( g_vbslib_path ) + "\"\r
  31 g_curdir = g_sh.CurrentDirectory\r
  32 \r
  33 'If IsEmpty(g_fs) Then  Set g_fs = CreateObject( "Scripting.FileSystemObject" )\r
  34 'If IsEmpty(g_sh) Then  Set g_sh = WScript.CreateObject("WScript.Shell")\r
  35 \r
  36 If Not IsEmpty( WScript.Arguments.Named("g_debug") ) Then  g_debug = True\r
  37 g_debug_vbs_inc = Not IsEmpty( WScript.Arguments.Named("debug") )\r
  38 If IsEmpty( g_debug_or_test ) Then  g_debug_or_test = g_debug\r
  39 \r
  40 Set  g_vbslib_var = CreateObject("Scripting.Dictionary")\r
  41 \r
  42 \r
  43 '//=== Debug print command line parameters ....\r
  44 If (g_debug or g_debug_vbs_inc ) And (LCase( Right( WScript.FullName, 11 ) ) = "cscript.exe") Then\r
  45   echo_c_in_vbs_inc  ">" + g_fs.GetFileName( WScript.FullName ) + " """ + WScript.ScriptFullName + """"\r
  46   echo_c_in_vbs_inc  "CurrentDirectory = " + g_sh.CurrentDirectory\r
  47   For i = 0 to WScript.Arguments.Count - 1\r
  48     echo_c_in_vbs_inc  "Arguments("&i&") = """+ WScript.Arguments(i) + """"\r
  49   Next\r
  50   echo_c_in_vbs_inc  "g_vbslib_path = " + g_vbslib_path\r
  51 End If\r
  52 \r
  53 \r
  54 '//=== change to command prompt ...\r
  55 ChangeScriptMode\r
  56 \r
  57 \r
  58 \r
  59 \r
  60 '//=== Load setting script\r
  61 If g_debug or g_debug_vbs_inc Then  echo_c_in_vbs_inc ">include setting folders"\r
  62 g_path = g_vbslib_ver_folder + "setting_default"\r
  63 If g_fs.FolderExists( g_path ) Then\r
  64   Set g_i = g_fs.GetFolder( g_path )\r
  65   For Each g_f in g_i.Files\r
  66     include  g_f.Path\r
  67   Next\r
  68 End If\r
  69 g_path = g_sh.ExpandEnvironmentStrings( "%myhome_mem%\prog\vbslib\setting_mem" )\r
  70 If g_path <> "%myhome_mem%\prog\vbslib\setting_mem" Then\r
  71   If g_fs.FolderExists( g_path ) Then\r
  72     Set g_i = g_fs.GetFolder( g_path )\r
  73     For Each g_f in g_i.Files\r
  74       include  g_f.Path\r
  75     Next\r
  76   End If\r
  77 End If\r
  78 g_path = g_sh.ExpandEnvironmentStrings( "%ProgramFiles%\vbslib\%USERNAME%\setting" )\r
  79 If g_fs.FolderExists( g_path ) Then\r
  80   Set g_i = g_fs.GetFolder( g_path )\r
  81   For Each g_f in g_i.Files\r
  82     include  g_f.Path\r
  83   Next\r
  84 End If\r
  85 g_path = g_vbslib_ver_folder + "setting"\r
  86 If g_fs.FolderExists( g_path ) Then\r
  87   Set g_i = g_fs.GetFolder( g_path )\r
  88   For Each g_f in g_i.Files\r
  89     include  g_f.Path\r
  90   Next\r
  91 End If\r
  92 g_i = Empty\r
  93 \r
  94 \r
  95 '//=== variables of innitialize/finalize\r
  96 Dim    g_InitializeModule\r
  97 Redim  g_InitializeModules(-1)\r
  98 Redim  g_InitializeModules_VBSPath(-1)\r
  99 \r
 100 Dim    g_FinalizeModule\r
 101 Dim    g_FinalizeLevel\r
 102 Redim  g_FinalizeModules(-1)\r
 103 Redim  g_FinalizeLevels(-1)\r
 104 Redim  g_FinalizeModules_VBSPath(-1)\r
 105 \r
 106 \r
 107 '//=== read and execute g_IncludePathes( )\r
 108 If not IsDefined( "Setting_getIncludePathes" ) Then _\r
 109   Err.Raise  1,,"Not defined ""Setting_getIncludePathes"" in SettingDefault.vbs or Setting.vbs"\r
 110 \r
 111 g_IncludePathes = Setting_getIncludePathes( Empty )\r
 112 \r
 113 If g_debug or g_debug_vbs_inc Then  echo_c_in_vbs_inc ">include libraries by g_IncludePathes in vbs_inc_setting.vbs"\r
 114 For g_i = 0 To UBound( g_IncludePathes )\r
 115   If Not IsEmpty( g_IncludePathes(g_i) ) Then\r
 116 \r
 117     If g_debug or g_debug_vbs_inc Then  echo_c_in_vbs_inc ">include  """ + g_vbslib_ver_folder + g_IncludePathes(g_i) + """"\r
 118 \r
 119     '//=== set default value\r
 120     g_InitializeModule = Empty\r
 121     g_FinalizeModule = Empty\r
 122     g_FinalizeLevel = 100\r
 123 \r
 124 \r
 125     '//=== read and execute g_IncludePathes(g_i)\r
 126     On Error Resume Next\r
 127       Set  g_f = g_fs.OpenTextFile( g_fs.GetAbsolutePathName( g_vbslib_ver_folder + g_IncludePathes(g_i) ) )\r
 128     g_err = Err.Number : On Error Goto 0\r
 129 \r
 130     If g_err <> 0 Then\r
 131       If g_err = 53 or g_err = 76 Then\r
 132         Err.Raise g_err, "Include path " + _\r
 133           g_fs.GetAbsolutePathName( g_vbslib_ver_folder + g_IncludePathes(g_i) ) + _\r
 134           " is not found. See " + g_vbslib_ver_folder + "vbs_inc_setting.vbs"\r
 135       Else\r
 136         Err.Raise g_err\r
 137       End If\r
 138     End If\r
 139 \r
 140     g_SrcPath = g_fs.GetAbsolutePathName( g_vbslib_ver_folder + g_IncludePathes(g_i) )\r
 141 \r
 142     If not g_debug Then\r
 143       On Error Resume Next\r
 144         Execute  g_f.ReadAll()\r
 145       g_err = Err.Number : On Error Goto 0\r
 146     Else\r
 147       Execute  "'// " + g_SrcPath +vbCRLF+ g_f.ReadAll()\r
 148     End If\r
 149 \r
 150     g_SrcPath = g_vbslib_path\r
 151 \r
 152     If g_err <> 0 Then\r
 153       If g_err = &h411 Then\r
 154         Err.Raise g_err, "Class, Member, Const name is duplicated in " + _\r
 155           g_fs.GetAbsolutePathName( g_vbslib_ver_folder + g_IncludePathes(g_i) )\r
 156       ElseIf g_err = &h3f7 Or g_err = &h400 Then\r
 157         Err.Raise g_err, "Syntax Error. Please double click " + _\r
 158           g_fs.GetAbsolutePathName( g_vbslib_ver_folder + g_IncludePathes(g_i) )\r
 159       Else\r
 160         Err.Raise g_err, "Error in including " + _\r
 161           g_fs.GetAbsolutePathName( g_vbslib_ver_folder + g_IncludePathes(g_i) )\r
 162       End If\r
 163     End If\r
 164 \r
 165 \r
 166     '//=== g_InitializeModules( ) <= g_InitializeModule\r
 167     '//=== g_InitializeModules_VBSPath( ) <= g_IncludePathes(g_i)\r
 168     If Not IsEmpty( g_InitializeModule ) Then\r
 169       Redim Preserve  g_InitializeModules( UBound( g_InitializeModules ) + 1 )\r
 170       Set  g_InitializeModules( UBound( g_InitializeModules ) ) = g_InitializeModule\r
 171       g_InitializeModule = Empty\r
 172 \r
 173       Redim Preserve  g_InitializeModules_VBSPath( UBound( g_InitializeModules_VBSPath ) + 1 )\r
 174       g_InitializeModules_VBSPath( UBound( g_InitializeModules_VBSPath ) ) = g_IncludePathes(g_i)\r
 175     End If\r
 176 \r
 177 \r
 178     '//=== g_FinalizeModules( ) <= g_FinalizeModule\r
 179     If Not IsEmpty( g_FinalizeModule ) Then\r
 180       Redim Preserve  g_FinalizeModules( UBound( g_FinalizeModules ) + 1 )\r
 181       Set  g_FinalizeModules( UBound( g_FinalizeModules ) ) = g_FinalizeModule\r
 182       g_FinalizeModule = Empty\r
 183 \r
 184       Redim Preserve  g_FinalizeModules_VBSPath( UBound( g_FinalizeModules_VBSPath ) + 1 )\r
 185       g_FinalizeModules_VBSPath( UBound( g_FinalizeModules_VBSPath ) ) = g_IncludePathes(g_i)\r
 186 \r
 187       Redim Preserve  g_FinalizeLevels( UBound( g_FinalizeLevels ) + 1 )\r
 188       g_FinalizeLevels( UBound( g_FinalizeLevels ) ) = g_FinalizeLevel\r
 189     End If\r
 190 \r
 191   End If\r
 192 Next\r
 193 \r
 194 \r
 195 CallInitializeInModules\r
 196 \r
 197 Set g_FinalizeInModulesCaller = new FinalizeInModulesCaller\r
 198 \r
 199 \r
 200 g_SrcPath = Empty\r
 201 g_f = Empty\r
 202 \r
 203 \r
 204  \r
 205 '********************************************************************************\r
 206 '  <<< [echo_c_in_vbs_inc] >>> \r
 207 '********************************************************************************\r
 208 Sub  echo_c_in_vbs_inc( Message )\r
 209   If g_CommandPrompt <> 0 Then  WScript.Echo  Message\r
 210 End Sub\r
 211  \r
 212 '********************************************************************************\r
 213 '  <<< [ChangeScriptMode] >>> \r
 214 '********************************************************************************\r
 215 Sub  ChangeScriptMode\r
 216   Dim  c_debug, c_admin, b_vista_admin\r
 217   Dim  cmd, exe, host, host_opt, script, params, opt, exit_cmd, host_end\r
 218   Dim  b_close_finish, i, key, directory, window_style\r
 219 \r
 220   '//=== Set default\r
 221   If IsEmpty(g_debug) Then  g_debug = False\r
 222   If IsEmpty(g_CommandPrompt) Then  g_CommandPrompt = True\r
 223   window_style = 1\r
 224 \r
 225   '//=== Get status\r
 226   g_b_cscript_exe = (LCase( Right( WScript.FullName, 11 ) ) = "cscript.exe")\r
 227   c_debug = Not IsEmpty( WScript.Arguments.Named("debug") )\r
 228   c_admin = Not IsEmpty( WScript.Arguments.Named("admin") )\r
 229   ' g_debug\r
 230   If Not IsEmpty( WScript.Arguments.Named("g_debug") ) Then  g_debug=True:c_debug=True\r
 231   If g_debug=1 Then g_debug=True\r
 232   If g_debug=0 Then g_debug=False\r
 233   ' b_close_finish\r
 234   If (g_CommandPrompt and 4) = 4 Then window_style = 7\r
 235   If (g_CommandPrompt and 3) = 2 Then b_close_finish = False\r
 236   If (g_CommandPrompt and 3) = 1 Then b_close_finish = True\r
 237   If (g_CommandPrompt and 3) = 0 Then b_close_finish = False\r
 238   g_admin = ( g_admin <> 0 )\r
 239 \r
 240 \r
 241   '//=== Make command line\r
 242   directory = g_sh.CurrentDirectory\r
 243   If g_CommandPrompt > 0 Then\r
 244     If g_admin Then\r
 245       exe  = "cmd"\r
 246       host = "cmd /K (cd /d """ + directory + """ & cscript //nologo"\r
 247       host_end = ")"\r
 248     Else\r
 249       exe  = "cmd"\r
 250       host = "cmd /K (cscript //nologo"\r
 251       host_end = ")"\r
 252     End If\r
 253   Else\r
 254     '//If IsEmpty( g_curdir ) Then  directory = g_sh.CurrentDirectory  Else  directory = g_curdir\r
 255     exe  = "wscript"\r
 256     host = "wscript"\r
 257     host_end = ""\r
 258   End If\r
 259 \r
 260   If g_debug Then\r
 261     host_opt = " //x"\r
 262   Else\r
 263     host_opt = ""\r
 264   End If\r
 265 \r
 266 '//  If g_CommandPrompt > 0 Then\r
 267 '//    script = " """ + g_fs.GetFileName( WScript.ScriptFullName ) + """"\r
 268 '//  Else\r
 269     script = " """ + WScript.ScriptFullName + """"\r
 270 '//  End If\r
 271 \r
 272   params=""\r
 273   For i=0 To WScript.Arguments.Count - 1\r
 274     If InStr( WScript.Arguments(i), " " ) = 0 Then\r
 275       params=params+" "+WScript.Arguments(i)\r
 276     Else\r
 277       params=params+" """+WScript.Arguments(i)+""""\r
 278     End If\r
 279   Next\r
 280   If not IsEmpty( g_debug_params ) Then\r
 281     params=params+" "+g_debug_params\r
 282   End If\r
 283 \r
 284   If g_debug Then\r
 285     opt = " /debug:1"\r
 286   Else\r
 287     opt = ""\r
 288   End If\r
 289 \r
 290   If g_admin Then\r
 291     opt = opt + " /admin:1"\r
 292   End If\r
 293 \r
 294   If b_close_finish Then\r
 295     exit_cmd = " & if errorlevel 21 exit"\r
 296   Else\r
 297     exit_cmd = ""\r
 298   End If\r
 299 \r
 300 \r
 301   '//=== Start\r
 302   If g_b_cscript_exe<>(g_CommandPrompt>0) or c_debug<>g_debug or c_admin<>g_admin Then\r
 303 \r
 304     cmd = host + host_opt + script + params + opt + exit_cmd + host_end\r
 305 \r
 306     If g_admin and ( GetOSVersion() >= 6.0 ) Then\r
 307 \r
 308       '// Run as administrator on Windows Vista\r
 309       Dim  sh_ap\r
 310       Set  sh_ap = CreateObject( "Shell.Application" )\r
 311       sh_ap.ShellExecute  exe, Mid( cmd, Len(exe)+2 ), directory, "runas", window_style\r
 312     Else\r
 313 \r
 314       '// Change to runas command\r
 315       If g_admin Then\r
 316         i = g_sh.ExpandEnvironmentStrings("%ProgramFiles%\vbslib\%USERNAME%\setting\account_setting.vbs")\r
 317         If g_fs.FileExists( i ) Then  include  i\r
 318         If IsDefined( "Setting_getAdminUserName" ) Then\r
 319           i = Setting_getAdminUserName()\r
 320           If MsgBox( "Do you start as Administrator user?" + vbCRLF + "user: " + i + vbCRLF +_\r
 321             "command: " +WScript.ScriptFullName + " " + params,_\r
 322             vbOKCancel, "Warning: " & WScript.ScriptName ) <> vbOK Then  WScript.Quit 1\r
 323           If not IsEmpty( i ) Then  cmd = "runas /user:" + i + " """ + Replace( cmd, """", "\""" )+""""\r
 324         End If\r
 325       End If\r
 326 \r
 327       '// Run the command\r
 328       '// g_sh.CurrentDirectory = directory\r
 329       Stop\r
 330 '//      g_sh.Run  cmd, window_style, Not IsEmpty(WScript.Arguments.Named.Item("waitfin"))\r
 331       g_sh.Run  cmd, window_style, True\r
 332     End If\r
 333 \r
 334     WScript.Quit 0\r
 335   End If\r
 336 End Sub\r
 337 \r
 338 \r
 339  \r
 340 '********************************************************************************\r
 341 '  <<< [CallInitializeInModules] >>> \r
 342 '********************************************************************************\r
 343 Sub  CallInitializeInModules\r
 344   Dim  i\r
 345 \r
 346   For i = 0 To UBound( g_InitializeModules )\r
 347     g_InitializeModules( i )( g_InitializeModules_VBSPath( i ) )\r
 348   Next\r
 349 End Sub\r
 350 \r
 351 \r
 352  \r
 353 '********************************************************************************\r
 354 '  <<< [CallFinalizeInModules] >>> \r
 355 '********************************************************************************\r
 356 Sub  CallFinalizeInModules( Reason )\r
 357   Dim  i, min_lv, min_over_lv, b\r
 358   Const  limit=999999999\r
 359 \r
 360   min_over_lv = -limit\r
 361   Do\r
 362     min_lv = limit\r
 363     For i = 0 To UBound( g_FinalizeModules )\r
 364       If g_FinalizeLevels( i ) < min_lv And  g_FinalizeLevels( i ) > min_over_lv Then _\r
 365         min_lv = g_FinalizeLevels( i )\r
 366     Next\r
 367     If min_lv = limit Then Exit Do\r
 368 \r
 369     For i = 0 To UBound( g_FinalizeModules )\r
 370       If g_FinalizeLevels( i ) = min_lv Then _\r
 371         Call  g_FinalizeModules( i )( g_FinalizeModules_VBSPath( i ), Reason )\r
 372     Next\r
 373     min_over_lv = min_lv\r
 374   Loop\r
 375   g_FinalizeInModulesCaller.m_bDisableCall = True\r
 376 \r
 377 \r
 378   Const  Pass_Num = 21, Skip_Num = 22\r
 379   Dim  exit_code\r
 380 \r
 381   If Err.Number = Pass_Num Then\r
 382     exit_code = Pass_Num\r
 383   ElseIf Err.Number <> 0 Then\r
 384     If Left( Err.Description, 1 ) = "<" or Err.Number = Skip_Num Then\r
 385       WScript.Echo  Err.Description\r
 386     Else\r
 387       WScript.Echo  GetErrStr( Err.Number, Err.Description )\r
 388     End If\r
 389     If g_CommandPrompt = 1 Then\r
 390 \r
 391       If not IsEmpty( g_CUI ) Then\r
 392         While  Left( g_CUI.m_Auto_Keys, 1 ) <> ""  and _\r
 393                Left( g_CUI.m_Auto_Keys, 1 ) <> "."\r
 394           g_CUI.m_Auto_Keys = Mid( g_CUI.m_Auto_Keys, 2 )\r
 395         WEnd\r
 396       End If\r
 397 \r
 398       b = False\r
 399       If not IsEmpty( g_CUI ) Then\r
 400         If Left( g_CUI.m_Auto_Keys, 1 ) = "." Then\r
 401           If not IsEmpty( WScript.Arguments.Named.Item("GUI_input") ) Then _\r
 402             WScript.StdOut.WriteLine  "<WARNING msg='\83G\83\89\81[\82ª\94\90¶\82µ\82½\83v\83\8d\83Z\83X\82Í\8bN\93®\82µ\82½\82Æ\82«\82Ì\83v\83\8d\83Z\83X\82Æ\88Ù\82È\82è\82Ü\82·' current_vbs='" + _\r
 403                WScript.ScriptFullName +"'/>"\r
 404           WScript.StdOut.Write  "\8fI\97¹\82·\82é\82É\82Í Enter \83L\81[\82ð\89\9f\82µ\82Ä\82\82¾\82³\82¢ . . . "\r
 405           g_CUI.m_Auto_Keys = Mid( g_CUI.m_Auto_Keys, 2 )\r
 406           b = True\r
 407         End If\r
 408       End If\r
 409       If not b Then\r
 410         If IsEmpty( WScript.Arguments.Named.Item("GUI_input") ) Then\r
 411           WScript.StdOut.Write  "\8fI\97¹\82·\82é\82É\82Í Enter \83L\81[\82ð\89\9f\82µ\82Ä\82\82¾\82³\82¢ . . . "\r
 412           Wscript.StdIn.ReadLine\r
 413         Else\r
 414           WScript.StdOut.WriteLine  "<WARNING msg='\83G\83\89\81[\82ª\94\90¶\82µ\82½\83v\83\8d\83Z\83X\82Í\8bN\93®\82µ\82½\82Æ\82«\82Ì\83v\83\8d\83Z\83X\82Æ\88Ù\82È\82è\82Ü\82·' current_vbs='" + _\r
 415                WScript.ScriptFullName +"'/>"\r
 416           WScript.StdOut.Write  "\8fI\97¹\82·\82é\82É\82Í Enter \83L\81[\82ð\89\9f\82µ\82Ä\82\82¾\82³\82¢ . . . "\r
 417           MsgBox  "\8fI\97¹\82·\82é\82É\82Í Enter \83L\81[\82ð\89\9f\82µ\82Ä\82\82¾\82³\82¢ . . . "\r
 418         End If\r
 419       End If\r
 420     End If\r
 421     exit_code = Err.Number\r
 422   Else\r
 423     exit_code = Pass_Num\r
 424     If not IsEmpty( g_ExitCode ) Then  exit_code = g_ExitCode\r
 425   End If\r
 426 \r
 427   If g_debug Then\r
 428     WScript.Echo  "exit code = " & exit_code & vbCRLF & _\r
 429                   "(but now exit code = 0 with debugger.)"\r
 430     Exit Sub  '// WScript.Quit occurs unknown error with debugger\r
 431   Else\r
 432     WScript.Quit  exit_code  ' If error was raised here, WSH-exe return is zero only.\r
 433   End If\r
 434 End Sub\r
 435 \r
 436 \r
 437  \r
 438 '********************************************************************************\r
 439 '  <<< [FinalizeInModulesCaller] >>> \r
 440 '********************************************************************************\r
 441 Class  FinalizeInModulesCaller\r
 442   Public  m_bDisableCall\r
 443   Private Sub  Class_Terminate()\r
 444     If IsEmpty( m_bDisableCall ) and Err.Number <> &h8004FFFD Then 'h8004FFFD=WScript.Quit\r
 445       Const  Pass_Num = 21, Skip_Num = 22\r
 446       If Err.Number = Pass_Num or Err.Number = Skip_Num  Then  CallFinalizeInModules  0 _\r
 447       Else  CallFinalizeInModules  1\r
 448     End If\r
 449   End Sub\r
 450 End Class\r
 451 \r
 452  \r
 453 '********************************************************************************\r
 454 '  <<< [ResumePush] >>> \r
 455 '********************************************************************************\r
 456 Function  ResumePush\r
 457   ResumePush = ( g_debug = 0 )\r
 458     '// If error occured, WSH process returns 0.\r
 459     '// ResumePop catches error for returning error code.\r
 460 End Function\r
 461 \r
 462 \r
 463  \r
 464 '********************************************************************************\r
 465 '  <<< [ResumePop] >>> \r
 466 '********************************************************************************\r
 467 Function  ResumePop\r
 468   Const  Pass_Num = 21\r
 469   If Err.Number = 0 or Err.Number = Pass_Num Then\r
 470     CallFinalizeInModules  0\r
 471   Else\r
 472     CallFinalizeInModules  1\r
 473   End If\r
 474 End Function\r
 475 \r
 476 \r
 477  \r
 478 '********************************************************************************\r
 479 '  <<< [GetErrStr] >>> \r
 480 '********************************************************************************\r
 481 Function  GetErrStr( en, ed )\r
 482   If en = 0 Then\r
 483     GetErrStr = "no error"\r
 484   ElseIf en = 21 Then\r
 485     GetErrStr = "[Pass]"\r
 486   ElseIf en > 0 And en <= &h7FFF Then\r
 487     GetErrStr = "<ERROR err_number='" & en & "' err_description='" & ed & "'/>"\r
 488   Else\r
 489     GetErrStr = "<ERROR err_number='0x" & Hex(en) & "' err_description='" & ed & "'/>"\r
 490   End If\r
 491 End Function\r
 492 \r
 493 \r
 494  \r
 495 '********************************************************************************\r
 496 '  <<< [SetVar] >>> \r
 497 '********************************************************************************\r
 498 Sub  SetVar( Symbol, Value )\r
 499   echo  ">SetVar  """ + Symbol + """, """ & Value & """"\r
 500   If Symbol = g_vbslib_var_break_symbol Then  Stop  '// Look at then caller function using watch window of debugger\r
 501   g_vbslib_var.Item( Symbol ) = Value\r
 502 End Sub\r
 503 \r
 504 \r
 505  \r
 506 '********************************************************************************\r
 507 '  <<< [GetVar] >>> \r
 508 '********************************************************************************\r
 509 Function  GetVar( Symbol )\r
 510   GetVar = g_vbslib_var.Item( Symbol )\r
 511   If IsEmpty( GetVar ) Then  GetVar = g_sh.ExpandEnvironmentStrings( "%"+Symbol+"%" )\r
 512   If InStr( GetVar, "%" ) > 0 Then  GetVar = Empty\r
 513 \r
 514   If Symbol = g_vbslib_var_break_symbol Then  Stop  '// Look at then caller function using watch window of debugger\r
 515 End Function\r
 516 \r
 517 \r
 518  \r
 519 '********************************************************************************\r
 520 '  <<< [SetVarBreak] >>> \r
 521 '********************************************************************************\r
 522 Sub  SetVarBreak( Symbol, Opt )\r
 523   g_vbslib_var_break_symbol = Symbol\r
 524 \r
 525   Dim  sym2 : sym2 = "%"+Symbol+"%"\r
 526   Dim  value : value = g_sh.ExpandEnvironmentStrings( sym2 )\r
 527   If value <> sym2 Then _\r
 528     Stop  '// (Symbol) OS environment variable is already defined.\r
 529 \r
 530   value = g_vbslib_var.Item( Symbol )\r
 531   If not IsEmpty( value ) Then _\r
 532     Stop  '// (Symbol) vbslib variable is already defined.\r
 533 End Sub\r
 534 \r
 535 \r
 536  \r
 537 '********************************************************************************\r
 538 '  <<< [IsDefined] >>> \r
 539 '********************************************************************************\r
 540 Function  IsDefined( Symbol )\r
 541   Dim en\r
 542 \r
 543   On Error Resume Next\r
 544     Call GetRef( Symbol )\r
 545   en = Err.Number : On Error GoTo 0\r
 546 \r
 547   IsDefined = ( en <> 5 )\r
 548 End Function\r
 549 \r
 550 \r
 551  \r
 552 '********************************************************************************\r
 553 '  <<< [GetOSVersion] >>> \r
 554 '********************************************************************************\r
 555 Function  GetOSVersion()\r
 556 \r
 557   '// Get OS Version from cimv2 of WMI\r
 558   Dim  cimv2 : Set cimv2 = GetObject( "winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")\r
 559   Dim  os : Set os = cimv2.ExecQuery( "SELECT * FROM Win32_OperatingSystem" )\r
 560   Dim  v, ver\r
 561   For Each v in os\r
 562     ver = v.Version\r
 563   Next\r
 564   cimv2 = Empty : os = Empty : v = Empty\r
 565 \r
 566   '// Cut build number\r
 567   Dim  i\r
 568   i = InStr( ver, "." )\r
 569   i = InStr( i+1, ver, "." )\r
 570   GetOSVersion = CDbl( Left( ver, i-1 ) )\r
 571 End Function\r
 572 \r
 573 \r
 574  \r
 575 '********************************************************************************\r
 576 '  <<< [GetExistPathInSetting] >>> \r
 577 '********************************************************************************\r
 578 Function  GetExistPathInSetting( Pathes, SettingFuncName )\r
 579   Dim  i, t\r
 580   For i=0 To UBound( Pathes )\r
 581     If g_fs.FileExists( Pathes(i) ) Then\r
 582       GetExistPathInSetting = g_fs.GetAbsolutePathName(Pathes(i))  '// set to same as Big/Little case\r
 583       Exit Function\r
 584     End If\r
 585   Next\r
 586   t = "" :  For i=0 To UBound( Pathes ) : t = t + vbCrLf + "  " + Pathes(i) : Next\r
 587   Err.Raise 1,, SettingFuncName + " \82Å\90Ý\92è\82µ\82Ä\82¢\82é\88È\89º\82Ì\82¢\82¸\82ê\82©\82Ì\83t\83@\83C\83\8b\82ª\8c©\82Â\82©\82è\82Ü\82¹\82ñ\81B" + _\r
 588    " \81i\8eQ\8dl\81Fvbslib \82Ì\90à\96¾\8f\91\82Ì setting \83t\83H\83\8b\83_\81j" + t\r
 589 End Function\r
 590 \r
 591 \r
 592  \r
 593 '********************************************************************************\r
 594 '  <<< [include] >>> \r
 595 '********************************************************************************\r
 596 Sub  include( ByVal path )\r
 597   Dim f, en,ed, current\r
 598 \r
 599   If g_debug or g_debug_vbs_inc Then  echo_c_in_vbs_inc ">include  """ + path + """"\r
 600 \r
 601   path = g_sh.ExpandEnvironmentStrings( path )\r
 602 \r
 603   If InStr( path, "*" ) > 0    Then  include_objs  path, Empty, Empty : Exit Sub\r
 604   If g_fs.FolderExists( path ) Then  include_objs  path, Empty, Empty : Exit Sub\r
 605 \r
 606   current = g_sh.CurrentDirectory\r
 607   g_SrcPath = g_fs.GetAbsolutePathName( path )\r
 608   If path <> g_fs.GetFileName( path ) Then\r
 609     if not g_fs.FileExists( path ) Then _\r
 610       Err.Raise 2,, "include: Not found """ + path + """ current=""" + g_sh.CurrentDirectory +""""\r
 611     g_sh.CurrentDirectory = g_fs.GetParentFolderName( g_fs.GetAbsolutePathName( path ) )\r
 612   End If\r
 613 \r
 614   On Error Resume Next\r
 615     Set f = g_fs.OpenTextFile( g_fs.GetFileName( path ) )\r
 616   en = Err.Number : ed = Err.Description : On Error GoTo 0\r
 617   If en <> 0 Then  Err.Raise en,,ed + " in include( " + path + " )"\r
 618   If g_debug=0 Then\r
 619     On Error Resume Next\r
 620       ExecuteGlobal  f.ReadAll()\r
 621       g_sh.CurrentDirectory = current\r
 622     en = Err.Number : ed = Err.Description : On Error GoTo 0\r
 623     If en=&h411 Then  en = 0  '// &h411=Symbol Overrided\r
 624     If en <> 0 Then  Err.Raise en,,ed + " in include( " + path + " )." + _\r
 625       " Please double click the vbs file, if syntax error occured."\r
 626   Else\r
 627     Dim  t : t = "'// " + g_SrcPath +vbCRLF+ f.ReadAll() : f.Close : ExecuteGlobal t\r
 628     g_sh.CurrentDirectory = current\r
 629   End If\r
 630   g_SrcPath = Empty\r
 631 End Sub\r
 632  \r