_src/_replica/vbslib/vbslib.vbs

   1 Option Explicit \r
   2 \r
   3 ' vbslib  ver2.00 2008/8/17\r
   4 ' Copyright (c) 2008, T's-Neko\r
   5 ' All rights reserved. 3-clause BSD license.\r
   6 \r
   7 \r
   8  \r
   9 '********************************************************************************\r
  10 '  <<< Global variables >>> \r
  11 '********************************************************************************\r
  12 \r
  13 Dim  g_workfolder, g_Err2, g_echo_on\r
  14 Dim  g_Test\r
  15 Dim  g_CUI\r
  16 \r
  17 Function  InitializeModule\r
  18   g_workfolder = ""\r
  19   g_echo_on = True\r
  20   Set g_Err2 = New Err2\r
  21   Set g_CUI = New CUI\r
  22 End Function\r
  23 Dim  g_InitializeModule\r
  24 Set  g_InitializeModule = GetRef( "InitializeModule" )\r
  25 \r
  26 Function  FinalizeModule( ThisPath )\r
  27   g_Err2.OnSuccessFinish\r
  28 End Function\r
  29 Dim g_FinalizeModule: Set g_FinalizeModule = GetRef( "FinalizeModule" )\r
  30 Dim g_FinalizeLevel:      g_FinalizeLevel  = 100  ' If smaller, called early\r
  31 \r
  32 \r
  33 Const  F_File      = 1\r
  34 Const  F_Folder    = 2\r
  35 Const  F_SubFolder = 4\r
  36 \r
  37 \r
  38  \r
  39 '********************************************************************************\r
  40 '  <<< Error Code >>> \r
  41 '********************************************************************************\r
  42 \r
  43 '         vbObjectError = &h80040000\r
  44 Const E_AssertFail      = &h80041001\r
  45 Const E_TestFail        = &h80041003\r
  46 Const E_BuildFail       = &h80041004\r
  47 Const E_OutOfWorkFolder = &h80041005\r
  48 Const E_ProgTerminated  = &hC0000005\r
  49 Const E_NotFoundSymbol  = &h80041006\r
  50 Const E_ProgRetNotZero  = &h80041007\r
  51 Const E_Unexpected      = &h80041008\r
  52 Const E_Other           = &h80041009\r
  53 Const E_FileNotExist      = 53\r
  54 Const E_EndOfFile         = 62\r
  55 Const E_WriteAccessDenied = 70\r
  56 Const E_PathNotFound      = 76\r
  57 \r
  58 \r
  59  \r
  60 '********************************************************************************\r
  61 '  <<< File Object >>> \r
  62 '********************************************************************************\r
  63 \r
  64 Const ReadOnly  = 1\r
  65 \r
  66 \r
  67  \r
  68 '*-------------------------------------------------------------------------*\r
  69 '* \81\9f<<<< \83\86\81[\83U\83C\83\93\83^\81[\83t\83F\83C\83X >>>> \r
  70 '*-------------------------------------------------------------------------*\r
  71 \r
  72 \r
  73  \r
  74 '********************************************************************************\r
  75 '  <<< [echo] >>> \r
  76 ' return: output message\r
  77 '********************************************************************************\r
  78 Function  echo( ByVal msg )\r
  79   Dim  b\r
  80 \r
  81   If IsObject( msg ) Then  msg = msg.Value\r
  82 \r
  83   WScript.Echo  msg\r
  84 \r
  85   b = False : If Not IsEmpty( g_Test ) Then  b = Not IsEmpty( g_Test.m_Log )\r
  86   If b Then  g_Test.m_Log.WriteLine  msg\r
  87   echo = msg\r
  88 End Function\r
  89 \r
  90 \r
  91  \r
  92 '********************************************************************************\r
  93 '  <<< [echo_r] >>> \r
  94 ' return: output message\r
  95 '********************************************************************************\r
  96 Function  echo_r( ByVal msg, redirect_path )\r
  97   Dim  f\r
  98   Const  ForAppending = 8\r
  99 \r
 100   If IsObject( msg ) Then  msg = msg.Value\r
 101 \r
 102   If g_debug Then  WScript.Echo  msg\r
 103 \r
 104   If IsEmpty( redirect_path ) Then\r
 105   ElseIf redirect_path = "" Then\r
 106     If Not g_debug Then  WScript.Echo  msg\r
 107   Else\r
 108     Set f = g_fs.OpenTextFile( redirect_path, ForAppending, True, False )\r
 109     f.WriteLine  msg\r
 110   End If\r
 111 \r
 112   echo_r = msg\r
 113 End Function\r
 114 \r
 115 \r
 116  \r
 117 '********************************************************************************\r
 118 '  <<< [echo_c] >>> \r
 119 '********************************************************************************\r
 120 Sub  echo_c( msg )\r
 121   If g_b_cscript_exe And g_echo_on Then  echo msg\r
 122 End Sub\r
 123 \r
 124 \r
 125  \r
 126 '********************************************************************************\r
 127 '  <<< [echo_on] >>> \r
 128 '********************************************************************************\r
 129 Sub  echo_on()\r
 130   g_echo_on = True\r
 131 End Sub\r
 132 \r
 133 Sub  echo_off()\r
 134   g_echo_on = False\r
 135 End Sub\r
 136 \r
 137 \r
 138  \r
 139 '********************************************************************************\r
 140 '  <<< [EchoOnOff] >>> \r
 141 '********************************************************************************\r
 142 Class  EchoOnOff\r
 143 \r
 144   Public  m_Prev\r
 145 \r
 146   Private Sub Class_Initialize\r
 147     m_Prev = g_echo_on\r
 148   End Sub\r
 149 \r
 150   Private Sub Class_Terminate\r
 151     g_echo_on = m_Prev\r
 152   End Sub\r
 153 End Class\r
 154 \r
 155 \r
 156  \r
 157 '********************************************************************************\r
 158 '  <<< [type_] >>> \r
 159 '********************************************************************************\r
 160 Sub  type_( path )\r
 161   Dim  f\r
 162 \r
 163   Set f = g_fs.OpenTextFile( path )\r
 164 \r
 165   Do Until f.AtEndOfStream\r
 166     WScript.Echo f.ReadLine\r
 167   Loop\r
 168 End Sub\r
 169 \r
 170 \r
 171  \r
 172 '********************************************************************************\r
 173 '  <<< [pause] >>> \r
 174 '********************************************************************************\r
 175 Sub  pause()\r
 176   input "\91±\8ds\82·\82é\82É\82Í Enter \83L\81[\82ð\89\9f\82µ\82Ä\82\82¾\82³\82¢ . . ."\r
 177 End Sub\r
 178 \r
 179 \r
 180  \r
 181 '********************************************************************************\r
 182 '  <<< [pause2] >>> \r
 183 '********************************************************************************\r
 184 Sub  pause2()\r
 185   If WScript.Arguments.Named("wscript")=1 Then input "Enter \83L\81[\82ð\89\9f\82µ\82Ä\82\82¾\82³\82¢ . . ."\r
 186 End Sub\r
 187 \r
 188 \r
 189  \r
 190 '********************************************************************************\r
 191 '  <<< [input] >>> \r
 192 '********************************************************************************\r
 193 Function  input( ByVal msg )\r
 194 \r
 195   input = g_CUI.input( msg )\r
 196 \r
 197 '  Dim e\r
 198 '\r
 199 '  Wscript.StdOut.Write  msg\r
 200 '\r
 201 '  On Error Resume Next\r
 202 '\r
 203 '    input = WScript.StdIn.ReadLine\r
 204 '\r
 205 '  e = Err.Number : Err.Clear : On Error GoTo 0\r
 206 '  If e <> 0 Then\r
 207 '    If e <> 62 Then Err.Raise e  '62= End Of File (StdIn, ^C)\r
 208 '    WScript.Quit 1\r
 209 '  End If\r
 210 \r
 211 End Function\r
 212 \r
 213 \r
 214  \r
 215 '********************************************************************************\r
 216 '  <<< [SendKeys] Send keyboard code stroke to OS >>> \r
 217 '********************************************************************************\r
 218 Sub  SendKeys( ByVal window_title, ByVal keycords, ByVal late_time )\r
 219   WScript.Sleep late_time\r
 220   If window_title <> "" Then  g_sh.AppActivate( window_title )\r
 221   WScript.Sleep 100\r
 222   g_sh.SendKeys keycords\r
 223 End Sub\r
 224 \r
 225 \r
 226  \r
 227 '*-------------------------------------------------------------------------*\r
 228 '* \81\9f<<<< [CUI] Class >>>> \r
 229 '*-------------------------------------------------------------------------*\r
 230 \r
 231 Class  CUI\r
 232 \r
 233   Public  m_Auto_InputFunc    ' as string of auto input function name\r
 234   Public  m_Auto_Src          ' as string of path\r
 235   Public  m_Auto_Keys         ' as string of auto input keys\r
 236   Public  m_Auto_KeyEnter     ' as string of the character of replacing to enter key\r
 237   Public  m_Auto_DebugCount   ' as integer\r
 238 \r
 239 \r
 240  \r
 241 '********************************************************************************\r
 242 '  <<< [CUI::Class_Initialize] >>> \r
 243 '********************************************************************************\r
 244 Private Sub Class_Initialize\r
 245   Me.m_Auto_KeyEnter = "."\r
 246   Me.m_Auto_DebugCount = Empty\r
 247 End Sub\r
 248 \r
 249 \r
 250  \r
 251 '********************************************************************************\r
 252 '  <<< [CUI::pause] >>> \r
 253 '********************************************************************************\r
 254 Public Sub  pause()\r
 255   input "\91±\8ds\82·\82é\82É\82Í Enter \83L\81[\82ð\89\9f\82µ\82Ä\82\82¾\82³\82¢ . . ."\r
 256 End Sub\r
 257 \r
 258 \r
 259  \r
 260 '********************************************************************************\r
 261 '  <<< [CUI::input] >>> \r
 262 '********************************************************************************\r
 263 Public Function  input( ByVal msg )\r
 264   Dim e\r
 265   Dim InputFunc\r
 266 \r
 267   Wscript.StdOut.Write  msg\r
 268 \r
 269   On Error Resume Next\r
 270 \r
 271   If Not IsEmpty( m_Auto_Keys ) And  m_Auto_Keys <> "" Then\r
 272     If Not IsEmpty( m_Auto_KeyEnter ) Then\r
 273       e = InStr( m_Auto_Keys, m_Auto_KeyEnter )\r
 274       If e = 0 Then\r
 275         input = m_Auto_Keys\r
 276         m_Auto_Keys = Empty\r
 277       Else\r
 278         input = Left( m_Auto_Keys, e - 1 )\r
 279         m_Auto_Keys = Mid( m_Auto_Keys, e + 1 )\r
 280       End If\r
 281     Else\r
 282       input = m_Auto_Keys\r
 283       m_Auto_Keys = Empty\r
 284     End If\r
 285 \r
 286     If IsEmpty( m_Auto_DebugCount ) Then\r
 287       echo input\r
 288     ElseIf  m_Auto_DebugCount > 1 Then\r
 289       echo input\r
 290       m_Auto_DebugCount = m_Auto_DebugCount - 1\r
 291     Else\r
 292       Wscript.StdOut.Write  input\r
 293       Wscript.StdIn.ReadLine\r
 294       echo ""\r
 295     End If\r
 296 \r
 297   ElseIf IsEmpty( m_Auto_InputFunc ) Then\r
 298     input = Wscript.StdIn.ReadLine\r
 299   Else\r
 300     If IsEmpty( m_Auto_Src ) Then\r
 301       Set InputFunc = GetRef( m_Auto_InputFunc )\r
 302       If Err.Number = 5 Then WScript.Echo vbCR+vbLF+"Not found function of """+_\r
 303                              m_Auto_InputFunc +"""": Err.Clear\r
 304       If Not IsEmpty( InputFunc ) Then  input = InputFunc( msg )\r
 305     Else\r
 306       input = call_vbs_t( m_Auto_Src, m_Auto_InputFunc, msg )\r
 307       If Err.Number = 5 Then WScript.Echo vbCR+vbLF+"Not found function of """+_\r
 308             m_Auto_InputFunc +""" in """+m_Auto_Src+"""" : Err.Clear\r
 309       If IsEmpty( input ) Then  Wscript.StdOut.Write  msg : input = Wscript.StdIn.ReadLine\r
 310     End If\r
 311   End If\r
 312 \r
 313   e = Err.Number : Err.Clear : On Error GoTo 0\r
 314   If e <> 0 Then\r
 315     If e <> 62 Then Err.Raise e  '62= End Of File (StdIn, ^C)\r
 316     WScript.Quit 1\r
 317   End If\r
 318 \r
 319 End Function\r
 320 \r
 321 \r
 322  \r
 323 '********************************************************************************\r
 324 '  <<< [CUI::SetAutoKeysFromMainArg] >>> \r
 325 '********************************************************************************\r
 326 Public Sub  SetAutoKeysFromMainArg\r
 327   If IsEmpty( Me.m_Auto_Keys ) Then\r
 328     Me.m_Auto_Keys = WScript.Arguments.Named.Item("autokeys")\r
 329     Me.m_Auto_DebugCount = WScript.Arguments.Named.Item("autokeys_debug")\r
 330   End If\r
 331 End Sub\r
 332 \r
 333 \r
 334  \r
 335 End Class \r
 336 \r
 337 \r
 338  \r
 339 '*-------------------------------------------------------------------------*\r
 340 '* \81\9f<<<< \83t\83@\83C\83\8b\91\80\8dì >>>> \r
 341 '*-------------------------------------------------------------------------*\r
 342 \r
 343 \r
 344  \r
 345 '********************************************************************************\r
 346 '  <<< [set_workfolder] Set modifiable base folder path >>> \r
 347 ' comment\r
 348 '  - if work path set current directory, path = ""\r
 349 '********************************************************************************\r
 350 Sub  set_workfolder( ByVal path )\r
 351   If g_debug Then  echo_c  "set_workfolder: " + path\r
 352 \r
 353   If path = "" Then\r
 354     g_workfolder = ""\r
 355   Else\r
 356     If Not g_fs.FolderExists( path ) Then  Err.Raise E_FileNotExist,"vbslib","Not found """+path+""""\r
 357     g_workfolder = g_fs.GetAbsolutePathName( path )\r
 358   End If\r
 359 End Sub\r
 360 \r
 361 \r
 362  \r
 363 '********************************************************************************\r
 364 '  <<< [WorkFolderStack] Set modifiable base folder path >>> \r
 365 '********************************************************************************\r
 366 Class  WorkFolderStack\r
 367 \r
 368   Public  m_PrevWorkFolder\r
 369 \r
 370   Private Sub Class_Initialize\r
 371     m_PrevWorkFolder = g_workfolder\r
 372   End Sub\r
 373 \r
 374   Private Sub Class_Terminate\r
 375     g_workfolder = m_PrevWorkFolder\r
 376   End Sub\r
 377 \r
 378   Public Sub  Set_( path )\r
 379     '// If g_debug Then  echo_c  "set_workfolder: " + path\r
 380 \r
 381     If path = "" Then\r
 382       g_workfolder = ""\r
 383     ElseIf path = "." Then\r
 384       g_workfolder = g_sh.CurrentDirectory\r
 385     Else\r
 386       If Not g_fs.FolderExists( path ) Then  Err.Raise E_FileNotExist,"vbslib","Not found """+path+""""\r
 387       g_workfolder = g_fs.GetAbsolutePathName( path )\r
 388     End If\r
 389   End Sub\r
 390 End Class\r
 391 \r
 392 \r
 393  \r
 394 '********************************************************************************\r
 395 '  <<< [chk_in_workfolder] Check not to modify out of working folder >>> \r
 396 ' comment\r
 397 '  - If path is out of workfolder, raise error of E_OutOfWorkFolder.\r
 398 '********************************************************************************\r
 399 Sub  chk_in_workfolder( ByVal path )\r
 400   Dim  sh, work\r
 401 \r
 402   If g_workfolder = "" Then\r
 403     Set sh = WScript.CreateObject("WScript.Shell")\r
 404     work = sh.CurrentDirectory\r
 405     sh = Empty\r
 406   Else\r
 407     work = g_workfolder\r
 408   End If\r
 409   work = g_fs.BuildPath( work, "a" )\r
 410   work = Left( work, Len(work) - 1 )\r
 411 \r
 412   path = g_fs.GetAbsolutePathName( path )\r
 413 \r
 414   If work <> Left( path, Len( work ) ) Then\r
 415     Err.Raise E_OutOfWorkFolder, "vbslib", "Out of working folder """ & path & """"\r
 416   End If\r
 417 \r
 418 End Sub\r
 419 \r
 420 \r
 421  \r
 422 '********************************************************************************\r
 423 '  <<< [cd] change current directory >>> \r
 424 ' sample\r
 425 '   cd "sub"\r
 426 '********************************************************************************\r
 427 Sub  cd( ByVal dir )\r
 428   Dim  sh\r
 429 \r
 430   Set sh = WScript.CreateObject("WScript.Shell")\r
 431   sh.CurrentDirectory = dir\r
 432 \r
 433 End Sub\r
 434 \r
 435 \r
 436  \r
 437 '********************************************************************************\r
 438 '  <<< [CurDirStack] >>> \r
 439 '********************************************************************************\r
 440 Class  CurDirStack\r
 441 \r
 442   Public  m_Prev\r
 443 \r
 444   Private Sub Class_Initialize\r
 445     m_Prev = g_sh.CurrentDirectory\r
 446   End Sub\r
 447 \r
 448   Private Sub Class_Terminate\r
 449     g_sh.CurrentDirectory = m_Prev\r
 450   End Sub\r
 451 End Class\r
 452 \r
 453 \r
 454  \r
 455 '********************************************************************************\r
 456 '  <<< [pushd] push and change current directory >>> \r
 457 ' sample\r
 458 '   pushd "sub"\r
 459 '********************************************************************************\r
 460 Dim  g_pushd_stack()\r
 461 Dim  g_pushd_stack_n\r
 462 \r
 463 Sub  pushd( ByVal dir )\r
 464   Dim  sh\r
 465 \r
 466   g_pushd_stack_n = g_pushd_stack_n + 1\r
 467   Redim Preserve  g_pushd_stack( g_pushd_stack_n )\r
 468 \r
 469   Set sh = WScript.CreateObject("WScript.Shell")\r
 470   g_pushd_stack( g_pushd_stack_n ) = sh.CurrentDirectory\r
 471   sh.CurrentDirectory = dir\r
 472 \r
 473 End Sub\r
 474 \r
 475 \r
 476  \r
 477 '********************************************************************************\r
 478 '  <<< [popd] pop current directory >>> \r
 479 '********************************************************************************\r
 480 Sub  popd\r
 481   Dim  sh\r
 482 \r
 483   If g_pushd_stack_n < 1 Then Exit Sub\r
 484 \r
 485   Set sh = WScript.CreateObject("WScript.Shell")\r
 486   sh.CurrentDirectory = g_pushd_stack( g_pushd_stack_n )\r
 487 \r
 488   g_pushd_stack_n = g_pushd_stack_n - 1\r
 489 \r
 490 End Sub\r
 491 \r
 492 \r
 493  \r
 494 '********************************************************************************\r
 495 '  <<< [copy] >>> \r
 496 ' argument\r
 497 '  - src : source file or folder path or wild card\r
 498 '  - dst : destination folder path or renaming file path\r
 499 ' comment\r
 500 '  - reference: vbslib.svg#copy\r
 501 '********************************************************************************\r
 502 Sub  copy( ByVal src, ByVal dst )\r
 503 \r
 504   If g_fs.FolderExists( dst ) Then\r
 505     chk_in_workfolder  g_fs.BuildPath( dst, "a" )\r
 506   Else\r
 507     chk_in_workfolder  dst\r
 508   End If\r
 509 \r
 510 \r
 511   ' If src had Wild card\r
 512   If IsWildcard( src ) Then\r
 513 \r
 514     Dim  fo,en,ed\r
 515 \r
 516     If Not g_fs.FolderExists( dst ) Then  mkdir dst\r
 517     If Not g_fs.FolderExists( g_fs.GetParentFolderName( src ) ) Then _\r
 518       Err.Raise  E_PathNotFound,,"\83p\83X\82ª\8c©\82Â\82©\82è\82Ü\82¹\82ñ\81B"\r
 519 \r
 520     On Error Resume Next\r
 521       g_fs.CopyFile  src, dst, True\r
 522       g_fs.CopyFolder  src, dst, True\r
 523     en = Err.Number : ed = Err.Description : On Error GoTo 0\r
 524     If en = E_PathNotFound Then  en = 0\r
 525     If en = E_FileNotExist Then  en = 0\r
 526     If en <> 0 Then  Err.Raise en,,ed\r
 527 \r
 528 \r
 529   ' If src is file\r
 530   ElseIf g_fs.FileExists( src ) Then\r
 531 \r
 532     Dim  dst_fo\r
 533 \r
 534     If g_fs.FolderExists( dst ) Then\r
 535       dst = g_fs.BuildPath( dst, g_fs.GetFileName( src ) )\r
 536     Else\r
 537       dst_fo = g_fs.GetParentFolderName( dst )\r
 538       If dst_fo <> "" And Not g_fs.FolderExists( dst_fo ) Then  mkdir  dst_fo\r
 539     End If\r
 540 \r
 541     g_fs.CopyFile  src, dst, True\r
 542 \r
 543 \r
 544   ' If src is folder\r
 545   ElseIf g_fs.FolderExists( src ) Then\r
 546 \r
 547     If Not g_fs.FolderExists( dst ) Then  mkdir  dst\r
 548 \r
 549     g_fs.CopyFolder src, g_fs.BuildPath( dst, g_fs.GetFileName( src ) ), True\r
 550 \r
 551 \r
 552   ' not found\r
 553   Else\r
 554     g_fs.CopyFile  src, dst, True  ' Error occurs\r
 555 \r
 556   End If\r
 557 End Sub\r
 558 \r
 559 \r
 560  \r
 561 '********************************************************************************\r
 562 '  <<< [move] >>> \r
 563 '********************************************************************************\r
 564 Sub  move( ByVal src, ByVal dst )\r
 565 \r
 566   If g_fs.FolderExists( dst ) Then\r
 567     chk_in_workfolder  g_fs.BuildPath( dst, "a" )\r
 568   Else\r
 569     chk_in_workfolder  dst\r
 570   End If\r
 571 \r
 572 \r
 573   ' If src had Wild card\r
 574   If IsWildcard( src ) Then\r
 575 \r
 576     Dim  fo,en,ed\r
 577 \r
 578     If Not g_fs.FolderExists( dst ) Then  mkdir dst\r
 579     If Not g_fs.FolderExists( g_fs.GetParentFolderName( src ) ) Then _\r
 580       Err.Raise  E_PathNotFound,,"\83p\83X\82ª\8c©\82Â\82©\82è\82Ü\82¹\82ñ\81B"\r
 581 \r
 582     On Error Resume Next\r
 583       g_fs.MoveFile  src, dst\r
 584       g_fs.MoveFolder  src, dst\r
 585     en = Err.Number : ed = Err.Description : On Error GoTo 0\r
 586     If en = E_PathNotFound Then  en = 0\r
 587     If en = E_FileNotExist Then  en = 0\r
 588     If en <> 0 Then  Err.Raise en,,ed\r
 589 \r
 590 \r
 591   ' If src is file\r
 592   ElseIf g_fs.FileExists( src ) Then\r
 593 \r
 594     Dim  dst_fo\r
 595 \r
 596     If g_fs.FolderExists( dst ) Then\r
 597       dst = g_fs.BuildPath( dst, g_fs.GetFileName( src ) )\r
 598     Else\r
 599       dst_fo = g_fs.GetParentFolderName( dst )\r
 600       If Not g_fs.FolderExists( dst_fo ) Then  mkdir  dst_fo\r
 601     End If\r
 602 \r
 603     g_fs.MoveFile  src, dst\r
 604 \r
 605 \r
 606   ' If src is folder\r
 607   ElseIf g_fs.FolderExists( src ) Then\r
 608 \r
 609     If Not g_fs.FolderExists( dst ) Then  mkdir  dst\r
 610 \r
 611     g_fs.MoveFolder src, g_fs.BuildPath( dst, g_fs.GetFileName( src ) )\r
 612 \r
 613 \r
 614   ' not found\r
 615   Else\r
 616     g_fs.MoveFile  src, dst  ' Error occurs\r
 617 \r
 618   End If\r
 619 End Sub\r
 620 \r
 621 \r
 622  \r
 623 '********************************************************************************\r
 624 '  <<< [ren] >>> \r
 625 '********************************************************************************\r
 626 Sub  ren( src, dst )\r
 627   Dim  f\r
 628   If g_fs.FileExists( src ) Then\r
 629     Set f = g_fs.GetFile( src )\r
 630     f.Name = g_fs.GetFileName( dst )\r
 631   Else\r
 632     Set f = g_fs.GetFolder( src )\r
 633     f.Name = g_fs.GetFileName( dst )\r
 634   End If\r
 635 End Sub\r
 636 \r
 637 \r
 638  \r
 639 '********************************************************************************\r
 640 '  <<< [SafeFileUpdate] >>> \r
 641 '********************************************************************************\r
 642 Sub  SafeFileUpdate( FromTmpFilePath, ToUpdateFilePath )\r
 643   Dim en,ed,en2,ed2,i,path\r
 644 \r
 645   For i=1 To 999\r
 646     path = g_fs.GetParentFolderName( ToUpdateFilePath ) + "\" + _\r
 647            g_fs.GetBaseName( ToUpdateFilePath ) + "." & i & "." + g_fs.GetExtensionName( ToUpdateFilePath )\r
 648     If not exist( path ) Then  Exit For\r
 649   Next\r
 650   If exist( path ) Then  Err.Raise E_Other,,"\83o\83b\83N\83A\83b\83v\82Ì\83t\83@\83C\83\8b\96¼\82ª\8dì\82ê\82Ü\82¹\82ñ\81B\81F" + ToUpdateFilePath\r
 651 \r
 652   On Error Resume Next\r
 653     g_fs.CopyFile  ToUpdateFilePath, path, False\r
 654   en = Err.Number : ed = Err.Description : On Error GoTo 0\r
 655   If en <> 0 Then  Err.Raise en,,"\83o\83b\83N\83A\83b\83v\83R\83s\81[\82É\8e¸\94s\82µ\82Ü\82µ\82½\81B"+vbCR+vbLF+_\r
 656      "\83o\83b\83N\83A\83b\83v\8c³\81F"+ToUpdateFilePath+vbCR+vbLF+ "\83o\83b\83N\83A\83b\83v\90æ\81F"+path+vbCR+vbLF+ ed\r
 657 \r
 658   del_to_trashbox  path\r
 659 \r
 660   On Error Resume Next\r
 661     g_fs.CopyFile  FromTmpFilePath, ToUpdateFilePath, True\r
 662   en2 = Err.Number : ed2 = Err.Description : On Error GoTo 0\r
 663 \r
 664   On Error Resume Next\r
 665     g_fs.DeleteFile  FromTmpFilePath\r
 666   en = Err.Number : ed = Err.Description : On Error GoTo 0\r
 667 \r
 668   If en2 <> 0 Then  Err.Raise en2,,"\8fã\8f\91\82«\83R\83s\81[\82É\8e¸\94s\82µ\82Ü\82µ\82½\81B\83S\83~\94 \82É\93ü\82ê\82½\8c³\82Ì\83t\83@\83C\83\8b\82ð\95\9c\8a\88\82³\82¹\82Ä\82\82¾\82³\82¢\81B"+vbCR+vbLF+_\r
 669      "\83R\83s\81[\8c³\81F"+FromTmpFilePath+vbCR+vbLF+ "\83R\83s\81[\90æ\81F"+ToUpdateFilePath+vbCR+vbLF+ ed2\r
 670 \r
 671   If en <> 0 Then  WScript.Echo "\8dX\90V\82Í\90¬\8c÷\82µ\82Ü\82µ\82½\82ª\81A\88ê\8e\9e\83t\83@\83C\83\8b\82Ì\8dí\8f\9c\82É\8e¸\94s\82µ\82Ü\82µ\82½\81B"+vbCR+vbLF+_\r
 672      "\88ê\8e\9e\83t\83@\83C\83\8b\81F"+FromTmpFilePath+vbCR+vbLF+ "\8dX\90V\8dÏ\82Ý\83t\83@\83C\83\8b\81F"+ToUpdateFilePath+vbCR+vbLF+ ed\r
 673 \r
 674 End Sub\r
 675 \r
 676 \r
 677  \r
 678 '********************************************************************************\r
 679 '  <<< [del] >>> \r
 680 '********************************************************************************\r
 681 Sub  del( ByVal path )\r
 682 \r
 683   ' If path had Wild card\r
 684   If IsWildCard( path ) Then\r
 685     Dim  folder, fname, fnames()\r
 686 \r
 687     ExpandWildcard  path, F_File, folder, fnames\r
 688     For Each fname in fnames\r
 689       del  g_fs.BuildPath( folder, fname )\r
 690     Next\r
 691 \r
 692     ExpandWildcard  path, F_Folder, folder, fnames\r
 693     For Each fname in fnames\r
 694       del  g_fs.BuildPath( folder, fname )\r
 695     Next\r
 696 \r
 697   ' If path was file or folder path\r
 698   Else\r
 699 \r
 700     If g_fs.FileExists( path ) Then\r
 701       chk_in_workfolder  path\r
 702       g_fs.DeleteFile  path\r
 703     ElseIf g_fs.FolderExists( path ) Then\r
 704       rmdir  path\r
 705     Else\r
 706       chk_in_workfolder  path\r
 707     End If\r
 708   End If\r
 709 \r
 710 End Sub\r
 711 \r
 712 \r
 713  \r
 714 '********************************************************************************\r
 715 '  <<< [del_subfolder] >>> \r
 716 '********************************************************************************\r
 717 Sub  del_subfolder( ByVal path )\r
 718   Dim  folder, fname, fnames()\r
 719 \r
 720   ExpandWildcard  path, F_File Or F_SubFolder, folder, fnames\r
 721   For Each fname in fnames\r
 722     del  g_fs.BuildPath( folder, fname )\r
 723   Next\r
 724 \r
 725   ExpandWildcard  path, F_Folder Or F_SubFolder, folder, fnames\r
 726   For Each fname in fnames\r
 727     del  g_fs.BuildPath( folder, fname )\r
 728   Next\r
 729 End Sub\r
 730 \r
 731 \r
 732  \r
 733 '********************************************************************************\r
 734 '  <<< [del_to_trashbox] >>> \r
 735 '********************************************************************************\r
 736 Sub  del_to_trashbox( ByVal path )\r
 737   Dim  sh_ap, TrashBox, folder, item, fname\r
 738   Set  sh_ap = CreateObject("Shell.Application")\r
 739   Const  ssfBITBUCKET = 10\r
 740 \r
 741   path = g_fs.GetAbsolutePathName( path )\r
 742   fname = g_fs.GetFileName( path )\r
 743   Set  folder = sh_ap.NameSpace( g_fs.GetParentFolderName( path ) )\r
 744   If folder is Nothing Then  Exit Sub\r
 745   Set  item = folder.Items.Item( fname )\r
 746   If item is Nothing Then  Exit Sub\r
 747 \r
 748   Set  TrashBox = sh_ap.NameSpace( ssfBITBUCKET )\r
 749   TrashBox.MoveHere  item\r
 750 \r
 751   Do\r
 752     WScript.Sleep 300\r
 753     Set  item = folder.Items.Item( fname )\r
 754     If item is Nothing Then Exit Do\r
 755     item = Empty\r
 756   Loop\r
 757 End Sub\r
 758 \r
 759 \r
 760  \r
 761 '********************************************************************************\r
 762 '  <<< [mkdir] >>> \r
 763 ' argument\r
 764 '  - return : count of made folder\r
 765 ' comment\r
 766 '  - This is able to make nested folder.\r
 767 '********************************************************************************\r
 768 Function  mkdir( ByVal fo )\r
 769   Dim  i, n, names(), fo2\r
 770 \r
 771   If g_fs.FolderExists( fo ) Then  mkdir = 0 : Exit Function\r
 772   chk_in_workfolder  fo\r
 773 \r
 774   n = 0\r
 775   fo2 = g_fs.GetAbsolutePathName( fo )\r
 776   Do\r
 777     If g_fs.FolderExists( fo2 ) Then Exit Do\r
 778 \r
 779     n = n + 1\r
 780     Redim Preserve  names(n)\r
 781     names(n) = g_fs.GetFileName( fo2 )\r
 782     fo2 = g_fs.GetParentFolderName( fo2 )\r
 783   Loop\r
 784 \r
 785   mkdir = n\r
 786 \r
 787   For n=n To 1 Step -1\r
 788     fo2 = g_fs.BuildPath( fo2, names(n) )\r
 789     g_fs.CreateFolder  fo2\r
 790   Next\r
 791 \r
 792 End Function\r
 793 \r
 794 \r
 795  \r
 796 '********************************************************************************\r
 797 '  <<< [rmdir] >>> \r
 798 '********************************************************************************\r
 799 Sub  rmdir( ByVal path )\r
 800   Dim  path2, iFolder, nFolder, fo, subf, f, file\r
 801 \r
 802   If Not g_fs.FolderExists( path ) Then Exit Sub\r
 803 \r
 804   chk_in_workfolder  path\r
 805 \r
 806 \r
 807   ' Cut last \\r
 808   path2 = path\r
 809   If Right( path2, 1 ) = "\" Then  path2 = Left( path2, Len( path2 ) - 1 )\r
 810 \r
 811   nFolder = 1\r
 812   ReDim folderPathes(nFolder)\r
 813   folderPathes(nFolder) = path2\r
 814 \r
 815   ' Enum sub folders\r
 816   iFolder = 1\r
 817   While iFolder <= nFolder\r
 818     Set fo = g_fs.GetFolder( folderPathes(iFolder) )\r
 819     For Each subf in fo.SubFolders\r
 820       nFolder = nFolder + 1\r
 821       ReDim Preserve folderPathes(nFolder)\r
 822       folderPathes(nFolder) = subf.Path\r
 823     Next\r
 824     iFolder = iFolder + 1\r
 825   WEnd\r
 826 \r
 827   ' Remove read only attribute of all files in sub folders\r
 828   For iFolder = 1 To nFolder\r
 829     Set fo = g_fs.GetFolder( folderPathes(iFolder) )\r
 830     For Each f in fo.Files\r
 831       Set file = g_fs.GetFile( f.Path )\r
 832       file.Attributes = file.Attributes And Not ReadOnly\r
 833     Next\r
 834   Next\r
 835 \r
 836   ' Delete folders\r
 837   Dim en,ed\r
 838   On Error Resume Next\r
 839     g_fs.DeleteFolder( path )\r
 840   en = Err.Number : ed = Err.Description : On Error GoTo 0\r
 841   If en = E_WriteAccessDenied Then ed = "Denied to delete the folder: "+ path\r
 842   If en <> 0 Then  Err.Raise en,,ed\r
 843 \r
 844 End Sub\r
 845 \r
 846 \r
 847  \r
 848 '********************************************************************************\r
 849 '  <<< [exist] >>> \r
 850 '********************************************************************************\r
 851 Function  exist( ByVal path )\r
 852   If IsWildcard( path ) Then\r
 853     Dim  folder, fnames()\r
 854     ExpandWildcard  path, F_File, folder, fnames\r
 855     exist = UBound( fnames ) <> -1\r
 856   Else\r
 857     exist = ( g_fs.FileExists( path ) = True ) Or ( g_fs.FolderExists( path ) = True )\r
 858   End If\r
 859 End Function\r
 860 \r
 861 \r
 862  \r
 863 '********************************************************************************\r
 864 '  <<< [fc] file compare as binary >>> \r
 865 ' argument\r
 866 '  - return : True=same, False=different\r
 867 '********************************************************************************\r
 868 Function  fc( ByVal path_a, ByVal path_b )\r
 869   fc = fc_r( path_a, path_b, "nul" )\r
 870 End Function\r
 871 \r
 872 \r
 873  \r
 874 '********************************************************************************\r
 875 '  <<< [fc_r] file compare as binary >>> \r
 876 ' argument\r
 877 '  - return : True=same, False=different\r
 878 '********************************************************************************\r
 879 Function  fc_r( ByVal path_a, ByVal path_b, redirect_path )\r
 880   Dim  echos_:Set echos_= New EchoOnOff\r
 881   Dim  cmdline\r
 882 \r
 883   cmdline = """" + g_vbslib_folder + "feq.exe"" """ + path_a + """ """ + path_b + """"\r
 884 \r
 885   If IsEmpty( redirect_path ) Then\r
 886     echo_c  "fc  """ + path_a + """ """ + path_b + """"\r
 887     chk_exist_in_lib  "feq.exe"\r
 888     fc_r = g_sh.Run( cmdline, 7, TRUE )\r
 889   Else\r
 890     Dim  ex\r
 891     If redirect_path <> "nul" Then _\r
 892       echo_c  "fc  """ + path_a + """ """ + path_b + """ >> " + redirect_path\r
 893     chk_exist_in_lib  "feq.exe"\r
 894     Set  ex = g_sh.Exec( cmdline )\r
 895     redirect_path = g_sh.ExpandEnvironmentStrings( redirect_path )\r
 896     fc_r = WaitForFinishAndRedirect( ex, redirect_path )\r
 897   End If\r
 898 \r
 899   fc_r = (fc_r = 0)\r
 900 \r
 901   If fc_r And g_fs.FolderExists( path_a ) Then\r
 902     Dim  folder, fnames_a(), fnames_b()\r
 903     Dim  i\r
 904 \r
 905     ExpandWildcard  path_a + "\*", F_Folder Or F_SubFolder, folder, fnames_a\r
 906     ExpandWildcard  path_b + "\*", F_Folder Or F_SubFolder, folder, fnames_b\r
 907     If UBound(fnames_a) = UBound(fnames_b) Then\r
 908       For i=0 To UBound(fnames_a)\r
 909         If fnames_a(i) <> fnames_b(i) Then  fc_r = False : Exit For\r
 910       Next\r
 911     Else\r
 912       fc_r = False\r
 913     End If\r
 914   End If\r
 915 \r
 916 '  echo_off\r
 917 '  fc_r = fc_r_imp( path_a, path_b, True, _\r
 918 '     g_fs.GetAbsolutePathName(path_a), redirect_path )\r
 919 \r
 920 End Function\r
 921 \r
 922 \r
 923 'Function  fc_r_imp( ByVal path_a, ByVal path_b, b_top, base_a, redirect_path )\r
 924 '\r
 925 '  ' File Compare\r
 926 '  If g_fs.FileExists( path_a ) Then\r
 927 '\r
 928 '    Dim  sh, ex, r\r
 929 '    If Not g_fs.FileExists( path_b ) Then _\r
 930 '      echo_r  "Not found (B)"+path_b, redirect_path : fc_r_imp=False : Exit Function\r
 931 '\r
 932 '    r = RunProg( "fc.exe /B """ + path_a + """ """ + path_b + """", redirect_path )\r
 933 '    If r = 0 Then\r
 934 '      If b_top Then  echo_r "same.", redirect_path\r
 935 '    Else\r
 936 '      If b_top Then  echo_r "NOT same.", redirect_path _\r
 937 '      Else           echo_r "NOT same in "+GetStepPath( path_a, base_a ), redirect_path\r
 938 '    End IF\r
 939 '    fc_r_imp = ( r = 0 )\r
 940 '\r
 941 '  ' Folder Compare\r
 942 '  ElseIf g_fs.FolderExists( path_a ) Then\r
 943 '\r
 944 '    Dim  foldersA, foldersB, folderA, folderB, foA, foB, step, f\r
 945 '    If Not g_fs.FolderExists( path_b ) Then _\r
 946 '      echo_r  "Not found (B)"+g_fs.GetFileName(path_b)+" in "+GetStepPath( folderA, base_a ), redirect_path : fc_r_imp=False : Exit Function\r
 947 '\r
 948 '    path_a = g_fs.GetAbsolutePathName( path_a )\r
 949 '    path_b = g_fs.GetAbsolutePathName( path_b )\r
 950 '    GetSubFolders  foldersA, path_a\r
 951 '    GetSubFolders  foldersB, path_b\r
 952 '\r
 953 '    If UBound( foldersA ) <> UBound( foldersB ) Then _\r
 954 '      echo_r  "NOT same count of folders in "+ GetStepPath( path_a, base_a ), redirect_path : fc_r_imp=False : Exit Function\r
 955 '\r
 956 '    For Each folderA In foldersA\r
 957 '      step = Mid( folderA, Len( path_a ) + 1 )\r
 958 '      If step = "" Then\r
 959 '        folderB = path_b\r
 960 '      Else\r
 961 '        folderB = g_fs.BuildPath( path_b, step )\r
 962 '      End If\r
 963 '\r
 964 '      Set foA = g_fs.GetFolder( folderA )\r
 965 '      Set foB = g_fs.GetFolder( folderB )\r
 966 '\r
 967 '      If foA.Files.Count <> foB.Files.Count Then _\r
 968 '        echo_r  "NOT same count of files in "+ GetStepPath( folderA, base_a ), redirect_path : fc_r_imp=False : Exit Function\r
 969 '\r
 970 '      For Each f In foA.Files\r
 971 '        If Not fc_r_imp( f.Path, folderB + Mid( f.Path, Len( folderA ) + 1 ), False, base_a, redirect_path ) Then\r
 972 '          fc_r_imp=False : Exit Function\r
 973 '        End If\r
 974 '      Next\r
 975 '    Next\r
 976 '\r
 977 '    If b_top Then\r
 978 '      If r = 0 Then  echo_r "same.", redirect_path\r
 979 '    End IF\r
 980 '    fc_r_imp = True\r
 981 '  Else\r
 982 '    echo_r  "Not found (A)"+path_a, redirect_path : fc_r_imp=False : Exit Function\r
 983 '  End If\r
 984 'End Function\r
 985 \r
 986 \r
 987  \r
 988 '********************************************************************************\r
 989 '  <<< [find] find lines including keyword >>> \r
 990 '********************************************************************************\r
 991 Function  find( ByVal keyword, ByVal path )\r
 992   Dim  f, line, ret\r
 993   Set  f = g_fs.OpenTextFile( path )\r
 994 \r
 995   ret = ""\r
 996   Do Until f.AtEndOfStream\r
 997     line = f.ReadLine\r
 998     If InStr( line, keyword ) > 0 Then  ret = ret + line\r
 999   Loop\r
1000 \r
1001   f.Close\r
1002 \r
1003   find = ret\r
1004 End Function\r
1005 \r
1006 \r
1007  \r
1008 '********************************************************************************\r
1009 '  <<< [find_c] find lines count including keyword >>> \r
1010 '********************************************************************************\r
1011 Function  find_c( ByVal keyword, ByVal path )\r
1012   Dim  f, line, ret\r
1013   Set  f = g_fs.OpenTextFile( path )\r
1014 \r
1015   ret = 0\r
1016   Do Until f.AtEndOfStream\r
1017     line = f.ReadLine\r
1018     If InStr( line, keyword ) > 0 Then  ret = ret + 1\r
1019   Loop\r
1020 \r
1021   f.Close\r
1022 \r
1023   find_c = ret\r
1024 End Function\r
1025 \r
1026 \r
1027  \r
1028 '********************************************************************************\r
1029 '  <<< [CreateFile] Create 1 line text file >>> \r
1030 '********************************************************************************\r
1031 Sub  CreateFile( ByVal path, ByVal text )\r
1032   Dim  t, folder\r
1033 \r
1034   chk_in_workfolder  path\r
1035 \r
1036   path = g_fs.GetAbsolutePathName( path )\r
1037   folder = g_fs.GetParentFolderName( path )\r
1038   mkdir  folder\r
1039 \r
1040   Set t = g_fs.CreateTextFile( path, True, False )\r
1041   t.WriteLine text\r
1042   t.Close\r
1043 End Sub\r
1044 \r
1045 \r
1046  \r
1047 '********************************************************************************\r
1048 '  <<< [ReadFile] >>> \r
1049 '********************************************************************************\r
1050 Function  ReadFile( Path )\r
1051   Dim  f, en, ed\r
1052 \r
1053   ReadFile = ""\r
1054 \r
1055   On Error Resume Next\r
1056      Set f = g_fs.OpenTextFile( Path )\r
1057   en = Err.Number : ed = Err.Description : On Error GoTo 0\r
1058   If en = E_FileNotExist  Then  Exit Function\r
1059   If en <> 0 Then  Err.Raise en,,ed\r
1060 \r
1061   ReadFile = ReadAll( f )\r
1062 End Function\r
1063 \r
1064 \r
1065  \r
1066 '********************************************************************************\r
1067 '  <<< [OpenTextFile] >>> \r
1068 '********************************************************************************\r
1069 Function  OpenTextFile( Path )\r
1070   Dim  en, ed\r
1071 \r
1072   On Error Resume Next\r
1073      Set OpenTextFile = g_fs.OpenTextFile( Path )\r
1074   en = Err.Number : ed = Err.Description : On Error GoTo 0\r
1075   If en = E_FileNotExist  Then  Err.raise  en,,ed+" : "+Path\r
1076   If en <> 0 Then  Err.Raise en,,ed\r
1077 End Function\r
1078 \r
1079 \r
1080  \r
1081 '********************************************************************************\r
1082 '  <<< [ReadAll] >>> \r
1083 '********************************************************************************\r
1084 Function  ReadAll( FileStream )\r
1085   Dim  en, ed\r
1086 \r
1087   ReadAll = ""\r
1088   On Error Resume Next\r
1089     ReadAll = FileStream.ReadAll\r
1090   en = Err.Number : ed = Err.Description : On Error GoTo 0\r
1091   If en = E_EndOfFile Then  en = 0\r
1092   If en <> 0 Then  Err.Raise en,,ed\r
1093 End Function\r
1094 \r
1095 \r
1096  \r
1097 '********************************************************************************\r
1098 '  <<< [WriteVBSLibHeader] >>> \r
1099 '********************************************************************************\r
1100 Sub  WriteVBSLibHeader( OutFileStream, Opt )\r
1101   Dim  f, line\r
1102 \r
1103   Set f = g_fs.OpenTextFile( WScript.ScriptFullName )\r
1104   Do Until f.AtEndOfStream\r
1105 \r
1106     line = f.ReadLine\r
1107 \r
1108     If InStr( line, "g_CommandPrompt =" ) > 0 and not IsEmpty( Opt ) Then\r
1109       If not IsEmpty( Opt.m_OverCommandPrompt ) Then\r
1110         line = "  g_CommandPrompt = " & Opt.m_OverCommandPrompt\r
1111       End If\r
1112     End If\r
1113     If InStr( line, "main()" ) > 0 Then Exit Do\r
1114 \r
1115     OutFileStream.WriteLine  line\r
1116   Loop\r
1117 End Sub\r
1118 \r
1119 \r
1120 Class  WriteVBSLibHeader_Option\r
1121   Public  m_OverCommandPrompt\r
1122 End Class\r
1123 \r
1124 \r
1125  \r
1126 '********************************************************************************\r
1127 '  <<< [GetAbsPath] >>> \r
1128 '********************************************************************************\r
1129 Function  GetAbsPath( StepPath, BasePath )\r
1130   Dim  i, ii, i3, sep_ch, path\r
1131 \r
1132 \r
1133   '//=== sep_ch = separetor "\" or "/"\r
1134   i  = InStr( BasePath, "\" )\r
1135   ii = InStr( BasePath, "/" )\r
1136   If i > 0 Then\r
1137     If ii > 0 Then\r
1138       If i > ii Then  sep_ch = "/"  Else  sep_ch = "\"\r
1139     Else\r
1140       sep_ch = "\"\r
1141     End If\r
1142   Else\r
1143    If ii > 0 Then  sep_ch = "/"  Else  sep_ch = "\"\r
1144   End If\r
1145 \r
1146 \r
1147   '//=== Joint and Replace to sep_ch\r
1148   If Right( BasePath, 1 ) = sep_ch Then\r
1149     path = BasePath + StepPath\r
1150   Else\r
1151     path = BasePath + sep_ch + StepPath\r
1152   End If\r
1153   If sep_ch = "\" Then\r
1154     path = Replace( path, "/", "\" )\r
1155   Else\r
1156     path = Replace( path, "\", "/" )\r
1157   End If\r
1158 \r
1159 \r
1160   '//=== Cut xxx\..\\r
1161   Do\r
1162     i = InStr( path, sep_ch+".."+sep_ch )\r
1163     If i = 0 Then Exit Do\r
1164     i3 = 0\r
1165     Do\r
1166       ii = InStr( i3+1, path, sep_ch )\r
1167       If ii = 0 Then Exit Do\r
1168       If ii = i Then\r
1169         If i3 = 0 and i = 1 Then Exit Do\r
1170         path = Left( path, i3 ) + Mid( path, i+4 )\r
1171         Exit Do\r
1172       End If\r
1173       i3 = ii\r
1174     Loop\r
1175   Loop\r
1176 \r
1177   GetAbsPath = path\r
1178 End Function\r
1179 \r
1180 \r
1181  \r
1182 '********************************************************************************\r
1183 '  <<< [GetStepPath] >>> \r
1184 ' - AbsPath, BasePath, (return) as string\r
1185 '********************************************************************************\r
1186 \r
1187 '// Test\r
1188 'Set  g_fs = CreateObject( "Scripting.FileSystemObject" )\r
1189 'If GetStepPath( "C:\folder\file.txt", "c:\folder" ) <> "file.txt" Then  MsgBox "ERROR!"\r
1190 'If GetStepPath( "C:\folder\file.txt", "c:\folder\" ) <> "file.txt" Then  MsgBox "ERROR!"\r
1191 'If GetStepPath( "C:\folder\file.txt", "c:\folder\sub" ) <> "..\file.txt" Then  MsgBox "ERROR!"\r
1192 'If GetStepPath( "C:\folder\file.txt", "c:\" ) <> "folder\file.txt" Then  MsgBox "ERROR!"\r
1193 'If GetStepPath( "C:\folder", "c:\folder" ) <> "." Then  MsgBox "ERROR!"\r
1194 'If GetStepPath( "http://www.a.com/folder/file.txt", "http://www.a.com/folder/" ) <> "file.txt" Then  MsgBox "ERROR!"\r
1195 'If GetStepPath( "http://www.a.com/folder/file.txt", "http://www.a.com/" ) <> "folder/file.txt" Then  MsgBox "ERROR!"\r
1196 'MsgBox  "Pass."\r
1197 \r
1198 \r
1199 Function  GetStepPath( AbsPath, BasePath )\r
1200   Dim  AbsPathU, BasePathU, path, sep_ch, i, ii\r
1201 \r
1202   AbsPathU = UCase(AbsPath)\r
1203   BasePathU = UCase(BasePath)\r
1204 \r
1205 \r
1206   '// sep_ch = separetor "\" or "/"\r
1207   i  = InStr( AbsPath, "\" )\r
1208   ii = InStr( AbsPath, "/" )\r
1209   If i > 0 Then\r
1210     If ii > 0 Then\r
1211       If i > ii Then  sep_ch = "/"  Else  sep_ch = "\"\r
1212     Else\r
1213       sep_ch = "\"\r
1214     End If\r
1215   Else\r
1216    If ii > 0 Then  sep_ch = "/"  Else  sep_ch = "\"\r
1217   End If\r
1218 \r
1219 \r
1220   '// path = common parent folder path\r
1221   path = BasePathU\r
1222   If Right(BasePathU,1) = sep_ch Then  path = Left(BasePathU,Len(BasePathU)-1)\r
1223   Do\r
1224     If path = Left( AbsPathU, Len(path) ) Then  Exit Do\r
1225     path = g_fs.GetParentFolderName( path )\r
1226   Loop\r
1227   If path = "" Then  GetStepPath = AbsPath : Exit Function\r
1228 \r
1229 \r
1230   '// GetStepPath = step path without ..\\r
1231   GetStepPath = Mid( AbsPath, Len(path) + 2 )\r
1232 \r
1233 \r
1234   '// GetStepPath: Add "..\"\r
1235   path = Mid( BasePath, Len(path) + 2 )\r
1236   Do\r
1237     If path = "" Then Exit Do\r
1238     path = g_fs.GetParentFolderName( path )\r
1239     GetStepPath = ".." + sep_ch + GetStepPath\r
1240   Loop\r
1241 \r
1242   If GetStepPath = "" Then  GetStepPath = "."\r
1243 End Function\r
1244 \r
1245 \r
1246  \r
1247 '********************************************************************************\r
1248 '  <<< [IsWildcard] >>> \r
1249 '********************************************************************************\r
1250 Function  IsWildcard( ByVal path )\r
1251   IsWildcard = InStr( path, "?" ) <> 0 Or InStr( path, "*" ) <> 0\r
1252 End Function\r
1253 \r
1254 \r
1255  \r
1256 '********************************************************************************\r
1257 '  <<< [ExpandWildcard] >>> \r
1258 '********************************************************************************\r
1259 Sub  ExpandWildcard( ByVal wildcard_path, flags, folder, fnames )\r
1260   Dim  s, re\r
1261 \r
1262   folder = g_fs.GetParentFolderName( g_fs.GetAbsolutePathName( wildcard_path ) )\r
1263 \r
1264   Set re = CreateObject("VBScript.RegExp")\r
1265   re.Global = True\r
1266   s = g_fs.GetFileName( wildcard_path )\r
1267   re.Pattern = "\\" :  s = re.Replace( s, "\\" )\r
1268   re.Pattern = "\." :  s = re.Replace( s, "\." )\r
1269   re.Pattern = "\$" :  s = re.Replace( s, "\$" )\r
1270   re.Pattern = "\^" :  s = re.Replace( s, "\^" )\r
1271   re.Pattern = "\{" :  s = re.Replace( s, "\{" )\r
1272   re.Pattern = "\}" :  s = re.Replace( s, "\}" )\r
1273   re.Pattern = "\[" :  s = re.Replace( s, "\[" )\r
1274   re.Pattern = "\]" :  s = re.Replace( s, "\]" )\r
1275   re.Pattern = "\(" :  s = re.Replace( s, "\(" )\r
1276   re.Pattern = "\)" :  s = re.Replace( s, "\)" )\r
1277   re.Pattern = "\|" :  s = re.Replace( s, "\|" )\r
1278   re.Pattern = "\+" :  s = re.Replace( s, "\+" )\r
1279   re.Pattern = "\*" :  s = re.Replace( s, ".*" )\r
1280   re.Pattern = "\?" :  s = re.Replace( s, "." )\r
1281 \r
1282   re.Pattern = "^" + s\r
1283   If Left( re.Pattern, 3 ) = "^.*" Then  re.Pattern = Mid( re.Pattern, 4 )\r
1284   re.Global = False\r
1285   ReDim  fnames( -1 )\r
1286 \r
1287   ExpandWildcard_sub  re, flags, folder, "", fnames\r
1288 End Sub\r
1289 \r
1290 \r
1291 Sub  ExpandWildcard_sub( re, flags, folder, step_folder, fnames )\r
1292   Dim  fo, f\r
1293 \r
1294   Set fo = g_fs.GetFolder( folder )\r
1295   If flags And F_File Then\r
1296     For Each f in fo.Files\r
1297       If re.Test( f.Name )  Then\r
1298         ReDim Preserve  fnames( UBound(fnames) + 1 )\r
1299         fnames( UBound(fnames) ) = step_folder + f.Name\r
1300       End If\r
1301     Next\r
1302   End If\r
1303   If flags And F_Folder Then\r
1304     For Each f in fo.SubFolders\r
1305       If re.Test( f.Name )  Then\r
1306         ReDim Preserve  fnames( UBound(fnames) + 1 )\r
1307         fnames( UBound(fnames) ) = step_folder + f.Name\r
1308       End If\r
1309     Next\r
1310   End If\r
1311 \r
1312   If flags And F_SubFolder Then\r
1313     For Each f in fo.SubFolders\r
1314       ExpandWildcard_sub  re, flags, f.Path, step_folder + f.Name + "\", fnames\r
1315     Next\r
1316   End If\r
1317 End Sub\r
1318 \r
1319 \r
1320  \r
1321 '********************************************************************************\r
1322 '  <<< [GetSubFolders] >>> \r
1323 ' argument\r
1324 '  - folders : (out) array of folder pathes\r
1325 '  - path : base folder path\r
1326 '********************************************************************************\r
1327 Sub  GetSubFolders( folders, ByVal path )\r
1328   ReDim  folders(-1)\r
1329   EnumSubFolders  folders, g_fs.GetFolder( path )\r
1330 End Sub\r
1331 \r
1332 Sub  EnumSubFolders( folders, fo )\r
1333   Dim  subfo\r
1334 \r
1335   ReDim Preserve  folders( UBound(folders) + 1 )\r
1336   folders( UBound(folders) ) = fo.Path\r
1337 \r
1338   For Each subfo in fo.SubFolders\r
1339     EnumSubFolders  folders, subfo\r
1340   Next\r
1341 End Sub\r
1342 \r
1343 \r
1344  \r
1345 '********************************************************************************\r
1346 '  <<< [RemoveWildcard] >>> \r
1347 '********************************************************************************\r
1348 Sub  RemoveWildcard( WildCard, fnames )\r
1349   Dim  s, path, fname, i, n, wc, wc_len\r
1350 \r
1351 \r
1352   '//=== check by with wildcard\r
1353   If Left( WildCard, 1 ) = "*" Then\r
1354     wc = LCase( Mid( WildCard, 2 ) ) : wc_len = Len( wc )\r
1355     n = UBound( fnames )\r
1356     For i = 0 To  n\r
1357       path = fnames(i)\r
1358       Do\r
1359         fname = g_fs.GetFileName( path )\r
1360         If LCase( Right( fname, wc_len ) ) = wc Then  fnames(i) = Empty : Exit Do\r
1361         path = g_fs.GetParentFolderName( path )\r
1362         If path = "" Then Exit Do\r
1363       Loop\r
1364     Next\r
1365 \r
1366 \r
1367   '//=== check by no wildcard\r
1368   Else\r
1369     wc = LCase( WildCard )\r
1370     n = UBound( fnames )\r
1371     For i = 0 To n\r
1372       path = fnames(i)\r
1373       Do\r
1374         fname = g_fs.GetFileName( path )\r
1375         If LCase( fname ) = wc Then  fnames(i) = Empty : Exit Do\r
1376         path = g_fs.GetParentFolderName( path )\r
1377         If path = "" Then Exit Do\r
1378       Loop\r
1379     Next\r
1380   End If\r
1381 \r
1382 \r
1383   '//=== shrink the array\r
1384   n = 0\r
1385   For i = 0 To UBound( fnames )\r
1386     If not IsEmpty( fnames(i) ) Then  fnames(n) = fnames(i) : n = n + 1\r
1387   Next\r
1388   Redim Preserve  fnames( n - 1 )\r
1389 End Sub\r
1390 \r
1391 \r
1392  \r
1393 '********************************************************************************\r
1394 '  <<< [MeltCSV] >>> \r
1395 '********************************************************************************\r
1396 Function  MeltCSV( Line, in_out_Start )\r
1397   Dim  s, i, c\r
1398 \r
1399   i = in_out_Start\r
1400 \r
1401   '//=== Skip space character\r
1402   Do\r
1403     c = Mid( Line, i, 1 )\r
1404     If c<>" " and c<>vbTab Then Exit Do\r
1405     i = i + 1\r
1406   Loop\r
1407 \r
1408   Select Case  c\r
1409 \r
1410    '//=== If enclosed by " "\r
1411    Case """"\r
1412     Do\r
1413       i = i + 1\r
1414       c = Mid( Line, i, 1 )\r
1415       If c = "" Then Exit Do\r
1416       If c = """" Then\r
1417         i = i + 1\r
1418         c = Mid( Line, i, 1 )\r
1419         If c = """" Then  s = s + c  Else  Exit Do\r
1420       Else\r
1421         s = s + c\r
1422       End If\r
1423     Loop\r
1424 \r
1425     MeltCSV = s\r
1426 \r
1427     Do\r
1428       If c = "" Then  in_out_Start = 0 : Exit Function\r
1429       If c = "," Then  in_out_Start = i+1 : Exit Function\r
1430       i = i + 1\r
1431       c = Mid( Line, i, 1 )\r
1432     Loop\r
1433 \r
1434 \r
1435    '//=== If no value\r
1436    Case ","\r
1437     in_out_Start = i+1 : Exit Function\r
1438    Case ""\r
1439     in_out_Start = 0 : Exit Function\r
1440 \r
1441 \r
1442    '//=== If NOT enclosed by " "\r
1443    Case Else\r
1444     Do\r
1445       If c = "" or c = "," Then Exit Do\r
1446       s = s + c\r
1447       i = i + 1\r
1448       c = Mid( Line, i, 1 )\r
1449     Loop\r
1450 \r
1451     MeltCSV = Trim( s )\r
1452 \r
1453     If c = "" Then  in_out_Start = 0 : Exit Function\r
1454     If c = "," Then  in_out_Start = i+1 : Exit Function\r
1455   End Select\r
1456 End Function\r
1457 \r
1458 \r
1459  \r
1460 '*-------------------------------------------------------------------------*\r
1461 '* \81\9f<<<< \8aÖ\90\94\83R\81[\83\8b\82Æ include >>>> \r
1462 '*-------------------------------------------------------------------------*\r
1463 \r
1464 \r
1465  \r
1466 '********************************************************************************\r
1467 '  <<< [call_vbs] >>> \r
1468 '********************************************************************************\r
1469 Function  call_vbs( path, func, param )\r
1470   call_vbs = call_vbs_t( path, func, param )\r
1471 End Function\r
1472 \r
1473 \r
1474  \r
1475 '*-------------------------------------------------------------------------*\r
1476 '* \81\9f<<<< \83v\83\8d\83Z\83X >>>> \r
1477 '*-------------------------------------------------------------------------*\r
1478 \r
1479 \r
1480  \r
1481 '********************************************************************************\r
1482 '  <<< [env] Expand environment strings >>> \r
1483 '********************************************************************************\r
1484 Function  env( s )\r
1485   env = g_sh.ExpandEnvironmentStrings( s )\r
1486 End Function\r
1487 \r
1488 \r
1489  \r
1490 '********************************************************************************\r
1491 '  <<< [start] >>> \r
1492 '********************************************************************************\r
1493 Sub  start( cmdline )\r
1494   echo_c  cmdline\r
1495   cmdline = g_sh.ExpandEnvironmentStrings( cmdline )\r
1496   g_sh.Run  cmdline,, FALSE\r
1497 End Sub\r
1498  \r
1499 '********************************************************************************\r
1500 '  <<< [RunProg] >>> \r
1501 '********************************************************************************\r
1502 Function  RunProg( ByVal cmdline, stdout_stderr_redirect )\r
1503   Dim  dbg_cmd\r
1504 \r
1505   '// Set debug mode\r
1506   If stdout_stderr_redirect = "_debug" Then\r
1507     dbg_cmd = "cmd /K " : stdout_stderr_redirect = ""\r
1508   Else\r
1509     dbg_cmd = ""\r
1510   End If\r
1511 \r
1512 \r
1513   '// Echo command line\r
1514   If stdout_stderr_redirect = "" Then\r
1515     echo_c  cmdline\r
1516   Else\r
1517     echo_c  cmdline+" >> """+stdout_stderr_redirect+""""\r
1518   End If\r
1519 \r
1520 \r
1521   '// Create new process\r
1522   cmdline = g_sh.ExpandEnvironmentStrings( cmdline )\r
1523 \r
1524   Dim  ex\r
1525   Set ex = g_sh.Exec( cmdline )\r
1526   stdout_stderr_redirect = g_sh.ExpandEnvironmentStrings( stdout_stderr_redirect )\r
1527   RunProg = WaitForFinishAndRedirect( ex, stdout_stderr_redirect )\r
1528 End Function\r
1529 \r
1530 \r
1531  \r
1532 '********************************************************************************\r
1533 '  <<< [WaitForFinishAndRedirect] >>> \r
1534 '********************************************************************************\r
1535 Function  WaitForFinishAndRedirect( ex, path )\r
1536   Dim  f\r
1537 \r
1538   If path <> "" and path <> "nul" Then _\r
1539     Set f = g_fs.OpenTextFile( path, 8, True, False )\r
1540 \r
1541   Do While ex.Status = 0\r
1542     WScript.Sleep 200\r
1543     If path = "" Then\r
1544       Do Until ex.StdOut.AtEndOfStream : echo ex.StdOut.ReadLine : Loop\r
1545       Do Until ex.StdErr.AtEndOfStream : echo ex.StdErr.ReadLine : Loop\r
1546     ElseIf path = "nul" Then\r
1547       Do Until ex.StdOut.AtEndOfStream : ex.StdOut.ReadLine : Loop\r
1548       Do Until ex.StdErr.AtEndOfStream : ex.StdErr.ReadLine : Loop\r
1549     Else\r
1550       Do Until ex.StdOut.AtEndOfStream : f.WriteLine ex.StdOut.ReadLine : Loop\r
1551       Do Until ex.StdErr.AtEndOfStream : f.WriteLine ex.StdErr.ReadLine : Loop\r
1552     End If\r
1553   Loop\r
1554 \r
1555   If path = "" Then\r
1556     Do Until ex.StdOut.AtEndOfStream : echo ex.StdOut.ReadLine : Loop\r
1557     Do Until ex.StdErr.AtEndOfStream : echo ex.StdErr.ReadLine : Loop\r
1558   ElseIf path = "nul" Then\r
1559     Do Until ex.StdOut.AtEndOfStream : ex.StdOut.ReadLine : Loop\r
1560     Do Until ex.StdErr.AtEndOfStream : ex.StdErr.ReadLine : Loop\r
1561   Else\r
1562     Do Until ex.StdOut.AtEndOfStream : f.WriteLine ex.StdOut.ReadLine : Loop\r
1563     Do Until ex.StdErr.AtEndOfStream : f.WriteLine ex.StdErr.ReadLine : Loop\r
1564   End If\r
1565   WaitForFinishAndRedirect = ex.ExitCode\r
1566 End Function\r
1567 \r
1568 \r
1569  \r
1570 '********************************************************************************\r
1571 '  <<< [ArgumentExist] >>> \r
1572 '********************************************************************************\r
1573 Function  ArgumentExist( name )\r
1574   Dim  key\r
1575   For Each key in WScript.Arguments.Named\r
1576     If key = name  Then  ArgumentExist = True : Exit Function\r
1577   Next\r
1578   ArgumentExist = False\r
1579 End Function\r
1580 \r
1581 \r
1582  \r
1583 '*-------------------------------------------------------------------------*\r
1584 '* \81\9f<<<< \91Ò\82¿\81A\90§\8cä >>>> \r
1585 '*-------------------------------------------------------------------------*\r
1586 \r
1587 \r
1588  \r
1589 '********************************************************************************\r
1590 '  <<< [Sleep] >>> \r
1591 '********************************************************************************\r
1592 Sub  Sleep( ByVal msec )\r
1593   WScript.Sleep msec\r
1594 End Sub\r
1595 \r
1596 \r
1597  \r
1598 '********************************************************************************\r
1599 '  <<< [WaitForFile] Wait for make the file >>> \r
1600 '********************************************************************************\r
1601 Sub  WaitForFile( ByVal path )\r
1602   While g_fs.FileExists( path ) = False\r
1603     WScript.Sleep 1000\r
1604   Wend\r
1605 End Sub\r
1606 \r
1607 \r
1608  \r
1609 '*-------------------------------------------------------------------------*\r
1610 '* \81\9f<<<< \94z\97ñ\81A\83R\83\8c\83N\83V\83\87\83\93 >>>> \r
1611 '*-------------------------------------------------------------------------*\r
1612 \r
1613 \r
1614  \r
1615 '********************************************************************************\r
1616 '  <<< [QuickSort_fromDic] >>> \r
1617 'dic as Scripting.Dictionary\r
1618 'out_arr as [out] object array\r
1619 '********************************************************************************\r
1620 Sub  QuickSort_fromDic( dic, out_arr, compare_func, param )\r
1621   Dim    i, i_last, elem\r
1622   i_last = dic.Count - 1\r
1623   Redim  out_arr( i_last )\r
1624 \r
1625   i=0\r
1626   For Each elem  In dic.Items\r
1627     Set out_arr(i) = elem\r
1628     i = i + 1\r
1629   Next\r
1630 \r
1631   QuickSort  out_arr, 0, i_last, compare_func, param\r
1632 End Sub\r
1633 \r
1634 \r
1635  \r
1636 '********************************************************************************\r
1637 '  <<< [QuickSort] >>> \r
1638 '********************************************************************************\r
1639 Sub  QuickSort( arr, i_left, i_right, compare_func, param )\r
1640   Dim  pivot, i_pivot, i_big, i_small, sw\r
1641 \r
1642   If i_left >= i_right Then Exit Sub  ' rule-b'\r
1643 \r
1644   i_pivot = ( i_left + i_right ) \ 2\r
1645   Set pivot = arr( i_pivot )\r
1646 \r
1647 \r
1648   '//== for debug\r
1649   ' Dim  i, sym, value\r
1650   ' echo "QuickSort start ----------------------"\r
1651   ' For i = i_left To i_right\r
1652   '   QuickSort_Debug_getSym  arr, i, sym, value\r
1653   '   If i = i_pivot Then  value = value & " (pivot)"\r
1654   '   echo "(" & i & ") " & sym & " = " & value\r
1655   ' Next\r
1656   'Stop\r
1657 \r
1658 \r
1659   i_big = i_left : i_small = i_right\r
1660   Do\r
1661     '// Set i_big on smaller than pivot\r
1662     Do\r
1663       If compare_func( arr(i_big), pivot, param ) >= 0 Then  Exit Do\r
1664       i_big = i_big + 1\r
1665     Loop\r
1666 \r
1667     '// Set i_small on equal or bigger than pivot\r
1668     Do\r
1669       If i_small < i_pivot and i_small < i_big Then\r
1670         If i_big < i_pivot Then  i_small = i_pivot : Exit Do _\r
1671         Else  Exit Sub  ' rule-c\r
1672       End If\r
1673       If compare_func( arr(i_small), pivot, param ) < 0 Then  Exit Do\r
1674       i_small = i_small - 1\r
1675     Loop\r
1676 \r
1677     '// Swap\r
1678     If i_big < i_small Then  ' rule-a\r
1679       Set sw = arr(i_big) : Set arr(i_big) = arr(i_small) : Set arr(i_small) = sw\r
1680       If i_big   = i_pivot Then  i_pivot = i_small\r
1681       If i_small = i_pivot Then  i_big = i_big + 1 : Exit Do   ' rule-c'\r
1682     Else\r
1683       Exit Do\r
1684     End If\r
1685   Loop\r
1686 \r
1687 \r
1688   '//== for debug\r
1689   ' echo "QuickSort middle ----------------------"\r
1690   ' For i = i_left To i_right\r
1691   '   QuickSort_Debug_getSym  arr, i, sym, value\r
1692   '   If i = i_big-1 Then  value = value & " (i_big-1)"\r
1693   '   If i = i_big   Then  value = value & " (i_big)"\r
1694   '   echo "(" & i & ") " & sym & " = " & value\r
1695   ' Next\r
1696 \r
1697 \r
1698   QuickSort  arr, i_left, i_big-1, compare_func, param  ' rule-b\r
1699   QuickSort  arr, i_big,  i_right, compare_func, param  ' rule-b\r
1700 \r
1701 \r
1702   '//== for debug\r
1703   ' echo "QuickSort end ----------------------"\r
1704   ' For i = i_left To i_right\r
1705   '   QuickSort_Debug_getSym  arr, i, sym, value\r
1706   '   echo "(" & i & ") " & sym & " = " & value\r
1707   ' Next\r
1708 End Sub\r
1709 \r
1710 \r
1711 Sub  QuickSort_Debug_getSym( Arr, Index, out_Symbol, out_Value )\r
1712   out_Symbol = Index\r
1713   out_Value  = Arr(Index).id\r
1714 End Sub\r
1715 \r
1716 \r
1717  \r
1718 '********************************************************************************\r
1719 '  <<< [ShakerSort_fromDic] >>> \r
1720 'dic as Scripting.Dictionary\r
1721 'out_arr as [out] object array\r
1722 '********************************************************************************\r
1723 Sub  ShakerSort_fromDic( dic, out_arr, sign, compare_func, param )\r
1724   Dim    i, i_last, elem\r
1725   i_last = dic.Count - 1\r
1726   Redim  out_arr( i_last )\r
1727 \r
1728   If sign >= 0 Then\r
1729     i=0\r
1730     For Each elem  In dic.Items\r
1731       Set out_arr(i) = elem\r
1732       i = i + 1\r
1733     Next\r
1734   Else\r
1735     i=i_last\r
1736     For Each elem  In dic.Items\r
1737       Set out_arr(i) = elem\r
1738       i = i - 1\r
1739     Next\r
1740   End If\r
1741 \r
1742   ShakerSort  out_arr, 0, i_last, compare_func, param\r
1743 End Sub\r
1744 \r
1745 \r
1746  \r
1747 '********************************************************************************\r
1748 '  <<< [ShakerSort] >>> \r
1749 '********************************************************************************\r
1750 Sub  ShakerSort( arr, i_left, i_right, compare_func, param )\r
1751   Dim  i_swap, i, sw\r
1752 \r
1753   Do\r
1754     i_swap = i_left+1\r
1755     For i=i_left+1 To i_right\r
1756       If compare_func( arr(i-1), arr(i), param ) > 0 Then\r
1757         Set sw = arr(i-1) : Set arr(i-1) = arr(i) : Set arr(i) = sw\r
1758         i_swap = i\r
1759       End If\r
1760     Next\r
1761     If i_swap = i_left+1 Then Exit Do\r
1762     i_right = i_swap-1\r
1763 \r
1764     i_swap = i_right-1\r
1765     For i=i_right-1 To i_left Step -1\r
1766       If compare_func( arr(i), arr(i+1), param ) > 0 Then\r
1767         Set sw = arr(i) : Set arr(i) = arr(i+1) : Set arr(i+1) = sw\r
1768         i_swap = i\r
1769       End If\r
1770     Next\r
1771     If i_swap = i_right-1 Then Exit Do\r
1772     i_left = i_swap+1\r
1773   Loop\r
1774 End Sub\r
1775 \r
1776  \r
1777 '********************************************************************************\r
1778 '  <<< [CInt2] >>> \r
1779 ' - no exception\r
1780 '********************************************************************************\r
1781 Function  CInt2( v )\r
1782   Dim  en, ed\r
1783 \r
1784   On Error Resume Next\r
1785     CInt2 = CInt( v )\r
1786   en = Err.Number : ed = Err.Description : On Error GoTo 0\r
1787   If en = 13 Then  '// if sym is not number\r
1788     CInt2 = 0\r
1789   ElseIf en <> 0 Then  Err.Raise en,,ed  End If\r
1790 End Function\r
1791 \r
1792 \r
1793  \r
1794 '*-------------------------------------------------------------------------*\r
1795 '* <<<< [ArrayClass] Class >>>> */ \r
1796 '*-------------------------------------------------------------------------*\r
1797 \r
1798 Class  ArrayClass\r
1799   Public  m_Array()\r
1800 \r
1801   Private Sub  Class_Initialize\r
1802     ReDim  m_Array( -1 )\r
1803   End Sub\r
1804 \r
1805   Public Sub  ToEmpty()\r
1806     ReDim  m_Array( -1 )\r
1807   End Sub\r
1808 \r
1809   Public Sub  Add( elem )\r
1810     Push  elem\r
1811   End Sub\r
1812 \r
1813   Public Sub  Push( elem )\r
1814     ReDim Preserve  m_Array( UBound(m_Array) + 1 )\r
1815     If IsObject( elem ) Then\r
1816       Set m_Array( UBound(m_Array) ) = elem\r
1817     Else\r
1818       m_Array( UBound(m_Array) ) = elem\r
1819     End If\r
1820   End Sub\r
1821 \r
1822   Public Function  Pop()\r
1823     If IsObject( m_Array( UBound(m_Array) ) ) Then\r
1824       Set Pop = m_Array( UBound(m_Array) )\r
1825     Else\r
1826       Pop = m_Array( UBound(m_Array) )\r
1827     End If\r
1828     ReDim Preserve  m_Array( UBound(m_Array) - 1 )\r
1829   End Function\r
1830 \r
1831   Public Function  Count()\r
1832     Count = UBound(m_Array) + 1\r
1833   End Function\r
1834 \r
1835   Public Sub  Echo()\r
1836     Dim i, e\r
1837     WScript.Echo  "count = " & Count\r
1838     For Each i In m_Array\r
1839       If IsObject( i ) Then\r
1840         WScript.Echo  "Class " & TypeName( i )\r
1841         On Error Resume Next\r
1842           i.Echo\r
1843           e = Err.Number\r
1844         On Error GoTo 0\r
1845         If e <> 0 And e <> 438 Then  Err.Raise e\r
1846       Else\r
1847         WScript.Echo  "each = " & i\r
1848       End If\r
1849     Next\r
1850   End Sub\r
1851 End Class\r
1852 \r
1853 \r
1854  \r
1855 '*-------------------------------------------------------------------------*\r
1856 '* <<<< [ArrayDictionary] Class >>>> */ \r
1857 '*-------------------------------------------------------------------------*\r
1858 \r
1859 class  ArrayDictionary\r
1860 \r
1861   Public  m_Dic\r
1862 \r
1863   Private Sub  Class_Initialize\r
1864     Set  m_Dic = CreateObject("Scripting.Dictionary")\r
1865   End Sub\r
1866 \r
1867   Public Sub  ToEmpty\r
1868     m_Dic.RemoveAll\r
1869   End Sub\r
1870 \r
1871   Public Sub  Add( key, item )\r
1872     Dim  dic_item\r
1873 \r
1874     If m_Dic.Exists( key ) Then\r
1875       m_Dic.Item( key ).Add  item\r
1876     Else\r
1877       Set  dic_item = New ArrayClass\r
1878       dic_item.Add  item\r
1879       m_Dic.Add  key, dic_item\r
1880     End If\r
1881   End Sub\r
1882 \r
1883   Public Function  Count\r
1884     Dim  i\r
1885     Count = 0\r
1886     For Each i in m_Dic.Items()\r
1887       Count = Count + i.Count\r
1888     Next\r
1889   End Function\r
1890 \r
1891   Public Sub  Echo\r
1892     Dim  i, n\r
1893 \r
1894     WScript.Echo  "--- ArrayDictionary ------------------------------"\r
1895     WScript.Echo  "key  count = " & m_Dic.Count\r
1896 \r
1897     WScript.Echo  "item count = " & Count\r
1898 \r
1899     For Each i in m_Dic.Keys()\r
1900       WScript.Echo  "key=""" & i & """"\r
1901       m_Dic.Item(i).Echo\r
1902     Next\r
1903     WScript.Echo ""\r
1904   End Sub\r
1905 \r
1906 End Class\r
1907 \r
1908 \r
1909  \r
1910 '*-------------------------------------------------------------------------*\r
1911 '* \81\9f<<<< \83G\83\89\81[\8f\88\97\9d \81iErr2\81j >>>> \r
1912 '*-------------------------------------------------------------------------*\r
1913 \r
1914 \r
1915  \r
1916 '********************************************************************************\r
1917 '  <<< [Finish] >>> \r
1918 '********************************************************************************\r
1919 Sub  Finish\r
1920   WScript.Quit 9\r
1921 End Sub\r
1922 \r
1923 \r
1924  \r
1925 '********************************************************************************\r
1926 '  <<< [Error] >>> \r
1927 '********************************************************************************\r
1928 Sub  Error\r
1929   Stop\r
1930   WScript.Echo "[ERROR] Unknown"\r
1931   pause2\r
1932   WScript.Quit 1\r
1933 End Sub\r
1934 \r
1935 \r
1936  \r
1937 '********************************************************************************\r
1938 '  <<< [Err2] >>> \r
1939 '********************************************************************************\r
1940 Class Err2\r
1941 \r
1942   Public  Number       ' Err.Number\r
1943   Public  num          ' Err.Number\r
1944   Public  Description  ' Err.Description (Error Message)\r
1945   Public  desc         ' Err.Description (Error Message)\r
1946   Public  Source       ' Err.Source\r
1947   Public  ErrID        ' count of (num <> 0) in each first Copy after Clear\r
1948   Public  RaiseID      ' count of (num <> 0) in Copy\r
1949   Public  BreakErrID   ' as integer\r
1950   Public  BreakRaiseID ' as integer\r
1951 \r
1952   Private Sub Class_Initialize\r
1953     num = 0 : Description = "" : ErrID = 0 : RaiseID = 0\r
1954   End Sub\r
1955 \r
1956   Public Sub OnSuccessFinish\r
1957     If num <> 0 Then  Err.Raise  num, Source, Description\r
1958     If Err.Number <> 0 Then  echo  GetErrStr( Err.Number, Err.Description, Err.Source )\r
1959   End Sub\r
1960 \r
1961   Public Sub Copy( err )\r
1962     Me.Number = err.Number\r
1963     Me.num = err.Number\r
1964     Me.Description = err.Description\r
1965     Me.desc = err.Description\r
1966     Me.Source = err.Source\r
1967     if Me.num <> 0 Then Me.RaiseID = Me.RaiseID + 1 : if Me.RaiseID = 1 Then Me.ErrID = Me.ErrID + 1\r
1968     BreakByID\r
1969   End Sub\r
1970 \r
1971   Public Function Value\r
1972     Value = GetErrStr( num, Description, Source )\r
1973   End Function\r
1974 \r
1975   Public Sub OverRaise( e_num, e_desc )\r
1976     num = e_num\r
1977     Description = e_desc\r
1978     Raise\r
1979   End Sub\r
1980 \r
1981   Public Sub Raise\r
1982     If num = 0 Then\r
1983       Err.Raise 1\r
1984     Else\r
1985       Err.Raise num, Source, Description\r
1986     End If\r
1987   End Sub\r
1988 \r
1989   Public Sub Clear\r
1990     num = 0 : Description = "" : RaiseID = 0\r
1991   End Sub\r
1992 End Class\r
1993 \r
1994 \r
1995  \r
1996 '********************************************************************************\r
1997 '  <<< [Raise] >>> \r
1998 '********************************************************************************\r
1999 Sub  Raise( ErrNum, Description )\r
2000   g_Err2.num = ErrNum\r
2001   g_Err2.Source = ""\r
2002   g_Err2.Description = Description\r
2003   g_Err2.RaiseID = g_Err2.RaiseID + 1 : if g_Err2.RaiseID = 1 Then g_Err2.ErrID = g_Err2.ErrID + 1\r
2004   If g_debug Then  echo  "ErrID = " & g_Err2.ErrID & ", RaiseID = " & g_Err2.RaiseID\r
2005   BreakByID\r
2006   Err.raise  g_Err2.num, g_Err2.Source, g_Err2.Description\r
2007 End Sub\r
2008 \r
2009 \r
2010  \r
2011 '********************************************************************************\r
2012 '  <<< [SetErrBreak] >>> \r
2013 '********************************************************************************\r
2014 Sub  SetErrBreak( ErrID, RaiseID )\r
2015   g_Err2.BreakErrID = ErrID\r
2016   g_Err2.BreakRaiseID = RaiseID\r
2017 End Sub\r
2018 \r
2019 \r
2020  \r
2021 '********************************************************************************\r
2022 '  <<< [BreakByID] >>> \r
2023 '********************************************************************************\r
2024 Sub  BreakByID\r
2025   If g_Err2.ErrID = g_Err2.BreakErrID And  g_Err2.RaiseID >= g_Err2.BreakRaiseID Then\r
2026     echo  "ErrID = " & g_Err2.ErrID & ", RaiseID = " & g_Err2.RaiseID\r
2027     Stop\r
2028   End If\r
2029 End Sub\r
2030 \r
2031 \r
2032  \r
2033 '********************************************************************************\r
2034 '  <<< [NestPos] >>> \r
2035 '********************************************************************************\r
2036 Class NestPos\r
2037   Public  m_HereArr()\r
2038 \r
2039   Private Sub Class_Initialize ' \83R\83\93\83X\83g\83\89\83N\83^\r
2040     Redim  m_HereArr(0)\r
2041     m_HereArr(0) = 0\r
2042   End Sub\r
2043 \r
2044   Public Function  GetPos( arr )\r
2045     Dim  u, i\r
2046     u = UBound( m_HereArr )\r
2047 \r
2048     Redim Preserve  arr(u-1)\r
2049 \r
2050     For i=0 To u-1\r
2051       arr(i) = m_HereArr(i)\r
2052     Next\r
2053   End Function\r
2054 \r
2055   Public Sub  OnBlockStart\r
2056     Dim  u\r
2057     u = UBound( m_HereArr )\r
2058     m_HereArr(u) = m_HereArr(u) + 1\r
2059     Redim Preserve  m_HereArr(u+1)\r
2060     m_HereArr(u+1) = 0\r
2061   End Sub\r
2062 \r
2063   Public Sub  OnBlockEnd\r
2064     Redim Preserve  m_HereArr( UBound( m_HereArr ) - 1 )\r
2065   End Sub\r
2066 End Class\r
2067 \r
2068 \r
2069  \r
2070 '********************************************************************************\r
2071 '  <<< [GetErrStr] >>> \r
2072 '********************************************************************************\r
2073 Function  GetErrStr( en, ed, es )\r
2074   If en = 0 Then\r
2075     GetErrStr = "no error"\r
2076   Else\r
2077     Dim  n\r
2078     If en > 0 And en <= &h7FFF Then n = &h800A0000 + en  Else n = en\r
2079     GetErrStr = "[ERROR] " & Hex(n) & " " & ed & " " & es\r
2080   End If\r
2081 End Function\r
2082 \r
2083 \r
2084  \r
2085 '********************************************************************************\r
2086 '  <<< [TryStart] >>> \r
2087 '********************************************************************************\r
2088 Function TryStart( e )\r
2089   Set e = g_Err2\r
2090   If g_debug Then\r
2091     If e.ErrID >= e.BreakErrID - 1 Then\r
2092       TryStart = False\r
2093     Else\r
2094       TryStart = True\r
2095     End If\r
2096   Else\r
2097     TryStart = True\r
2098   End If\r
2099 End Function\r
2100 \r
2101 \r
2102  \r
2103 '********************************************************************************\r
2104 '  <<< [Trying] >>> \r
2105 '********************************************************************************\r
2106 Function Trying\r
2107   Trying = (Err.Number=0)\r
2108 End Function\r
2109 \r
2110 \r
2111  \r
2112 '********************************************************************************\r
2113 '  <<< [TryEnd] >>> \r
2114 '********************************************************************************\r
2115 Function TryEnd\r
2116 ' Do not have parameters.\r
2117 ' Because "If TryEnd(e) Then On Error Goto 0" cannot get error, if e is not Dim.\r
2118 \r
2119   If Err.Number <> 0 Then  g_Err2.Copy Err\r
2120   If g_debug = 1 Then  TryEnd = False  Else  TryEnd = True\r
2121 End Function\r
2122 \r
2123 \r
2124  \r
2125 '********************************************************************************\r
2126 '  <<< [chk_exist_in_lib] >>> \r
2127 ' comment\r
2128 '  - If there is not path in vbslib folder, raise error of E_FileNotExist.\r
2129 '********************************************************************************\r
2130 Sub  chk_exist_in_lib( ByVal path )\r
2131   If not exist( g_vbslib_folder + path ) Then  Err.Raise  E_FileNotExist,, _\r
2132     "Not found """ + g_vbslib_folder + path + """"\r
2133 End  Sub\r
2134  \r