vbslib/vbslib.vbs

   1 Option Explicit \r
   2 \r
   3 ' vbslib  ver1.00 2008/2/11\r
   4 ' Copyright (c) 2008, T's-Neko\r
   5 ' All rights reserved. 3-clause BSD license.\r
   6 \r
   7 Dim g_fs, g_log, e, g_workfolder\r
   8 \r
   9 Set g_fs = CreateObject("Scripting.FileSystemObject")\r
  10 Set e = new Err2\r
  11 g_workfolder = ""\r
  12 \r
  13 \r
  14  \r
  15 '********************************************************************************\r
  16 '  <<< Error Code >>> \r
  17 '********************************************************************************\r
  18 \r
  19 '         vbObjectError = &h80040000\r
  20 Const E_AssertFail      = &h80041001\r
  21 Const E_FileNotExist    = 2\r
  22 Const E_TestFail        = &h80041003\r
  23 Const E_BuildFail       = &h80041004\r
  24 Const E_OutOfWorkFolder = &h80041005\r
  25 Const E_ProgTerminated  = &hC0000005\r
  26 Const E_NotFoundSymbol  = &h80041006\r
  27 Const E_ProgRetNotZero  = &h80041007\r
  28  \r
  29 '********************************************************************************\r
  30 '  <<< File Object >>> \r
  31 '********************************************************************************\r
  32 \r
  33 Const ReadOnly  = 1\r
  34 \r
  35 \r
  36  \r
  37 '********************************************************************************\r
  38 '  <<< [ChgToCommandPrompt] If VBS file was double clicked, Run a command prompt >>> \r
  39 '********************************************************************************\r
  40 Sub ChgToCommandPrompt\r
  41   If LCase( Right( WScript.FullName, 11 ) ) = "wscript.exe" Then\r
  42     Dim cmd\r
  43     cmd = "cscript.exe " & Chr(34) & WScript.ScriptFullName & Chr(34)\r
  44     WScript.Quit CreateObject("WScript.Shell").Run( cmd, 1, True )\r
  45   End If\r
  46 End Sub\r
  47 \r
  48 \r
  49  \r
  50 '********************************************************************************\r
  51 '  <<< [input] >>> \r
  52 '********************************************************************************\r
  53 Function  input( ByVal msg )\r
  54   Dim e\r
  55 \r
  56   Wscript.StdOut.Write  msg\r
  57 \r
  58   On Error Resume Next\r
  59 \r
  60   input = Wscript.StdIn.ReadLine\r
  61 \r
  62   e = Err.Number : Err.Clear : On Error GoTo 0\r
  63   If e <> 0 Then\r
  64     If e <> 62 Then Err.Raise e  '62= End Of File (StdIn, ^C)\r
  65     WScript.Quit 1\r
  66   End If\r
  67 \r
  68 End Function\r
  69 \r
  70  \r
  71 '********************************************************************************\r
  72 '  <<< [pause] >>> \r
  73 '********************************************************************************\r
  74 Sub  pause()\r
  75   input "\91±\8ds\82·\82é\82É\82Í Enter \83L\81[\82ð\89\9f\82µ\82Ä\82\82¾\82³\82¢ . . ."\r
  76 End Sub\r
  77 \r
  78 \r
  79  \r
  80 '********************************************************************************\r
  81 '  <<< [echo] >>> \r
  82 '********************************************************************************\r
  83 Sub  echo( ByVal msg )\r
  84   WScript.Echo msg\r
  85   If Not IsEmpty( g_log ) Then  g_log.WriteLine msg\r
  86 End Sub\r
  87 \r
  88  \r
  89 '********************************************************************************\r
  90 '  <<< [cd] change current directory >>> \r
  91 ' sample\r
  92 '   cd "sub"\r
  93 '********************************************************************************\r
  94 Sub  cd( ByVal dir )\r
  95   Dim  sh\r
  96 \r
  97   Set sh = WScript.CreateObject("WScript.Shell")\r
  98   sh.CurrentDirectory = dir\r
  99 \r
 100 End Sub\r
 101 \r
 102 \r
 103  \r
 104 '********************************************************************************\r
 105 '  <<< [pushd] push and change current directory >>> \r
 106 ' sample\r
 107 '   pushd "sub"\r
 108 '********************************************************************************\r
 109 Dim  g_pushd_stack()\r
 110 Dim  g_pushd_stack_n\r
 111 \r
 112 Sub  pushd( ByVal dir )\r
 113   Dim  sh\r
 114 \r
 115   g_pushd_stack_n = g_pushd_stack_n + 1\r
 116   Redim Preserve  g_pushd_stack( g_pushd_stack_n )\r
 117 \r
 118   Set sh = WScript.CreateObject("WScript.Shell")\r
 119   g_pushd_stack( g_pushd_stack_n ) = sh.CurrentDirectory\r
 120   sh.CurrentDirectory = dir\r
 121 \r
 122 End Sub\r
 123 \r
 124 \r
 125  \r
 126 '********************************************************************************\r
 127 '  <<< [popd] pop current directory >>> \r
 128 '********************************************************************************\r
 129 Sub  popd\r
 130   Dim  sh\r
 131 \r
 132   If g_pushd_stack_n < 1 Then Exit Sub\r
 133 \r
 134   Set sh = WScript.CreateObject("WScript.Shell")\r
 135   sh.CurrentDirectory = g_pushd_stack( g_pushd_stack_n )\r
 136 \r
 137   g_pushd_stack_n = g_pushd_stack_n - 1\r
 138 \r
 139 End Sub\r
 140 \r
 141 \r
 142  \r
 143 '********************************************************************************\r
 144 '  <<< [set_workfolder] Set modifiable base folder path >>> \r
 145 ' comment\r
 146 '  - if work path set current directory, path = ""\r
 147 '********************************************************************************\r
 148 Sub  set_workfolder( ByVal path )\r
 149   If path = "" Then\r
 150     g_workfolder = ""\r
 151   Else\r
 152     chk_exist  path\r
 153     g_workfolder = g_fs.GetAbsolutePathName( path )\r
 154   End If\r
 155 End Sub\r
 156 \r
 157  \r
 158 '********************************************************************************\r
 159 '  <<< [copy] >>> \r
 160 ' argument\r
 161 '  - src : source file or folder path or wild card\r
 162 '  - dst : destination folder path or renaming file path\r
 163 ' comment\r
 164 '  - reference: vbslib.svg#copy\r
 165 '********************************************************************************\r
 166 Sub  copy( ByVal src, ByVal dst )\r
 167 \r
 168   If g_fs.FolderExists( dst ) Then\r
 169     chk_in_workfolder  g_fs.BuildPath( dst, "a" )\r
 170   Else\r
 171     chk_in_workfolder  dst\r
 172   End If\r
 173 \r
 174 \r
 175   ' If src had Wild card\r
 176   If IsWildcard( src ) Then\r
 177 \r
 178     Dim  fo\r
 179 \r
 180     If Not g_fs.FolderExists( dst ) Then  mkdir dst\r
 181 \r
 182     g_fs.CopyFile  src, dst, True\r
 183     g_fs.CopyFolder  src, dst, True\r
 184 \r
 185 \r
 186   ' If src is file\r
 187   ElseIf g_fs.FileExists( src ) Then\r
 188 \r
 189     Dim  dst_fo\r
 190 \r
 191     If g_fs.FolderExists( dst ) Then\r
 192       dst = g_fs.BuildPath( dst, g_fs.GetFileName( src ) )\r
 193     Else\r
 194       dst_fo = g_fs.GetParentFolderName( dst )\r
 195       If Not g_fs.FolderExists( dst_fo ) Then  mkdir  dst_fo\r
 196     End If\r
 197 \r
 198     g_fs.CopyFile  src, dst, True\r
 199 \r
 200 \r
 201   ' If src is folder\r
 202   ElseIf g_fs.FolderExists( src ) Then\r
 203 \r
 204     If Not g_fs.FolderExists( dst ) Then  mkdir  dst\r
 205 \r
 206     g_fs.CopyFolder src, g_fs.BuildPath( dst, g_fs.GetFileName( src ) ), True\r
 207 \r
 208 \r
 209   ' not found\r
 210   Else\r
 211     g_fs.CopyFile  src, dst, True  ' Error occurs\r
 212 \r
 213   End If\r
 214 End Sub\r
 215 \r
 216 \r
 217  \r
 218 '********************************************************************************\r
 219 '  <<< [move] >>> \r
 220 '********************************************************************************\r
 221 Sub  move( ByVal src, ByVal dst )\r
 222 \r
 223   If g_fs.FolderExists( dst ) Then\r
 224     chk_in_workfolder  g_fs.BuildPath( dst, "a" )\r
 225   Else\r
 226     chk_in_workfolder  dst\r
 227   End If\r
 228 \r
 229 \r
 230   ' If src had Wild card\r
 231   If IsWildcard( src ) Then\r
 232 \r
 233     Dim  fo\r
 234 \r
 235     If Not g_fs.FolderExists( dst ) Then  mkdir dst\r
 236 \r
 237     g_fs.MoveFile  src, dst\r
 238     g_fs.MoveFolder  src, dst\r
 239 \r
 240 \r
 241   ' If src is file\r
 242   ElseIf g_fs.FileExists( src ) Then\r
 243 \r
 244     Dim  dst_fo\r
 245 \r
 246     If g_fs.FolderExists( dst ) Then\r
 247       dst = g_fs.BuildPath( dst, g_fs.GetFileName( src ) )\r
 248     Else\r
 249       dst_fo = g_fs.GetParentFolderName( dst )\r
 250       If Not g_fs.FolderExists( dst_fo ) Then  mkdir  dst_fo\r
 251     End If\r
 252 \r
 253     g_fs.MoveFile  src, dst\r
 254 \r
 255 \r
 256   ' If src is folder\r
 257   ElseIf g_fs.FolderExists( src ) Then\r
 258 \r
 259     If Not g_fs.FolderExists( dst ) Then  mkdir  dst\r
 260 \r
 261     g_fs.MoveFolder src, g_fs.BuildPath( dst, g_fs.GetFileName( src ) )\r
 262 \r
 263 \r
 264   ' not found\r
 265   Else\r
 266     g_fs.MoveFile  src, dst  ' Error occurs\r
 267 \r
 268   End If\r
 269 End Sub\r
 270 \r
 271 \r
 272  \r
 273 '********************************************************************************\r
 274 '  <<< [exist] >>> \r
 275 '********************************************************************************\r
 276 Function  exist( ByVal path )\r
 277   If IsWildcard( path ) Then\r
 278     Dim  folder, fnames()\r
 279     ExpandWildcard  folder, fnames, path\r
 280     exist = Array_count( fnames ) <> 0\r
 281   Else\r
 282     exist = ( g_fs.FileExists( path ) = True ) Or ( g_fs.FolderExists( path ) = True )\r
 283   End If\r
 284 End Function\r
 285  \r
 286 '********************************************************************************\r
 287 '  <<< [chk_exist] >>> \r
 288 '********************************************************************************\r
 289 Sub  chk_exist( ByVal path )\r
 290   If Not exist( path ) Then  raise E_FileNotExist, path & " not found"\r
 291 End Sub\r
 292  \r
 293 '********************************************************************************\r
 294 '  <<< [chk_in_workfolder] Check not to modify out of working folder >>> \r
 295 ' comment\r
 296 '  - If path is out of workfolder, raise error of E_OutOfWorkFolder.\r
 297 '********************************************************************************\r
 298 Sub  chk_in_workfolder( ByVal path )\r
 299   Dim  sh, work\r
 300 \r
 301   If g_workfolder = "" Then\r
 302     Set sh = WScript.CreateObject("WScript.Shell")\r
 303     work = sh.CurrentDirectory\r
 304     sh = Empty\r
 305   Else\r
 306     work = g_workfolder\r
 307   End If\r
 308   work = g_fs.BuildPath( work, "a" )\r
 309   work = Left( work, Len(work) - 1 )\r
 310 \r
 311   path = g_fs.GetAbsolutePathName( path )\r
 312 \r
 313   If work <> Left( path, Len( work ) ) Then\r
 314     raise E_OutOfWorkFolder, path & " is out of working folder"\r
 315   End If\r
 316 \r
 317 End Sub\r
 318 \r
 319  \r
 320 '********************************************************************************\r
 321 '  <<< [fc] diff text file >>> \r
 322 ' argument\r
 323 '  - return : True=same, False=different\r
 324 '********************************************************************************\r
 325 Function  fc( ByVal pathA, ByVal pathB )\r
 326 \r
 327   ' File Compare\r
 328   If g_fs.FileExists( pathA ) Then\r
 329 \r
 330     Dim  sh, r\r
 331     If Not g_fs.FileExists( pathB ) Then  fc=False : Exit Function\r
 332 \r
 333     Set sh = WScript.CreateObject("WScript.Shell")\r
 334     r = sh.Run( "fc.exe """ + pathA + """ """ + pathB + """", 7, True )\r
 335     If r = E_ProgTerminated Then  raise E_ProgTerminated, "Program Terminated"\r
 336     fc = ( r = 0 )\r
 337 \r
 338 \r
 339   ' Folder Compare\r
 340   ElseIf g_fs.FolderExists( pathA ) Then\r
 341 \r
 342     Dim  foldersA, foldersB, folderA, folderB, foA, foB, step, f\r
 343     If Not g_fs.FolderExists( pathB ) Then  fc=False : Exit Function\r
 344 \r
 345     pathA = g_fs.GetAbsolutePathName( pathA )\r
 346     pathB = g_fs.GetAbsolutePathName( pathB )\r
 347     GetSubFolders  foldersA, pathA\r
 348     GetSubFolders  foldersB, pathB\r
 349 \r
 350     If Array_count( foldersA ) <> Array_count( foldersB ) Then  fc=False : Exit Function\r
 351 \r
 352     For Each folderA In foldersA\r
 353       step = Mid( folderA, Len( pathA ) + 1 )\r
 354       If step = "" Then\r
 355         folderB = pathB\r
 356       Else\r
 357         folderB = g_fs.BuildPath( pathB, step )\r
 358       End If\r
 359 \r
 360       Set foA = g_fs.GetFolder( folderA )\r
 361       Set foB = g_fs.GetFolder( folderB )\r
 362 \r
 363       If foA.Files.Count <> foB.Files.Count Then  fc=False : Exit Function\r
 364       For Each f In foA.Files\r
 365         If Not fc( f.Path, folderB + Mid( f.Path, Len( folderA ) + 1 ) ) Then\r
 366           fc=False : Exit Function\r
 367         End If\r
 368       Next\r
 369     Next\r
 370 \r
 371     fc = True\r
 372   Else\r
 373     fc = False : Exit Function\r
 374   End If\r
 375 End Function\r
 376 \r
 377 \r
 378 \r
 379  \r
 380 '********************************************************************************\r
 381 '  <<< [find] find lines including keyword >>> \r
 382 '********************************************************************************\r
 383 Function  find( ByVal keyword, ByVal path )\r
 384   Dim  f, line, ret\r
 385   Set  f = g_fs.OpenTextFile( path )\r
 386 \r
 387   ret = ""\r
 388   Do Until f.AtEndOfStream\r
 389     line = f.ReadLine\r
 390     If InStr( line, keyword ) > 0 Then  ret = ret + line\r
 391   Loop\r
 392 \r
 393   f.Close\r
 394 \r
 395   find = ret\r
 396 End Function\r
 397 \r
 398 \r
 399  \r
 400 '********************************************************************************\r
 401 '  <<< [find_c] find lines count including keyword >>> \r
 402 '********************************************************************************\r
 403 Function  find_c( ByVal keyword, ByVal path )\r
 404   Dim  f, line, ret\r
 405   Set  f = g_fs.OpenTextFile( path )\r
 406 \r
 407   ret = 0\r
 408   Do Until f.AtEndOfStream\r
 409     line = f.ReadLine\r
 410     If InStr( line, keyword ) > 0 Then  ret = ret + 1\r
 411   Loop\r
 412 \r
 413   f.Close\r
 414 \r
 415   find_c = ret\r
 416 End Function\r
 417 \r
 418 \r
 419  \r
 420 '********************************************************************************\r
 421 '  <<< [del] >>> \r
 422 '********************************************************************************\r
 423 Sub  del( ByVal path )\r
 424 \r
 425   ' If path had Wild card\r
 426   If IsWildCard( path ) Then\r
 427     Dim  folder, fname, fnames()\r
 428 \r
 429     ExpandWildcard  folder, fnames, path\r
 430     For Each fname in fnames\r
 431       del  g_fs.BuildPath( folder, fname )\r
 432     Next\r
 433 \r
 434   ' If path was file or folder path\r
 435   Else\r
 436 \r
 437     If g_fs.FileExists( path ) Then\r
 438       chk_in_workfolder  path\r
 439       g_fs.DeleteFile  path\r
 440     ElseIf g_fs.FolderExists( path ) Then\r
 441       rmdir  path\r
 442     End If\r
 443   End If\r
 444 \r
 445 End Sub\r
 446 \r
 447 \r
 448  \r
 449 '********************************************************************************\r
 450 '  <<< [mkdir] >>> \r
 451 ' argument\r
 452 '  - return : count of made folder\r
 453 ' comment\r
 454 '  - This is able to make nested folder.\r
 455 '********************************************************************************\r
 456 Function  mkdir( ByVal fo )\r
 457   Dim  i, n, names(), fo2\r
 458 \r
 459   chk_in_workfolder  fo\r
 460 \r
 461   n = 0\r
 462   fo2 = g_fs.GetAbsolutePathName( fo )\r
 463   Do\r
 464     If g_fs.FolderExists( fo2 ) Then Exit Do\r
 465 \r
 466     n = n + 1\r
 467     Redim Preserve  names(n)\r
 468     names(n) = g_fs.GetFileName( fo2 )\r
 469     fo2 = g_fs.GetParentFolderName( fo2 )\r
 470   Loop\r
 471 \r
 472   mkdir = n\r
 473 \r
 474   For n=n To 1 Step -1\r
 475     fo2 = g_fs.BuildPath( fo2, names(n) )\r
 476     g_fs.CreateFolder  fo2\r
 477   Next\r
 478 \r
 479 End Function\r
 480  \r
 481 '********************************************************************************\r
 482 '  <<< [rmdir] >>> \r
 483 '********************************************************************************\r
 484 Sub  rmdir( ByVal path )\r
 485   Dim  path2, iFolder, nFolder, fo, subf, f, file\r
 486 \r
 487   If Not g_fs.FolderExists( path ) Then Exit Sub\r
 488 \r
 489   chk_in_workfolder  path\r
 490 \r
 491 \r
 492   ' Cut last \\r
 493   path2 = path\r
 494   If Right( path2, 1 ) = "\" Then  path2 = Left( path2, Len( path2 ) - 1 )\r
 495 \r
 496   nFolder = 1\r
 497   ReDim folderPathes(nFolder)\r
 498   folderPathes(nFolder) = path2\r
 499 \r
 500   ' Enum sub folders\r
 501   iFolder = 1\r
 502   While iFolder <= nFolder\r
 503     Set fo = g_fs.GetFolder( folderPathes(iFolder) )\r
 504     For Each subf in fo.SubFolders\r
 505       nFolder = nFolder + 1\r
 506       ReDim Preserve folderPathes(nFolder)\r
 507       folderPathes(nFolder) = subf.Path\r
 508     Next\r
 509     iFolder = iFolder + 1\r
 510   WEnd\r
 511 \r
 512   ' Remove read only attribute of all files in sub folders\r
 513   For iFolder = 1 To nFolder\r
 514     Set fo = g_fs.GetFolder( folderPathes(iFolder) )\r
 515     For Each f in fo.Files\r
 516       Set file = g_fs.GetFile( f.Path )\r
 517       file.Attributes = file.Attributes And Not ReadOnly\r
 518     Next\r
 519   Next\r
 520 \r
 521   ' Delete folders\r
 522   g_fs.DeleteFolder( path )\r
 523 End Sub\r
 524  \r
 525 '********************************************************************************\r
 526 '  <<< [GetSubFolders] >>> \r
 527 ' argument\r
 528 '  - folders : (out) array of folder pathes\r
 529 '  - path : base folder path\r
 530 '********************************************************************************\r
 531 Sub  GetSubFolders( folders, ByVal path )\r
 532   Array_toEmpty  folders\r
 533   EnumSubFolders  folders, g_fs.GetFolder( path )\r
 534 End Sub\r
 535 \r
 536 Sub  EnumSubFolders( folders, fo )\r
 537   Dim  subfo\r
 538 \r
 539   Array_push  folders, fo.Path\r
 540 \r
 541   For Each subfo in fo.SubFolders\r
 542     EnumSubFolders  folders, subfo\r
 543   Next\r
 544 End Sub\r
 545  \r
 546 '********************************************************************************\r
 547 '  <<< [IsWildcard] >>> \r
 548 '********************************************************************************\r
 549 Function  IsWildcard( ByVal path )\r
 550   IsWildcard = InStr( path, "?" ) <> 0 Or InStr( path, "*" ) <> 0\r
 551 End Function\r
 552 \r
 553 \r
 554  \r
 555 '********************************************************************************\r
 556 '  <<< [ExpandWildcard] >>> \r
 557 '********************************************************************************\r
 558 Sub  ExpandWildcard( folder, fnames, ByVal wildcard )\r
 559   Dim  s, re, fo, f\r
 560 \r
 561   folder = g_fs.GetParentFolderName( g_fs.GetAbsolutePathName( wildcard ) )\r
 562 \r
 563   Set re = CreateObject("VBScript.RegExp")\r
 564   re.Global = True\r
 565   s = g_fs.GetFileName( wildcard )\r
 566   re.Pattern = "\\" :  s = re.Replace( s, "\\" )\r
 567   re.Pattern = "\." :  s = re.Replace( s, "\." )\r
 568   re.Pattern = "\$" :  s = re.Replace( s, "\$" )\r
 569   re.Pattern = "\^" :  s = re.Replace( s, "\^" )\r
 570   re.Pattern = "\{" :  s = re.Replace( s, "\{" )\r
 571   re.Pattern = "\}" :  s = re.Replace( s, "\}" )\r
 572   re.Pattern = "\[" :  s = re.Replace( s, "\[" )\r
 573   re.Pattern = "\]" :  s = re.Replace( s, "\]" )\r
 574   re.Pattern = "\(" :  s = re.Replace( s, "\(" )\r
 575   re.Pattern = "\)" :  s = re.Replace( s, "\)" )\r
 576   re.Pattern = "\|" :  s = re.Replace( s, "\|" )\r
 577   re.Pattern = "\+" :  s = re.Replace( s, "\+" )\r
 578   re.Pattern = "\*" :  s = re.Replace( s, ".*" )\r
 579   re.Pattern = "\?" :  s = re.Replace( s, "." )\r
 580 \r
 581   re.Pattern = s\r
 582   re.Global = False\r
 583   Array_toEmpty  fnames\r
 584   Set fo = g_fs.GetFolder( folder )\r
 585   For Each f in fo.Files\r
 586     If re.Test( f.Name )  Then  Array_push  fnames, f.Name\r
 587   Next\r
 588   For Each f in fo.SubFolders\r
 589     If re.Test( f.Name )  Then  Array_push  fnames, f.Name\r
 590   Next\r
 591 End Sub\r
 592 \r
 593  \r
 594 '********************************************************************************\r
 595 '  <<< [start] >>> \r
 596 '********************************************************************************\r
 597 Sub  start( ByVal cmdline )\r
 598   Dim  sh\r
 599 \r
 600   Set sh = WScript.CreateObject("WScript.Shell")\r
 601   sh.Run cmdline, 1, False\r
 602 \r
 603 End Sub\r
 604 \r
 605 \r
 606 \r
 607  \r
 608 '********************************************************************************\r
 609 '  <<< [call_exe] >>> \r
 610 ' comment\r
 611 '   - It is possible to call .bat file.\r
 612 '   - cmdline is able to have environment variable.\r
 613 '     ex) call_exe """%ProgramFiles%\Movie Maker\moviemk.exe"""\r
 614 '********************************************************************************\r
 615 Function  call_exe( ByVal cmdline )\r
 616   Dim  sh, r\r
 617 \r
 618   Set sh = WScript.CreateObject("WScript.Shell")\r
 619 \r
 620   cmdline = sh.ExpandEnvironmentStrings( cmdline )\r
 621   r = sh.Run( cmdline, 1, True )\r
 622 \r
 623   If r = E_ProgTerminated Then  raise E_ProgTerminated, "Program Terminated"\r
 624 \r
 625   call_exe = r\r
 626 End Function\r
 627 \r
 628 \r
 629 \r
 630  \r
 631 '********************************************************************************\r
 632 '  <<< [call_exe_r] redirect >>> \r
 633 '********************************************************************************\r
 634 Function  call_exe_r( ByVal cmdline, ByVal inpath, ByVal outpath, ByVal errpath )\r
 635   Dim  sh, ex, r, f, prev_txt\r
 636 \r
 637   If inpath <> "" Then  raise E_AssertFail, "Not supported"\r
 638 \r
 639   Set sh = WScript.CreateObject( "WScript.Shell" )\r
 640   cmdline = sh.ExpandEnvironmentStrings( cmdline )\r
 641 \r
 642   Set ex = sh.Exec( cmdline )\r
 643   Do While ex.Status = 0\r
 644     WScript.Sleep 100\r
 645   Loop\r
 646 \r
 647   If outpath <> "" Then\r
 648 \r
 649     prev_txt = ""\r
 650     If g_fs.FileExists( outpath ) Then\r
 651       Set f = g_fs.OpenTextFile( outpath, 1 )\r
 652       On Error Resume Next\r
 653         prev_txt = f.ReadAll\r
 654       e.Copy( Err ) : On Error GoTo 0 : If e.num <> 0 Then\r
 655         If e.num <> &h3E Then  e.Raise\r
 656         e.Clear\r
 657       End If\r
 658       f.Close\r
 659     End If\r
 660     Set f = g_fs.CreateTextFile( outpath, True, False )\r
 661     f.Write  prev_txt\r
 662     Do Until ex.StdOut.AtEndOfStream\r
 663       f.WriteLine ex.StdOut.ReadLine\r
 664     Loop\r
 665 \r
 666     If outpath <> errpath Then\r
 667       f.Close\r
 668 \r
 669       prev_txt = ""\r
 670       If g_fs.FileExists( errpath ) Then\r
 671         Set f = g_fs.OpenTextFile( errpath, 1 )\r
 672         On Error Resume Next\r
 673           prev_txt = f.ReadAll\r
 674         e.Copy( Err ) : On Error GoTo 0 : If e.num <> 0 Then\r
 675           If e.num <> &h3E Then  e.Raise\r
 676           e.Clear\r
 677         End If\r
 678         f.Close\r
 679       End If\r
 680 \r
 681       Set f = g_fs.CreateTextFile( errpath, True, False )\r
 682     End If\r
 683     Do Until ex.StdErr.AtEndOfStream\r
 684       f.WriteLine ex.StdErr.ReadLine\r
 685     Loop\r
 686     f.Close\r
 687   End If\r
 688 \r
 689   call_exe_r = ex.ExitCode\r
 690   ex = Empty\r
 691 End Function\r
 692  \r
 693 '********************************************************************************\r
 694 '  <<< [call_vbs] >>> \r
 695 '   - path is able to have environment variable.\r
 696 '     ex) """%ProgramFiles%\Movie Maker\moviemk.exe"""\r
 697 '********************************************************************************\r
 698 Function  call_vbs( ByVal path, ByVal func, ByVal param )\r
 699   Dim sh, oldDir, f, funcX, in_call\r
 700 \r
 701   in_call = False\r
 702   Set sh = WScript.CreateObject("WScript.Shell")\r
 703   oldDir = sh.CurrentDirectory\r
 704 \r
 705   path = sh.ExpandEnvironmentStrings( path )\r
 706   path = g_fs.GetAbsolutePathName( path )\r
 707   chk_exist path\r
 708 \r
 709   On Error Resume Next  'try\r
 710 \r
 711     sh.CurrentDirectory = g_fs.GetParentFolderName( path )\r
 712 \r
 713     If Err=0 Then  Set f = g_fs.OpenTextFile( g_fs.GetFileName( path ) ) : ExecuteGlobal f.ReadAll()\r
 714     If Err=&h411 Then  Err.Clear  ' Symbol Overrided\r
 715     If Err=0 Then  Set funcX = GetRef( func )\r
 716     If Err=0 Then  in_call = True : call_vbs = funcX( param )\r
 717     If Err=0 Then  in_call = False\r
 718 \r
 719   e.Copy( Err ) : On Error GoTo 0 : If e.num <> 0 Then  'catch\r
 720     If in_call Then\r
 721       e.Source = func + " in " + path\r
 722       If path=WScript.ScriptFullName Then\r
 723         echo "If you want to debug, Call directory " + func + " before On Error Resume Next."\r
 724       Else\r
 725         echo "If you want to debug, Start "+g_fs.GetFileName(path)+" directly."\r
 726       End If\r
 727     End If\r
 728     If e.num = 5 Then  raise  E_NotFoundSymbol, "Not found func name '" + func + "' in " + path\r
 729     e.Raise\r
 730   End If  'finally\r
 731 \r
 732     f.Close\r
 733     sh.CurrentDirectory = oldDir\r
 734 \r
 735   If e.num <> 0 Then  e.Raise\r
 736 End Function\r
 737 \r
 738 \r
 739 \r
 740  \r
 741 '********************************************************************************\r
 742 '  <<< [call_vbs_exe] >>> \r
 743 '   - path is able to have environment variable.\r
 744 '     ex) """%ProgramFiles%\Movie Maker\moviemk.exe"""\r
 745 '   - This function craetes new process.\r
 746 '********************************************************************************\r
 747 Function  call_vbs_exe( ByVal path )\r
 748   Dim sh, oldDir, f, funcX, ex, log_bk_path, t, param\r
 749 \r
 750   Set sh = WScript.CreateObject("WScript.Shell")\r
 751 \r
 752 \r
 753   ' Nest test_log.txt\r
 754   If Not IsEmpty( g_log ) Then\r
 755     g_log.Close\r
 756     g_log = Empty\r
 757 \r
 758     log_bk_path = "test_log_bk.txt"\r
 759     Set f = g_fs.GetFile( Test_DefLogFName )\r
 760     If exist( log_bk_path ) Then  g_fs.DeleteFile  log_bk_path\r
 761     f.Name = log_bk_path\r
 762     f = Empty\r
 763   Else\r
 764     log_bk_path = ""\r
 765   End If\r
 766 \r
 767 \r
 768   ' Change current directory\r
 769   oldDir = sh.CurrentDirectory\r
 770 \r
 771   path = sh.ExpandEnvironmentStrings( path )\r
 772   path = g_fs.GetAbsolutePathName( path )\r
 773   chk_exist path\r
 774 \r
 775   sh.CurrentDirectory = g_fs.GetParentFolderName( path )\r
 776 \r
 777 \r
 778   ' Execute\r
 779   If log_bk_path <> "" Then param = " //nologo -sub_test" Else param = "" End If\r
 780   Set ex = sh.Exec( "CScript """ + path + """" + param )\r
 781 \r
 782   Do While ex.Status = 0\r
 783     WScript.Sleep 100\r
 784   Loop\r
 785 \r
 786   Do Until ex.StdOut.AtEndOfStream\r
 787     echo ex.StdOut.ReadLine\r
 788   Loop\r
 789 \r
 790 \r
 791   ' Return current directory\r
 792   sh.CurrentDirectory = oldDir\r
 793 \r
 794 \r
 795   ' Un-nest test_log.txt\r
 796   If log_bk_path <> "" Then\r
 797     If g_fs.FileExists( Test_DefLogFName ) Then\r
 798       Set f = g_fs.OpenTextFile( log_bk_path, 1 )\r
 799       t = f.ReadAll\r
 800       f.Close\r
 801     Else\r
 802       t = ""\r
 803     End If\r
 804 \r
 805     Set f = g_fs.OpenTextFile( Test_DefLogFName, 1 )\r
 806     t = t + f.ReadAll\r
 807     f.Close\r
 808     f = Empty\r
 809 \r
 810     Set g_log = g_fs.CreateTextFile( Test_DefLogFName, 1 )\r
 811     g_log.Write  t\r
 812 \r
 813     g_fs.DeleteFile  log_bk_path\r
 814   End If\r
 815 \r
 816 \r
 817   ' Get and raise error level\r
 818   If ex.ExitCode <> 0 Then\r
 819     raise E_ProgRetNotZero, CStr( ex.ExitCode )\r
 820   End If\r
 821 End Function\r
 822 \r
 823 \r
 824 \r
 825  \r
 826 '********************************************************************************\r
 827 '  <<< [include] >>> \r
 828 '********************************************************************************\r
 829 Sub  include( ByVal path )\r
 830   Dim sh, f\r
 831 \r
 832   Set sh = WScript.CreateObject("WScript.Shell")\r
 833 \r
 834   path = sh.ExpandEnvironmentStrings( path )\r
 835   chk_exist path\r
 836 \r
 837   On Error Resume Next\r
 838 \r
 839     If Err=0 Then  Set f = g_fs.OpenTextFile( g_fs.GetFileName( path ) ) : ExecuteGlobal f.ReadAll()\r
 840     If Err=&h411 Then  Err.Clear  ' Symbol Overrided\r
 841 \r
 842   e.Copy( Err ) : On Error GoTo 0\r
 843   If e.num=&h400 Or e.num=&h3EA Then e.Description = e.Description + " " + path  ' No Statement\r
 844   If e.num <> 0 Then  e.Raise\r
 845 End Sub\r
 846  \r
 847 '********************************************************************************\r
 848 '  <<< [env] Expand environment strings >>> \r
 849 '********************************************************************************\r
 850 Function  env( ByVal s )\r
 851   Set sh = WScript.CreateObject("WScript.Shell")\r
 852 \r
 853   env = sh.ExpandEnvironmentStrings( s )\r
 854 End Function\r
 855 \r
 856 \r
 857  \r
 858 '********************************************************************************\r
 859 '  <<< [devenv] Visual Studio 2005 command line build >>> \r
 860 ' sample\r
 861 '   pushd "src"\r
 862 '   devenv "sample.sln /rebuild", "Release"\r
 863 '   popd\r
 864 '********************************************************************************\r
 865 Sub  devenv( ByVal param, ByVal config )\r
 866   Dim sh, r, cmdline\r
 867   Set sh = WScript.CreateObject("WScript.Shell")\r
 868 \r
 869   cmdline = Chr(34) + sh.RegRead( "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\VisualStudio\8.0\"+_\r
 870             "InstallDir" ) + "devenv.exe" + Chr(34) +_\r
 871             " " + param + " " + Chr(34) + config + Chr(34)\r
 872   r = call_exe( cmdline )\r
 873 \r
 874   If r <> 0 Then  raise E_BuildFail, "devenv failed " + param + " in " + sh.CurrentDirectory\r
 875 End Sub\r
 876 \r
 877 \r
 878  \r
 879 '********************************************************************************\r
 880 '  <<< [devenv_clean] Visual Studio 2005 clean >>> \r
 881 ' sample\r
 882 '   pushd "src"\r
 883 '   devenv_clean "sample.sln"\r
 884 '   popd\r
 885 '********************************************************************************\r
 886 Sub  devenv_clean( ByVal sln )\r
 887   devenv sln+" /clean", "Release"\r
 888   del "Release"\r
 889   devenv sln+" /clean", "Debug"\r
 890   del "Debug"\r
 891   del "*.ncb"\r
 892   del "*.suo"\r
 893   del "*.user"\r
 894 End Sub\r
 895  \r
 896 '********************************************************************************\r
 897 '  <<< [SendKeys] Send keyboard code stroke to OS >>> \r
 898 '********************************************************************************\r
 899 Sub  SendKeys( ByVal window_title, ByVal keycords, ByVal late_time )\r
 900   Dim  sh\r
 901   Set  sh = WScript.CreateObject("WScript.Shell")\r
 902 \r
 903   WScript.Sleep late_time\r
 904   sh.AppActivate( window_title )\r
 905   WScript.Sleep 100\r
 906   sh.SendKeys keycords\r
 907 End Sub\r
 908 \r
 909 \r
 910 \r
 911  \r
 912 '********************************************************************************\r
 913 '  <<< [Sleep] >>> \r
 914 '********************************************************************************\r
 915 Sub  Sleep( ByVal msec )\r
 916   Dim  sh\r
 917   Set  sh = WScript.CreateObject("WScript.Shell")\r
 918 \r
 919   WScript.Sleep msec\r
 920 End Sub\r
 921 \r
 922 \r
 923 \r
 924  \r
 925 '********************************************************************************\r
 926 '  <<< [WaitForFile] Wait for make the file >>> \r
 927 '********************************************************************************\r
 928 Sub  WaitForFile( ByVal path )\r
 929   While g_fs.FileExists( path ) = False\r
 930     WScript.Sleep 1000\r
 931   Wend\r
 932 End Sub\r
 933 \r
 934 \r
 935 \r
 936  \r
 937 '********************************************************************************\r
 938 '  <<< [CreateFile] Create 1 line text file >>> \r
 939 '********************************************************************************\r
 940 Sub  CreateFile( ByVal path, ByVal text )\r
 941   Dim  t, folder\r
 942 \r
 943   chk_in_workfolder  path\r
 944 \r
 945   path = g_fs.GetAbsolutePathName( path )\r
 946   folder = g_fs.GetParentFolderName( path )\r
 947   mkdir  folder\r
 948 \r
 949   Set t = g_fs.CreateTextFile( path, True, False )\r
 950   t.WriteLine text\r
 951   t.Close\r
 952 End Sub\r
 953 \r
 954 \r
 955  \r
 956 '********************************************************************************\r
 957 '  <<< [Array_toEmpty] >>> \r
 958 '********************************************************************************\r
 959 Sub  Array_toEmpty( arr )\r
 960   ReDim  arr( -1 )\r
 961 End Sub\r
 962  \r
 963 '********************************************************************************\r
 964 '  <<< [Array_push] >>> \r
 965 '********************************************************************************\r
 966 Sub  Array_push( arr, item )\r
 967   ReDim Preserve  arr( UBound(arr) + 1 )\r
 968   arr( UBound(arr) ) = item\r
 969 End Sub\r
 970  \r
 971 '********************************************************************************\r
 972 '  <<< [Array_pop] >>> \r
 973 '********************************************************************************\r
 974 Function  Array_pop( arr )\r
 975   Array_pop = arr( UBound(arr) )\r
 976   ReDim Preserve  arr( UBound(arr) - 1 )\r
 977 End Function\r
 978  \r
 979 '********************************************************************************\r
 980 '  <<< [Array_count] >>> \r
 981 '********************************************************************************\r
 982 Function  Array_count( arr )\r
 983   Array_count = UBound(arr) + 1\r
 984 End Function\r
 985  \r
 986 '********************************************************************************\r
 987 '  <<< [Array_echo] >>> \r
 988 '********************************************************************************\r
 989 Sub  Array_echo( arr )\r
 990   Dim i\r
 991 \r
 992   WScript.Echo  "count = " & Array_count( arr )\r
 993   ' WScript.Echo  "LBound = " & LBound( arr ) & ", UBound = " & UBound( arr )\r
 994   For Each i In arr\r
 995     WScript.Echo  "each = " & i\r
 996   Next\r
 997 End Sub\r
 998  \r
 999 '********************************************************************************\r
1000 '  <<< [raise] >>> \r
1001 ' argument\r
1002 '  - e_num : E_AssertFail, E_TestFail ...\r
1003 '********************************************************************************\r
1004 Sub  raise( ByVal e_num, ByVal e_desc )\r
1005   Err.Raise  e_num, "[ERROR] VBSLib", e_desc\r
1006 End Sub\r
1007 \r
1008 \r
1009  \r
1010 '********************************************************************************\r
1011 '  <<< [Err2] >>> \r
1012 '********************************************************************************\r
1013 Class Err2\r
1014 \r
1015   Public  num          ' Err.Number\r
1016   Public  Description  ' Err.Description (Error Message)\r
1017   Public  Source       ' Err.Source\r
1018   Public  ErrID        ' count of (num <> 0) in each first Copy after Clear\r
1019   Public  RaiseID      ' count of (num <> 0) in Copy\r
1020 \r
1021   Private Sub Class_Initialize\r
1022     num = 0 : Description = "" : ErrID = 0 : RaiseID = 0\r
1023   End Sub\r
1024 \r
1025   Public Sub Copy( err )\r
1026     num = err.Number\r
1027     Description = err.Description\r
1028     Source = err.Source\r
1029     if num <> 0 Then RaiseID = RaiseID + 1 : if RaiseID = 1 Then ErrID = ErrID + 1\r
1030 \r
1031     If ErrID = 1 Then Stop  ' if debug, Enable this line and "If e.ErrID <> ErrID_of_this-1 Then On Error Resume Next" in caller\r
1032 \r
1033   End Sub\r
1034 \r
1035   Public Sub Echo\r
1036     Dim msg\r
1037     msg = "[ERROR] 0x" & Hex(num) & " " & Description & " ErrID=" & ErrID\r
1038     WScript.Echo msg\r
1039     If Not IsEmpty( g_log ) Then  g_log.WriteLine msg\r
1040   End Sub\r
1041 \r
1042   Public Sub OverRaise( e_num, e_desc )\r
1043     num = vbObjectError + e_num\r
1044     Description = e_desc\r
1045     Raise\r
1046   End Sub\r
1047 \r
1048   Public Sub Raise\r
1049     Err.Raise num, Source, Description\r
1050   End Sub\r
1051 \r
1052   Public Sub Clear\r
1053     num = 0 : Description = "" : RaiseID = 0\r
1054   End Sub\r
1055 End Class\r
1056 \r
1057  \r
1058 '********************************************************************************\r
1059 '  <<< [Test_init] >>> \r
1060 '********************************************************************************\r
1061 Dim  Test_nPass\r
1062 Dim  Test_nSkip\r
1063 Dim  Test_nNG\r
1064 Const Test_DefLogFName = "test_log.txt"\r
1065 \r
1066 Sub Test_init\r
1067   Dim  sub_test ' Boolean\r
1068 \r
1069   Set g_log = g_fs.CreateTextFile( Test_DefLogFName, True, False )\r
1070 \r
1071   sub_test = False\r
1072   If WScript.Arguments.Count >= 1 Then\r
1073     If WScript.Arguments(0) = "-sub_test" Then sub_test = True\r
1074   End If\r
1075 \r
1076   If Not sub_test Then  echo  "Test Start"\r
1077 \r
1078   Test_nPass = 0\r
1079   Test_nSkip = 0\r
1080   Test_nNG = 0\r
1081 End Sub\r
1082 \r
1083 \r
1084  \r
1085 '********************************************************************************\r
1086 '  <<< [Test_do] >>> \r
1087 ' comment\r
1088 '   If test failed, raise E_TestFail, ""\r
1089 '********************************************************************************\r
1090 Sub  Test_do( ByVal vbs_path, ByVal func, ByVal param )\r
1091   echo "=========================================================="\r
1092   echo "Test: " & vbs_path & " - " & func & " " & param\r
1093 \r
1094   On Error Resume Next\r
1095     call_vbs  vbs_path, func, param\r
1096   e.Copy( Err ) : On Error GoTo 0 : If e.num <> 0 Then\r
1097     if e.num = vbObjectError Then\r
1098       echo "[SKIP] " & e.Description\r
1099       Test_nSkip = Test_nSkip + 1\r
1100     Else\r
1101       e.Echo\r
1102       Test_nNG = Test_nNG + 1\r
1103     End If\r
1104     e.Clear\r
1105   Else\r
1106     Test_nPass = Test_nPass + 1\r
1107     echo "Pass."\r
1108   End If\r
1109 \r
1110 End Sub\r
1111 \r
1112 \r
1113  \r
1114 '********************************************************************************\r
1115 '  <<< [Test_exe] >>> \r
1116 'comment\r
1117 ' - func and param is dummy.\r
1118 '********************************************************************************\r
1119 Sub  Test_exe( ByVal vbs_path, ByVal func, ByVal param )\r
1120 \r
1121   On Error Resume Next\r
1122     call_vbs_exe  vbs_path\r
1123   e.Copy( Err ) : On Error GoTo 0 : If e.num <> 0 Then\r
1124     if e.num = vbObjectError Then\r
1125       echo "[SKIP] " & e.Description\r
1126       Test_nSkip = Test_nSkip + 1\r
1127     Else\r
1128       e.Echo\r
1129       Test_nNG = Test_nNG + 1\r
1130     End If\r
1131     e.Clear\r
1132   Else\r
1133     Test_nPass = Test_nPass + 1\r
1134   End If\r
1135 \r
1136 End Sub\r
1137 \r
1138 \r
1139  \r
1140 '********************************************************************************\r
1141 '  <<< [Test_skip] >>> \r
1142 '********************************************************************************\r
1143 Sub  Test_skip( ByVal desc )\r
1144   Err.Raise  vbObjectError, "VBSLib", desc\r
1145 End Sub\r
1146 \r
1147 \r
1148  \r
1149 '********************************************************************************\r
1150 '  <<< [Test_finish] >>> \r
1151 '********************************************************************************\r
1152 Sub Test_finish\r
1153   Dim  sub_test ' Boolean\r
1154 \r
1155   sub_test = False\r
1156   If WScript.Arguments.Count >= 1 Then\r
1157     If WScript.Arguments(0) = "-sub_test" Then sub_test = True\r
1158   End If\r
1159 \r
1160   If sub_test Then\r
1161     echo "=========================================================="\r
1162     echo  "Test Finish (Pass=" & Test_nPass & ", SKIP=" & Test_nSkip & ", ERROR=" & Test_nNG & ")"\r
1163   Else\r
1164     If Test_nNG = 0 Then WScript.Quit 0  Else WScript.Quit 1  End If\r
1165   End If\r
1166 \r
1167   g_log = Empty\r
1168 End Sub\r
1169 \r
1170 \r
1171  \r