Option Explicit \r
\r
-' vbslib ver1.00 2008/2/11\r
+' vbslib ver2.00 2008/8/17\r
' Copyright (c) 2008, T's-Neko\r
' All rights reserved. 3-clause BSD license.\r
\r
-Dim g_fs, g_log, e, g_workfolder\r
\r
-Set g_fs = CreateObject("Scripting.FileSystemObject")\r
-Set e = new Err2\r
-g_workfolder = ""\r
+ \r
+'********************************************************************************\r
+' <<< Global variables >>> \r
+'********************************************************************************\r
+\r
+Dim g_workfolder, g_Err2, g_echo_on\r
+Dim g_Test\r
+Dim g_CUI\r
+\r
+Function InitializeModule\r
+ g_workfolder = ""\r
+ g_echo_on = True\r
+ Set g_Err2 = New Err2\r
+ Set g_CUI = New CUI\r
+End Function\r
+Dim g_InitializeModule\r
+Set g_InitializeModule = GetRef( "InitializeModule" )\r
+\r
+Function FinalizeModule( ThisPath )\r
+ g_Err2.OnSuccessFinish\r
+End Function\r
+Dim g_FinalizeModule: Set g_FinalizeModule = GetRef( "FinalizeModule" )\r
+Dim g_FinalizeLevel: g_FinalizeLevel = 100 ' If smaller, called early\r
+\r
+\r
+Const F_File = 1\r
+Const F_Folder = 2\r
+Const F_SubFolder = 4\r
\r
\r
\r
\r
' vbObjectError = &h80040000\r
Const E_AssertFail = &h80041001\r
-Const E_FileNotExist = 2\r
Const E_TestFail = &h80041003\r
Const E_BuildFail = &h80041004\r
Const E_OutOfWorkFolder = &h80041005\r
Const E_ProgTerminated = &hC0000005\r
Const E_NotFoundSymbol = &h80041006\r
Const E_ProgRetNotZero = &h80041007\r
+Const E_Unexpected = &h80041008\r
+Const E_Other = &h80041009\r
+Const E_FileNotExist = 53\r
+Const E_EndOfFile = 62\r
+Const E_WriteAccessDenied = 70\r
+Const E_PathNotFound = 76\r
+\r
+\r
\r
'********************************************************************************\r
' <<< File Object >>> \r
\r
\r
\r
+'*-------------------------------------------------------------------------*\r
+'* \81\9f<<<< \83\86\81[\83U\83C\83\93\83^\81[\83t\83F\83C\83X >>>> \r
+'*-------------------------------------------------------------------------*\r
+\r
+\r
+ \r
+'********************************************************************************\r
+' <<< [echo] >>> \r
+' return: output message\r
+'********************************************************************************\r
+Function echo( ByVal msg )\r
+ Dim b\r
+\r
+ If IsObject( msg ) Then msg = msg.Value\r
+\r
+ WScript.Echo msg\r
+\r
+ b = False : If Not IsEmpty( g_Test ) Then b = Not IsEmpty( g_Test.m_Log )\r
+ If b Then g_Test.m_Log.WriteLine msg\r
+ echo = msg\r
+End Function\r
+\r
+\r
+ \r
'********************************************************************************\r
-' <<< [ChgToCommandPrompt] If VBS file was double clicked, Run a command prompt >>> \r
+' <<< [echo_r] >>> \r
+' return: output message\r
'********************************************************************************\r
-Sub ChgToCommandPrompt\r
- If LCase( Right( WScript.FullName, 11 ) ) = "wscript.exe" Then\r
- Dim cmd\r
- cmd = "cscript.exe " & Chr(34) & WScript.ScriptFullName & Chr(34)\r
- WScript.Quit CreateObject("WScript.Shell").Run( cmd, 1, True )\r
+Function echo_r( ByVal msg, redirect_path )\r
+ Dim f\r
+ Const ForAppending = 8\r
+\r
+ If IsObject( msg ) Then msg = msg.Value\r
+\r
+ If g_debug Then WScript.Echo msg\r
+\r
+ If IsEmpty( redirect_path ) Then\r
+ ElseIf redirect_path = "" Then\r
+ If Not g_debug Then WScript.Echo msg\r
+ Else\r
+ Set f = g_fs.OpenTextFile( redirect_path, ForAppending, True, False )\r
+ f.WriteLine msg\r
End If\r
+\r
+ echo_r = msg\r
+End Function\r
+\r
+\r
+ \r
+'********************************************************************************\r
+' <<< [echo_c] >>> \r
+'********************************************************************************\r
+Sub echo_c( msg )\r
+ If g_b_cscript_exe And g_echo_on Then echo msg\r
+End Sub\r
+\r
+\r
+ \r
+'********************************************************************************\r
+' <<< [echo_on] >>> \r
+'********************************************************************************\r
+Sub echo_on()\r
+ g_echo_on = True\r
+End Sub\r
+\r
+Sub echo_off()\r
+ g_echo_on = False\r
+End Sub\r
+\r
+\r
+ \r
+'********************************************************************************\r
+' <<< [EchoOnOff] >>> \r
+'********************************************************************************\r
+Class EchoOnOff\r
+\r
+ Public m_Prev\r
+\r
+ Private Sub Class_Initialize\r
+ m_Prev = g_echo_on\r
+ End Sub\r
+\r
+ Private Sub Class_Terminate\r
+ g_echo_on = m_Prev\r
+ End Sub\r
+End Class\r
+\r
+\r
+ \r
+'********************************************************************************\r
+' <<< [type_] >>> \r
+'********************************************************************************\r
+Sub type_( path )\r
+ Dim f\r
+\r
+ Set f = g_fs.OpenTextFile( path )\r
+\r
+ Do Until f.AtEndOfStream\r
+ WScript.Echo f.ReadLine\r
+ Loop\r
+End Sub\r
+\r
+\r
+ \r
+'********************************************************************************\r
+' <<< [pause] >>> \r
+'********************************************************************************\r
+Sub pause()\r
+ input "\91±\8ds\82·\82é\82É\82Í Enter \83L\81[\82ð\89\9f\82µ\82Ä\82\82¾\82³\82¢ . . ."\r
+End Sub\r
+\r
+\r
+ \r
+'********************************************************************************\r
+' <<< [pause2] >>> \r
+'********************************************************************************\r
+Sub pause2()\r
+ If WScript.Arguments.Named("wscript")=1 Then input "Enter \83L\81[\82ð\89\9f\82µ\82Ä\82\82¾\82³\82¢ . . ."\r
End Sub\r
\r
\r
' <<< [input] >>> \r
'********************************************************************************\r
Function input( ByVal msg )\r
+\r
+ input = g_CUI.input( msg )\r
+\r
+' Dim e\r
+'\r
+' Wscript.StdOut.Write msg\r
+'\r
+' On Error Resume Next\r
+'\r
+' input = WScript.StdIn.ReadLine\r
+'\r
+' e = Err.Number : Err.Clear : On Error GoTo 0\r
+' If e <> 0 Then\r
+' If e <> 62 Then Err.Raise e '62= End Of File (StdIn, ^C)\r
+' WScript.Quit 1\r
+' End If\r
+\r
+End Function\r
+\r
+\r
+ \r
+'********************************************************************************\r
+' <<< [SendKeys] Send keyboard code stroke to OS >>> \r
+'********************************************************************************\r
+Sub SendKeys( ByVal window_title, ByVal keycords, ByVal late_time )\r
+ WScript.Sleep late_time\r
+ If window_title <> "" Then g_sh.AppActivate( window_title )\r
+ WScript.Sleep 100\r
+ g_sh.SendKeys keycords\r
+End Sub\r
+\r
+\r
+ \r
+'*-------------------------------------------------------------------------*\r
+'* \81\9f<<<< [CUI] Class >>>> \r
+'*-------------------------------------------------------------------------*\r
+\r
+Class CUI\r
+\r
+ Public m_Auto_InputFunc ' as string of auto input function name\r
+ Public m_Auto_Src ' as string of path\r
+ Public m_Auto_Keys ' as string of auto input keys\r
+ Public m_Auto_KeyEnter ' as string of the character of replacing to enter key\r
+ Public m_Auto_DebugCount ' as integer\r
+\r
+\r
+ \r
+'********************************************************************************\r
+' <<< [CUI::Class_Initialize] >>> \r
+'********************************************************************************\r
+Private Sub Class_Initialize\r
+ Me.m_Auto_KeyEnter = "."\r
+ Me.m_Auto_DebugCount = Empty\r
+End Sub\r
+\r
+\r
+ \r
+'********************************************************************************\r
+' <<< [CUI::pause] >>> \r
+'********************************************************************************\r
+Public Sub pause()\r
+ input "\91±\8ds\82·\82é\82É\82Í Enter \83L\81[\82ð\89\9f\82µ\82Ä\82\82¾\82³\82¢ . . ."\r
+End Sub\r
+\r
+\r
+ \r
+'********************************************************************************\r
+' <<< [CUI::input] >>> \r
+'********************************************************************************\r
+Public Function input( ByVal msg )\r
Dim e\r
+ Dim InputFunc\r
\r
Wscript.StdOut.Write msg\r
\r
On Error Resume Next\r
\r
- input = Wscript.StdIn.ReadLine\r
+ If Not IsEmpty( m_Auto_Keys ) And m_Auto_Keys <> "" Then\r
+ If Not IsEmpty( m_Auto_KeyEnter ) Then\r
+ e = InStr( m_Auto_Keys, m_Auto_KeyEnter )\r
+ If e = 0 Then\r
+ input = m_Auto_Keys\r
+ m_Auto_Keys = Empty\r
+ Else\r
+ input = Left( m_Auto_Keys, e - 1 )\r
+ m_Auto_Keys = Mid( m_Auto_Keys, e + 1 )\r
+ End If\r
+ Else\r
+ input = m_Auto_Keys\r
+ m_Auto_Keys = Empty\r
+ End If\r
+\r
+ If IsEmpty( m_Auto_DebugCount ) Then\r
+ echo input\r
+ ElseIf m_Auto_DebugCount > 1 Then\r
+ echo input\r
+ m_Auto_DebugCount = m_Auto_DebugCount - 1\r
+ Else\r
+ Wscript.StdOut.Write input\r
+ Wscript.StdIn.ReadLine\r
+ echo ""\r
+ End If\r
+\r
+ ElseIf IsEmpty( m_Auto_InputFunc ) Then\r
+ input = Wscript.StdIn.ReadLine\r
+ Else\r
+ If IsEmpty( m_Auto_Src ) Then\r
+ Set InputFunc = GetRef( m_Auto_InputFunc )\r
+ If Err.Number = 5 Then WScript.Echo vbCR+vbLF+"Not found function of """+_\r
+ m_Auto_InputFunc +"""": Err.Clear\r
+ If Not IsEmpty( InputFunc ) Then input = InputFunc( msg )\r
+ Else\r
+ input = call_vbs_t( m_Auto_Src, m_Auto_InputFunc, msg )\r
+ If Err.Number = 5 Then WScript.Echo vbCR+vbLF+"Not found function of """+_\r
+ m_Auto_InputFunc +""" in """+m_Auto_Src+"""" : Err.Clear\r
+ If IsEmpty( input ) Then Wscript.StdOut.Write msg : input = Wscript.StdIn.ReadLine\r
+ End If\r
+ End If\r
\r
e = Err.Number : Err.Clear : On Error GoTo 0\r
If e <> 0 Then\r
\r
End Function\r
\r
+\r
\r
'********************************************************************************\r
-' <<< [pause] >>> \r
+' <<< [CUI::SetAutoKeysFromMainArg] >>> \r
'********************************************************************************\r
-Sub pause()\r
- input "\91±\8ds\82·\82é\82É\82Í Enter \83L\81[\82ð\89\9f\82µ\82Ä\82\82¾\82³\82¢ . . ."\r
+Public Sub SetAutoKeysFromMainArg\r
+ If IsEmpty( Me.m_Auto_Keys ) Then\r
+ Me.m_Auto_Keys = WScript.Arguments.Named.Item("autokeys")\r
+ Me.m_Auto_DebugCount = WScript.Arguments.Named.Item("autokeys_debug")\r
+ End If\r
End Sub\r
\r
\r
\r
+End Class \r
+\r
+\r
+ \r
+'*-------------------------------------------------------------------------*\r
+'* \81\9f<<<< \83t\83@\83C\83\8b\91\80\8dì >>>> \r
+'*-------------------------------------------------------------------------*\r
+\r
+\r
+ \r
'********************************************************************************\r
-' <<< [echo] >>> \r
+' <<< [set_workfolder] Set modifiable base folder path >>> \r
+' comment\r
+' - if work path set current directory, path = ""\r
+'********************************************************************************\r
+Sub set_workfolder( ByVal path )\r
+ If g_debug Then echo_c "set_workfolder: " + path\r
+\r
+ If path = "" Then\r
+ g_workfolder = ""\r
+ Else\r
+ If Not g_fs.FolderExists( path ) Then Err.Raise E_FileNotExist,"vbslib","Not found """+path+""""\r
+ g_workfolder = g_fs.GetAbsolutePathName( path )\r
+ End If\r
+End Sub\r
+\r
+\r
+ \r
+'********************************************************************************\r
+' <<< [WorkFolderStack] Set modifiable base folder path >>> \r
+'********************************************************************************\r
+Class WorkFolderStack\r
+\r
+ Public m_PrevWorkFolder\r
+\r
+ Private Sub Class_Initialize\r
+ m_PrevWorkFolder = g_workfolder\r
+ End Sub\r
+\r
+ Private Sub Class_Terminate\r
+ g_workfolder = m_PrevWorkFolder\r
+ End Sub\r
+\r
+ Public Sub Set_( path )\r
+ '// If g_debug Then echo_c "set_workfolder: " + path\r
+\r
+ If path = "" Then\r
+ g_workfolder = ""\r
+ ElseIf path = "." Then\r
+ g_workfolder = g_sh.CurrentDirectory\r
+ Else\r
+ If Not g_fs.FolderExists( path ) Then Err.Raise E_FileNotExist,"vbslib","Not found """+path+""""\r
+ g_workfolder = g_fs.GetAbsolutePathName( path )\r
+ End If\r
+ End Sub\r
+End Class\r
+\r
+\r
+ \r
+'********************************************************************************\r
+' <<< [chk_in_workfolder] Check not to modify out of working folder >>> \r
+' comment\r
+' - If path is out of workfolder, raise error of E_OutOfWorkFolder.\r
'********************************************************************************\r
-Sub echo( ByVal msg )\r
- WScript.Echo msg\r
- If Not IsEmpty( g_log ) Then g_log.WriteLine msg\r
+Sub chk_in_workfolder( ByVal path )\r
+ Dim sh, work\r
+\r
+ If g_workfolder = "" Then\r
+ Set sh = WScript.CreateObject("WScript.Shell")\r
+ work = sh.CurrentDirectory\r
+ sh = Empty\r
+ Else\r
+ work = g_workfolder\r
+ End If\r
+ work = g_fs.BuildPath( work, "a" )\r
+ work = Left( work, Len(work) - 1 )\r
+\r
+ path = g_fs.GetAbsolutePathName( path )\r
+\r
+ If work <> Left( path, Len( work ) ) Then\r
+ Err.Raise E_OutOfWorkFolder, "vbslib", "Out of working folder """ & path & """"\r
+ End If\r
+\r
End Sub\r
\r
+\r
\r
'********************************************************************************\r
' <<< [cd] change current directory >>> \r
\r
\r
'********************************************************************************\r
+' <<< [CurDirStack] >>> \r
+'********************************************************************************\r
+Class CurDirStack\r
+\r
+ Public m_Prev\r
+\r
+ Private Sub Class_Initialize\r
+ m_Prev = g_sh.CurrentDirectory\r
+ End Sub\r
+\r
+ Private Sub Class_Terminate\r
+ g_sh.CurrentDirectory = m_Prev\r
+ End Sub\r
+End Class\r
+\r
+\r
+ \r
+'********************************************************************************\r
' <<< [pushd] push and change current directory >>> \r
' sample\r
' pushd "sub"\r
\r
\r
'********************************************************************************\r
-' <<< [set_workfolder] Set modifiable base folder path >>> \r
-' comment\r
-' - if work path set current directory, path = ""\r
-'********************************************************************************\r
-Sub set_workfolder( ByVal path )\r
- If path = "" Then\r
- g_workfolder = ""\r
- Else\r
- chk_exist path\r
- g_workfolder = g_fs.GetAbsolutePathName( path )\r
- End If\r
-End Sub\r
-\r
- \r
-'********************************************************************************\r
' <<< [copy] >>> \r
' argument\r
' - src : source file or folder path or wild card\r
' If src had Wild card\r
If IsWildcard( src ) Then\r
\r
- Dim fo\r
+ Dim fo,en,ed\r
\r
If Not g_fs.FolderExists( dst ) Then mkdir dst\r
+ If Not g_fs.FolderExists( g_fs.GetParentFolderName( src ) ) Then _\r
+ Err.Raise E_PathNotFound,,"\83p\83X\82ª\8c©\82Â\82©\82è\82Ü\82¹\82ñ\81B"\r
\r
- g_fs.CopyFile src, dst, True\r
- g_fs.CopyFolder src, dst, True\r
+ On Error Resume Next\r
+ g_fs.CopyFile src, dst, True\r
+ g_fs.CopyFolder src, dst, True\r
+ en = Err.Number : ed = Err.Description : On Error GoTo 0\r
+ If en = E_PathNotFound Then en = 0\r
+ If en = E_FileNotExist Then en = 0\r
+ If en <> 0 Then Err.Raise en,,ed\r
\r
\r
' If src is file\r
dst = g_fs.BuildPath( dst, g_fs.GetFileName( src ) )\r
Else\r
dst_fo = g_fs.GetParentFolderName( dst )\r
- If Not g_fs.FolderExists( dst_fo ) Then mkdir dst_fo\r
+ If dst_fo <> "" And Not g_fs.FolderExists( dst_fo ) Then mkdir dst_fo\r
End If\r
\r
g_fs.CopyFile src, dst, True\r
' If src had Wild card\r
If IsWildcard( src ) Then\r
\r
- Dim fo\r
+ Dim fo,en,ed\r
\r
If Not g_fs.FolderExists( dst ) Then mkdir dst\r
+ If Not g_fs.FolderExists( g_fs.GetParentFolderName( src ) ) Then _\r
+ Err.Raise E_PathNotFound,,"\83p\83X\82ª\8c©\82Â\82©\82è\82Ü\82¹\82ñ\81B"\r
\r
- g_fs.MoveFile src, dst\r
- g_fs.MoveFolder src, dst\r
+ On Error Resume Next\r
+ g_fs.MoveFile src, dst\r
+ g_fs.MoveFolder src, dst\r
+ en = Err.Number : ed = Err.Description : On Error GoTo 0\r
+ If en = E_PathNotFound Then en = 0\r
+ If en = E_FileNotExist Then en = 0\r
+ If en <> 0 Then Err.Raise en,,ed\r
\r
\r
' If src is file\r
\r
\r
'********************************************************************************\r
-' <<< [exist] >>> \r
+' <<< [ren] >>> \r
'********************************************************************************\r
-Function exist( ByVal path )\r
- If IsWildcard( path ) Then\r
- Dim folder, fnames()\r
- ExpandWildcard folder, fnames, path\r
- exist = Array_count( fnames ) <> 0\r
+Sub ren( src, dst )\r
+ Dim f\r
+ If g_fs.FileExists( src ) Then\r
+ Set f = g_fs.GetFile( src )\r
+ f.Name = g_fs.GetFileName( dst )\r
Else\r
- exist = ( g_fs.FileExists( path ) = True ) Or ( g_fs.FolderExists( path ) = True )\r
+ Set f = g_fs.GetFolder( src )\r
+ f.Name = g_fs.GetFileName( dst )\r
End If\r
-End Function\r
- \r
-'********************************************************************************\r
-' <<< [chk_exist] >>> \r
-'********************************************************************************\r
-Sub chk_exist( ByVal path )\r
- If Not exist( path ) Then raise E_FileNotExist, path & " not found"\r
End Sub\r
+\r
+\r
\r
'********************************************************************************\r
-' <<< [chk_in_workfolder] Check not to modify out of working folder >>> \r
-' comment\r
-' - If path is out of workfolder, raise error of E_OutOfWorkFolder.\r
+' <<< [SafeFileUpdate] >>> \r
'********************************************************************************\r
-Sub chk_in_workfolder( ByVal path )\r
- Dim sh, work\r
+Sub SafeFileUpdate( FromTmpFilePath, ToUpdateFilePath )\r
+ Dim en,ed,en2,ed2,i,path\r
\r
- If g_workfolder = "" Then\r
- Set sh = WScript.CreateObject("WScript.Shell")\r
- work = sh.CurrentDirectory\r
- sh = Empty\r
- Else\r
- work = g_workfolder\r
- End If\r
- work = g_fs.BuildPath( work, "a" )\r
- work = Left( work, Len(work) - 1 )\r
+ For i=1 To 999\r
+ path = g_fs.GetParentFolderName( ToUpdateFilePath ) + "\" + _\r
+ g_fs.GetBaseName( ToUpdateFilePath ) + "." & i & "." + g_fs.GetExtensionName( ToUpdateFilePath )\r
+ If not exist( path ) Then Exit For\r
+ Next\r
+ 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
\r
- path = g_fs.GetAbsolutePathName( path )\r
+ On Error Resume Next\r
+ g_fs.CopyFile ToUpdateFilePath, path, False\r
+ en = Err.Number : ed = Err.Description : On Error GoTo 0\r
+ 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
+ "\83o\83b\83N\83A\83b\83v\8c³\81F"+ToUpdateFilePath+vbCR+vbLF+ "\83o\83b\83N\83A\83b\83v\90æ\81F"+path+vbCR+vbLF+ ed\r
\r
- If work <> Left( path, Len( work ) ) Then\r
- raise E_OutOfWorkFolder, path & " is out of working folder"\r
- End If\r
-\r
-End Sub\r
-\r
- \r
-'********************************************************************************\r
-' <<< [fc] diff text file >>> \r
-' argument\r
-' - return : True=same, False=different\r
-'********************************************************************************\r
-Function fc( ByVal pathA, ByVal pathB )\r
-\r
- ' File Compare\r
- If g_fs.FileExists( pathA ) Then\r
-\r
- Dim sh, r\r
- If Not g_fs.FileExists( pathB ) Then fc=False : Exit Function\r
-\r
- Set sh = WScript.CreateObject("WScript.Shell")\r
- r = sh.Run( "fc.exe """ + pathA + """ """ + pathB + """", 7, True )\r
- If r = E_ProgTerminated Then raise E_ProgTerminated, "Program Terminated"\r
- fc = ( r = 0 )\r
-\r
-\r
- ' Folder Compare\r
- ElseIf g_fs.FolderExists( pathA ) Then\r
-\r
- Dim foldersA, foldersB, folderA, folderB, foA, foB, step, f\r
- If Not g_fs.FolderExists( pathB ) Then fc=False : Exit Function\r
-\r
- pathA = g_fs.GetAbsolutePathName( pathA )\r
- pathB = g_fs.GetAbsolutePathName( pathB )\r
- GetSubFolders foldersA, pathA\r
- GetSubFolders foldersB, pathB\r
-\r
- If Array_count( foldersA ) <> Array_count( foldersB ) Then fc=False : Exit Function\r
-\r
- For Each folderA In foldersA\r
- step = Mid( folderA, Len( pathA ) + 1 )\r
- If step = "" Then\r
- folderB = pathB\r
- Else\r
- folderB = g_fs.BuildPath( pathB, step )\r
- End If\r
-\r
- Set foA = g_fs.GetFolder( folderA )\r
- Set foB = g_fs.GetFolder( folderB )\r
-\r
- If foA.Files.Count <> foB.Files.Count Then fc=False : Exit Function\r
- For Each f In foA.Files\r
- If Not fc( f.Path, folderB + Mid( f.Path, Len( folderA ) + 1 ) ) Then\r
- fc=False : Exit Function\r
- End If\r
- Next\r
- Next\r
-\r
- fc = True\r
- Else\r
- fc = False : Exit Function\r
- End If\r
-End Function\r
-\r
-\r
-\r
- \r
-'********************************************************************************\r
-' <<< [find] find lines including keyword >>> \r
-'********************************************************************************\r
-Function find( ByVal keyword, ByVal path )\r
- Dim f, line, ret\r
- Set f = g_fs.OpenTextFile( path )\r
-\r
- ret = ""\r
- Do Until f.AtEndOfStream\r
- line = f.ReadLine\r
- If InStr( line, keyword ) > 0 Then ret = ret + line\r
- Loop\r
-\r
- f.Close\r
-\r
- find = ret\r
-End Function\r
+ del_to_trashbox path\r
\r
+ On Error Resume Next\r
+ g_fs.CopyFile FromTmpFilePath, ToUpdateFilePath, True\r
+ en2 = Err.Number : ed2 = Err.Description : On Error GoTo 0\r
\r
- \r
-'********************************************************************************\r
-' <<< [find_c] find lines count including keyword >>> \r
-'********************************************************************************\r
-Function find_c( ByVal keyword, ByVal path )\r
- Dim f, line, ret\r
- Set f = g_fs.OpenTextFile( path )\r
+ On Error Resume Next\r
+ g_fs.DeleteFile FromTmpFilePath\r
+ en = Err.Number : ed = Err.Description : On Error GoTo 0\r
\r
- ret = 0\r
- Do Until f.AtEndOfStream\r
- line = f.ReadLine\r
- If InStr( line, keyword ) > 0 Then ret = ret + 1\r
- Loop\r
+ 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
+ "\83R\83s\81[\8c³\81F"+FromTmpFilePath+vbCR+vbLF+ "\83R\83s\81[\90æ\81F"+ToUpdateFilePath+vbCR+vbLF+ ed2\r
\r
- f.Close\r
+ 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
+ "\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
\r
- find_c = ret\r
-End Function\r
+End Sub\r
\r
\r
\r
If IsWildCard( path ) Then\r
Dim folder, fname, fnames()\r
\r
- ExpandWildcard folder, fnames, path\r
+ ExpandWildcard path, F_File, folder, fnames\r
+ For Each fname in fnames\r
+ del g_fs.BuildPath( folder, fname )\r
+ Next\r
+\r
+ ExpandWildcard path, F_Folder, folder, fnames\r
For Each fname in fnames\r
del g_fs.BuildPath( folder, fname )\r
Next\r
g_fs.DeleteFile path\r
ElseIf g_fs.FolderExists( path ) Then\r
rmdir path\r
+ Else\r
+ chk_in_workfolder path\r
End If\r
End If\r
\r
\r
\r
'********************************************************************************\r
+' <<< [del_subfolder] >>> \r
+'********************************************************************************\r
+Sub del_subfolder( ByVal path )\r
+ Dim folder, fname, fnames()\r
+\r
+ ExpandWildcard path, F_File Or F_SubFolder, folder, fnames\r
+ For Each fname in fnames\r
+ del g_fs.BuildPath( folder, fname )\r
+ Next\r
+\r
+ ExpandWildcard path, F_Folder Or F_SubFolder, folder, fnames\r
+ For Each fname in fnames\r
+ del g_fs.BuildPath( folder, fname )\r
+ Next\r
+End Sub\r
+\r
+\r
+ \r
+'********************************************************************************\r
+' <<< [del_to_trashbox] >>> \r
+'********************************************************************************\r
+Sub del_to_trashbox( ByVal path )\r
+ Dim sh_ap, TrashBox, folder, item, fname\r
+ Set sh_ap = CreateObject("Shell.Application")\r
+ Const ssfBITBUCKET = 10\r
+\r
+ path = g_fs.GetAbsolutePathName( path )\r
+ fname = g_fs.GetFileName( path )\r
+ Set folder = sh_ap.NameSpace( g_fs.GetParentFolderName( path ) )\r
+ If folder is Nothing Then Exit Sub\r
+ Set item = folder.Items.Item( fname )\r
+ If item is Nothing Then Exit Sub\r
+\r
+ Set TrashBox = sh_ap.NameSpace( ssfBITBUCKET )\r
+ TrashBox.MoveHere item\r
+\r
+ Do\r
+ WScript.Sleep 300\r
+ Set item = folder.Items.Item( fname )\r
+ If item is Nothing Then Exit Do\r
+ item = Empty\r
+ Loop\r
+End Sub\r
+\r
+\r
+ \r
+'********************************************************************************\r
' <<< [mkdir] >>> \r
' argument\r
' - return : count of made folder\r
Function mkdir( ByVal fo )\r
Dim i, n, names(), fo2\r
\r
+ If g_fs.FolderExists( fo ) Then mkdir = 0 : Exit Function\r
chk_in_workfolder fo\r
\r
n = 0\r
Next\r
\r
End Function\r
+\r
+\r
\r
'********************************************************************************\r
' <<< [rmdir] >>> \r
Next\r
\r
' Delete folders\r
- g_fs.DeleteFolder( path )\r
+ Dim en,ed\r
+ On Error Resume Next\r
+ g_fs.DeleteFolder( path )\r
+ en = Err.Number : ed = Err.Description : On Error GoTo 0\r
+ If en = E_WriteAccessDenied Then ed = "Denied to delete the folder: "+ path\r
+ If en <> 0 Then Err.Raise en,,ed\r
+\r
End Sub\r
+\r
+\r
\r
'********************************************************************************\r
-' <<< [GetSubFolders] >>> \r
-' argument\r
-' - folders : (out) array of folder pathes\r
-' - path : base folder path\r
+' <<< [exist] >>> \r
'********************************************************************************\r
-Sub GetSubFolders( folders, ByVal path )\r
- Array_toEmpty folders\r
- EnumSubFolders folders, g_fs.GetFolder( path )\r
-End Sub\r
-\r
-Sub EnumSubFolders( folders, fo )\r
- Dim subfo\r
+Function exist( ByVal path )\r
+ If IsWildcard( path ) Then\r
+ Dim folder, fnames()\r
+ ExpandWildcard path, F_File, folder, fnames\r
+ exist = UBound( fnames ) <> -1\r
+ Else\r
+ exist = ( g_fs.FileExists( path ) = True ) Or ( g_fs.FolderExists( path ) = True )\r
+ End If\r
+End Function\r
\r
- Array_push folders, fo.Path\r
\r
- For Each subfo in fo.SubFolders\r
- EnumSubFolders folders, subfo\r
- Next\r
-End Sub\r
\r
'********************************************************************************\r
-' <<< [IsWildcard] >>> \r
+' <<< [fc] file compare as binary >>> \r
+' argument\r
+' - return : True=same, False=different\r
'********************************************************************************\r
-Function IsWildcard( ByVal path )\r
- IsWildcard = InStr( path, "?" ) <> 0 Or InStr( path, "*" ) <> 0\r
+Function fc( ByVal path_a, ByVal path_b )\r
+ fc = fc_r( path_a, path_b, "nul" )\r
End Function\r
\r
\r
\r
'********************************************************************************\r
-' <<< [ExpandWildcard] >>> \r
+' <<< [fc_r] file compare as binary >>> \r
+' argument\r
+' - return : True=same, False=different\r
'********************************************************************************\r
-Sub ExpandWildcard( folder, fnames, ByVal wildcard )\r
- Dim s, re, fo, f\r
+Function fc_r( ByVal path_a, ByVal path_b, redirect_path )\r
+ Dim echos_:Set echos_= New EchoOnOff\r
+ Dim cmdline\r
\r
- folder = g_fs.GetParentFolderName( g_fs.GetAbsolutePathName( wildcard ) )\r
+ cmdline = """" + g_vbslib_folder + "feq.exe"" """ + path_a + """ """ + path_b + """"\r
\r
- Set re = CreateObject("VBScript.RegExp")\r
- re.Global = True\r
- s = g_fs.GetFileName( wildcard )\r
- re.Pattern = "\\" : s = re.Replace( s, "\\" )\r
- re.Pattern = "\." : s = re.Replace( s, "\." )\r
- re.Pattern = "\$" : s = re.Replace( s, "\$" )\r
- re.Pattern = "\^" : s = re.Replace( s, "\^" )\r
- re.Pattern = "\{" : s = re.Replace( s, "\{" )\r
- re.Pattern = "\}" : s = re.Replace( s, "\}" )\r
- re.Pattern = "\[" : s = re.Replace( s, "\[" )\r
- re.Pattern = "\]" : s = re.Replace( s, "\]" )\r
- re.Pattern = "\(" : s = re.Replace( s, "\(" )\r
- re.Pattern = "\)" : s = re.Replace( s, "\)" )\r
- re.Pattern = "\|" : s = re.Replace( s, "\|" )\r
- re.Pattern = "\+" : s = re.Replace( s, "\+" )\r
- re.Pattern = "\*" : s = re.Replace( s, ".*" )\r
- re.Pattern = "\?" : s = re.Replace( s, "." )\r
+ If IsEmpty( redirect_path ) Then\r
+ echo_c "fc """ + path_a + """ """ + path_b + """"\r
+ chk_exist_in_lib "feq.exe"\r
+ fc_r = g_sh.Run( cmdline, 7, TRUE )\r
+ Else\r
+ Dim ex\r
+ If redirect_path <> "nul" Then _\r
+ echo_c "fc """ + path_a + """ """ + path_b + """ >> " + redirect_path\r
+ chk_exist_in_lib "feq.exe"\r
+ Set ex = g_sh.Exec( cmdline )\r
+ redirect_path = g_sh.ExpandEnvironmentStrings( redirect_path )\r
+ fc_r = WaitForFinishAndRedirect( ex, redirect_path )\r
+ End If\r
\r
- re.Pattern = s\r
- re.Global = False\r
- Array_toEmpty fnames\r
- Set fo = g_fs.GetFolder( folder )\r
- For Each f in fo.Files\r
- If re.Test( f.Name ) Then Array_push fnames, f.Name\r
- Next\r
- For Each f in fo.SubFolders\r
- If re.Test( f.Name ) Then Array_push fnames, f.Name\r
- Next\r
-End Sub\r
+ fc_r = (fc_r = 0)\r
\r
- \r
-'********************************************************************************\r
-' <<< [start] >>> \r
-'********************************************************************************\r
-Sub start( ByVal cmdline )\r
- Dim sh\r
+ If fc_r And g_fs.FolderExists( path_a ) Then\r
+ Dim folder, fnames_a(), fnames_b()\r
+ Dim i\r
\r
- Set sh = WScript.CreateObject("WScript.Shell")\r
- sh.Run cmdline, 1, False\r
+ ExpandWildcard path_a + "\*", F_Folder Or F_SubFolder, folder, fnames_a\r
+ ExpandWildcard path_b + "\*", F_Folder Or F_SubFolder, folder, fnames_b\r
+ If UBound(fnames_a) = UBound(fnames_b) Then\r
+ For i=0 To UBound(fnames_a)\r
+ If fnames_a(i) <> fnames_b(i) Then fc_r = False : Exit For\r
+ Next\r
+ Else\r
+ fc_r = False\r
+ End If\r
+ End If\r
\r
-End Sub\r
+' echo_off\r
+' fc_r = fc_r_imp( path_a, path_b, True, _\r
+' g_fs.GetAbsolutePathName(path_a), redirect_path )\r
+\r
+End Function\r
\r
\r
+'Function fc_r_imp( ByVal path_a, ByVal path_b, b_top, base_a, redirect_path )\r
+'\r
+' ' File Compare\r
+' If g_fs.FileExists( path_a ) Then\r
+'\r
+' Dim sh, ex, r\r
+' If Not g_fs.FileExists( path_b ) Then _\r
+' echo_r "Not found (B)"+path_b, redirect_path : fc_r_imp=False : Exit Function\r
+'\r
+' r = RunProg( "fc.exe /B """ + path_a + """ """ + path_b + """", redirect_path )\r
+' If r = 0 Then\r
+' If b_top Then echo_r "same.", redirect_path\r
+' Else\r
+' If b_top Then echo_r "NOT same.", redirect_path _\r
+' Else echo_r "NOT same in "+GetStepPath( path_a, base_a ), redirect_path\r
+' End IF\r
+' fc_r_imp = ( r = 0 )\r
+'\r
+' ' Folder Compare\r
+' ElseIf g_fs.FolderExists( path_a ) Then\r
+'\r
+' Dim foldersA, foldersB, folderA, folderB, foA, foB, step, f\r
+' If Not g_fs.FolderExists( path_b ) Then _\r
+' echo_r "Not found (B)"+g_fs.GetFileName(path_b)+" in "+GetStepPath( folderA, base_a ), redirect_path : fc_r_imp=False : Exit Function\r
+'\r
+' path_a = g_fs.GetAbsolutePathName( path_a )\r
+' path_b = g_fs.GetAbsolutePathName( path_b )\r
+' GetSubFolders foldersA, path_a\r
+' GetSubFolders foldersB, path_b\r
+'\r
+' If UBound( foldersA ) <> UBound( foldersB ) Then _\r
+' echo_r "NOT same count of folders in "+ GetStepPath( path_a, base_a ), redirect_path : fc_r_imp=False : Exit Function\r
+'\r
+' For Each folderA In foldersA\r
+' step = Mid( folderA, Len( path_a ) + 1 )\r
+' If step = "" Then\r
+' folderB = path_b\r
+' Else\r
+' folderB = g_fs.BuildPath( path_b, step )\r
+' End If\r
+'\r
+' Set foA = g_fs.GetFolder( folderA )\r
+' Set foB = g_fs.GetFolder( folderB )\r
+'\r
+' If foA.Files.Count <> foB.Files.Count Then _\r
+' echo_r "NOT same count of files in "+ GetStepPath( folderA, base_a ), redirect_path : fc_r_imp=False : Exit Function\r
+'\r
+' For Each f In foA.Files\r
+' If Not fc_r_imp( f.Path, folderB + Mid( f.Path, Len( folderA ) + 1 ), False, base_a, redirect_path ) Then\r
+' fc_r_imp=False : Exit Function\r
+' End If\r
+' Next\r
+' Next\r
+'\r
+' If b_top Then\r
+' If r = 0 Then echo_r "same.", redirect_path\r
+' End IF\r
+' fc_r_imp = True\r
+' Else\r
+' echo_r "Not found (A)"+path_a, redirect_path : fc_r_imp=False : Exit Function\r
+' End If\r
+'End Function\r
+\r
\r
\r
'********************************************************************************\r
-' <<< [call_exe] >>> \r
-' comment\r
-' - It is possible to call .bat file.\r
-' - cmdline is able to have environment variable.\r
-' ex) call_exe """%ProgramFiles%\Movie Maker\moviemk.exe"""\r
+' <<< [find] find lines including keyword >>> \r
'********************************************************************************\r
-Function call_exe( ByVal cmdline )\r
- Dim sh, r\r
-\r
- Set sh = WScript.CreateObject("WScript.Shell")\r
+Function find( ByVal keyword, ByVal path )\r
+ Dim f, line, ret\r
+ Set f = g_fs.OpenTextFile( path )\r
\r
- cmdline = sh.ExpandEnvironmentStrings( cmdline )\r
- r = sh.Run( cmdline, 1, True )\r
+ ret = ""\r
+ Do Until f.AtEndOfStream\r
+ line = f.ReadLine\r
+ If InStr( line, keyword ) > 0 Then ret = ret + line\r
+ Loop\r
\r
- If r = E_ProgTerminated Then raise E_ProgTerminated, "Program Terminated"\r
+ f.Close\r
\r
- call_exe = r\r
+ find = ret\r
End Function\r
\r
\r
-\r
\r
'********************************************************************************\r
-' <<< [call_exe_r] redirect >>> \r
+' <<< [find_c] find lines count including keyword >>> \r
'********************************************************************************\r
-Function call_exe_r( ByVal cmdline, ByVal inpath, ByVal outpath, ByVal errpath )\r
- Dim sh, ex, r, f, prev_txt\r
-\r
- If inpath <> "" Then raise E_AssertFail, "Not supported"\r
-\r
- Set sh = WScript.CreateObject( "WScript.Shell" )\r
- cmdline = sh.ExpandEnvironmentStrings( cmdline )\r
+Function find_c( ByVal keyword, ByVal path )\r
+ Dim f, line, ret\r
+ Set f = g_fs.OpenTextFile( path )\r
\r
- Set ex = sh.Exec( cmdline )\r
- Do While ex.Status = 0\r
- WScript.Sleep 100\r
+ ret = 0\r
+ Do Until f.AtEndOfStream\r
+ line = f.ReadLine\r
+ If InStr( line, keyword ) > 0 Then ret = ret + 1\r
Loop\r
\r
- If outpath <> "" Then\r
-\r
- prev_txt = ""\r
- If g_fs.FileExists( outpath ) Then\r
- Set f = g_fs.OpenTextFile( outpath, 1 )\r
- On Error Resume Next\r
- prev_txt = f.ReadAll\r
- e.Copy( Err ) : On Error GoTo 0 : If e.num <> 0 Then\r
- If e.num <> &h3E Then e.Raise\r
- e.Clear\r
- End If\r
- f.Close\r
- End If\r
- Set f = g_fs.CreateTextFile( outpath, True, False )\r
- f.Write prev_txt\r
- Do Until ex.StdOut.AtEndOfStream\r
- f.WriteLine ex.StdOut.ReadLine\r
- Loop\r
-\r
- If outpath <> errpath Then\r
- f.Close\r
+ f.Close\r
\r
- prev_txt = ""\r
- If g_fs.FileExists( errpath ) Then\r
- Set f = g_fs.OpenTextFile( errpath, 1 )\r
- On Error Resume Next\r
- prev_txt = f.ReadAll\r
- e.Copy( Err ) : On Error GoTo 0 : If e.num <> 0 Then\r
- If e.num <> &h3E Then e.Raise\r
- e.Clear\r
- End If\r
- f.Close\r
- End If\r
+ find_c = ret\r
+End Function\r
\r
- Set f = g_fs.CreateTextFile( errpath, True, False )\r
- End If\r
- Do Until ex.StdErr.AtEndOfStream\r
- f.WriteLine ex.StdErr.ReadLine\r
- Loop\r
- f.Close\r
- End If\r
\r
- call_exe_r = ex.ExitCode\r
- ex = Empty\r
-End Function\r
\r
'********************************************************************************\r
-' <<< [call_vbs] >>> \r
-' - path is able to have environment variable.\r
-' ex) """%ProgramFiles%\Movie Maker\moviemk.exe"""\r
+' <<< [CreateFile] Create 1 line text file >>> \r
'********************************************************************************\r
-Function call_vbs( ByVal path, ByVal func, ByVal param )\r
- Dim sh, oldDir, f, funcX, in_call\r
+Sub CreateFile( ByVal path, ByVal text )\r
+ Dim t, folder\r
\r
- in_call = False\r
- Set sh = WScript.CreateObject("WScript.Shell")\r
- oldDir = sh.CurrentDirectory\r
+ chk_in_workfolder path\r
\r
- path = sh.ExpandEnvironmentStrings( path )\r
path = g_fs.GetAbsolutePathName( path )\r
- chk_exist path\r
+ folder = g_fs.GetParentFolderName( path )\r
+ mkdir folder\r
\r
- On Error Resume Next 'try\r
+ Set t = g_fs.CreateTextFile( path, True, False )\r
+ t.WriteLine text\r
+ t.Close\r
+End Sub\r
\r
- sh.CurrentDirectory = g_fs.GetParentFolderName( path )\r
\r
- If Err=0 Then Set f = g_fs.OpenTextFile( g_fs.GetFileName( path ) ) : ExecuteGlobal f.ReadAll()\r
- If Err=&h411 Then Err.Clear ' Symbol Overrided\r
- If Err=0 Then Set funcX = GetRef( func )\r
- If Err=0 Then in_call = True : call_vbs = funcX( param )\r
- If Err=0 Then in_call = False\r
+ \r
+'********************************************************************************\r
+' <<< [ReadFile] >>> \r
+'********************************************************************************\r
+Function ReadFile( Path )\r
+ Dim f, en, ed\r
\r
- e.Copy( Err ) : On Error GoTo 0 : If e.num <> 0 Then 'catch\r
- If in_call Then\r
- e.Source = func + " in " + path\r
- If path=WScript.ScriptFullName Then\r
- echo "If you want to debug, Call directory " + func + " before On Error Resume Next."\r
- Else\r
- echo "If you want to debug, Start "+g_fs.GetFileName(path)+" directly."\r
- End If\r
- End If\r
- If e.num = 5 Then raise E_NotFoundSymbol, "Not found func name '" + func + "' in " + path\r
- e.Raise\r
- End If 'finally\r
+ ReadFile = ""\r
\r
- f.Close\r
- sh.CurrentDirectory = oldDir\r
+ On Error Resume Next\r
+ Set f = g_fs.OpenTextFile( Path )\r
+ en = Err.Number : ed = Err.Description : On Error GoTo 0\r
+ If en = E_FileNotExist Then Exit Function\r
+ If en <> 0 Then Err.Raise en,,ed\r
\r
- If e.num <> 0 Then e.Raise\r
+ ReadFile = ReadAll( f )\r
End Function\r
\r
\r
-\r
\r
'********************************************************************************\r
-' <<< [call_vbs_exe] >>> \r
-' - path is able to have environment variable.\r
-' ex) """%ProgramFiles%\Movie Maker\moviemk.exe"""\r
-' - This function craetes new process.\r
+' <<< [OpenTextFile] >>> \r
'********************************************************************************\r
-Function call_vbs_exe( ByVal path )\r
- Dim sh, oldDir, f, funcX, ex, log_bk_path, t, param\r
-\r
- Set sh = WScript.CreateObject("WScript.Shell")\r
+Function OpenTextFile( Path )\r
+ Dim en, ed\r
\r
+ On Error Resume Next\r
+ Set OpenTextFile = g_fs.OpenTextFile( Path )\r
+ en = Err.Number : ed = Err.Description : On Error GoTo 0\r
+ If en = E_FileNotExist Then Err.raise en,,ed+" : "+Path\r
+ If en <> 0 Then Err.Raise en,,ed\r
+End Function\r
\r
- ' Nest test_log.txt\r
- If Not IsEmpty( g_log ) Then\r
- g_log.Close\r
- g_log = Empty\r
\r
- log_bk_path = "test_log_bk.txt"\r
- Set f = g_fs.GetFile( Test_DefLogFName )\r
- If exist( log_bk_path ) Then g_fs.DeleteFile log_bk_path\r
- f.Name = log_bk_path\r
- f = Empty\r
- Else\r
- log_bk_path = ""\r
- End If\r
+ \r
+'********************************************************************************\r
+' <<< [ReadAll] >>> \r
+'********************************************************************************\r
+Function ReadAll( FileStream )\r
+ Dim en, ed\r
\r
+ ReadAll = ""\r
+ On Error Resume Next\r
+ ReadAll = FileStream.ReadAll\r
+ en = Err.Number : ed = Err.Description : On Error GoTo 0\r
+ If en = E_EndOfFile Then en = 0\r
+ If en <> 0 Then Err.Raise en,,ed\r
+End Function\r
\r
- ' Change current directory\r
- oldDir = sh.CurrentDirectory\r
\r
- path = sh.ExpandEnvironmentStrings( path )\r
- path = g_fs.GetAbsolutePathName( path )\r
- chk_exist path\r
+ \r
+'********************************************************************************\r
+' <<< [WriteVBSLibHeader] >>> \r
+'********************************************************************************\r
+Sub WriteVBSLibHeader( OutFileStream, Opt )\r
+ Dim f, line\r
\r
- sh.CurrentDirectory = g_fs.GetParentFolderName( path )\r
+ Set f = g_fs.OpenTextFile( WScript.ScriptFullName )\r
+ Do Until f.AtEndOfStream\r
\r
+ line = f.ReadLine\r
\r
- ' Execute\r
- If log_bk_path <> "" Then param = " //nologo -sub_test" Else param = "" End If\r
- Set ex = sh.Exec( "CScript """ + path + """" + param )\r
+ If InStr( line, "g_CommandPrompt =" ) > 0 and not IsEmpty( Opt ) Then\r
+ If not IsEmpty( Opt.m_OverCommandPrompt ) Then\r
+ line = " g_CommandPrompt = " & Opt.m_OverCommandPrompt\r
+ End If\r
+ End If\r
+ If InStr( line, "main()" ) > 0 Then Exit Do\r
\r
- Do While ex.Status = 0\r
- WScript.Sleep 100\r
+ OutFileStream.WriteLine line\r
Loop\r
+End Sub\r
\r
- Do Until ex.StdOut.AtEndOfStream\r
- echo ex.StdOut.ReadLine\r
- Loop\r
+\r
+Class WriteVBSLibHeader_Option\r
+ Public m_OverCommandPrompt\r
+End Class\r
\r
\r
- ' Return current directory\r
- sh.CurrentDirectory = oldDir\r
+ \r
+'********************************************************************************\r
+' <<< [GetAbsPath] >>> \r
+'********************************************************************************\r
+Function GetAbsPath( StepPath, BasePath )\r
+ Dim i, ii, i3, sep_ch, path\r
\r
\r
- ' Un-nest test_log.txt\r
- If log_bk_path <> "" Then\r
- If g_fs.FileExists( Test_DefLogFName ) Then\r
- Set f = g_fs.OpenTextFile( log_bk_path, 1 )\r
- t = f.ReadAll\r
- f.Close\r
+ '//=== sep_ch = separetor "\" or "/"\r
+ i = InStr( BasePath, "\" )\r
+ ii = InStr( BasePath, "/" )\r
+ If i > 0 Then\r
+ If ii > 0 Then\r
+ If i > ii Then sep_ch = "/" Else sep_ch = "\"\r
Else\r
- t = ""\r
+ sep_ch = "\"\r
End If\r
+ Else\r
+ If ii > 0 Then sep_ch = "/" Else sep_ch = "\"\r
+ End If\r
\r
- Set f = g_fs.OpenTextFile( Test_DefLogFName, 1 )\r
- t = t + f.ReadAll\r
- f.Close\r
- f = Empty\r
\r
- Set g_log = g_fs.CreateTextFile( Test_DefLogFName, 1 )\r
- g_log.Write t\r
-\r
- g_fs.DeleteFile log_bk_path\r
+ '//=== Joint and Replace to sep_ch\r
+ If Right( BasePath, 1 ) = sep_ch Then\r
+ path = BasePath + StepPath\r
+ Else\r
+ path = BasePath + sep_ch + StepPath\r
+ End If\r
+ If sep_ch = "\" Then\r
+ path = Replace( path, "/", "\" )\r
+ Else\r
+ path = Replace( path, "\", "/" )\r
End If\r
\r
\r
- ' Get and raise error level\r
- If ex.ExitCode <> 0 Then\r
- raise E_ProgRetNotZero, CStr( ex.ExitCode )\r
+ '//=== Cut xxx\..\\r
+ Do\r
+ i = InStr( path, sep_ch+".."+sep_ch )\r
+ If i = 0 Then Exit Do\r
+ i3 = 0\r
+ Do\r
+ ii = InStr( i3+1, path, sep_ch )\r
+ If ii = 0 Then Exit Do\r
+ If ii = i Then\r
+ If i3 = 0 and i = 1 Then Exit Do\r
+ path = Left( path, i3 ) + Mid( path, i+4 )\r
+ Exit Do\r
+ End If\r
+ i3 = ii\r
+ Loop\r
+ Loop\r
+\r
+ GetAbsPath = path\r
+End Function\r
+\r
+\r
+ \r
+'********************************************************************************\r
+' <<< [GetStepPath] >>> \r
+' - AbsPath, BasePath, (return) as string\r
+'********************************************************************************\r
+\r
+'// Test\r
+'Set g_fs = CreateObject( "Scripting.FileSystemObject" )\r
+'If GetStepPath( "C:\folder\file.txt", "c:\folder" ) <> "file.txt" Then MsgBox "ERROR!"\r
+'If GetStepPath( "C:\folder\file.txt", "c:\folder\" ) <> "file.txt" Then MsgBox "ERROR!"\r
+'If GetStepPath( "C:\folder\file.txt", "c:\folder\sub" ) <> "..\file.txt" Then MsgBox "ERROR!"\r
+'If GetStepPath( "C:\folder\file.txt", "c:\" ) <> "folder\file.txt" Then MsgBox "ERROR!"\r
+'If GetStepPath( "C:\folder", "c:\folder" ) <> "." Then MsgBox "ERROR!"\r
+'If GetStepPath( "http://www.a.com/folder/file.txt", "http://www.a.com/folder/" ) <> "file.txt" Then MsgBox "ERROR!"\r
+'If GetStepPath( "http://www.a.com/folder/file.txt", "http://www.a.com/" ) <> "folder/file.txt" Then MsgBox "ERROR!"\r
+'MsgBox "Pass."\r
+\r
+\r
+Function GetStepPath( AbsPath, BasePath )\r
+ Dim AbsPathU, BasePathU, path, sep_ch, i, ii\r
+\r
+ AbsPathU = UCase(AbsPath)\r
+ BasePathU = UCase(BasePath)\r
+\r
+\r
+ '// sep_ch = separetor "\" or "/"\r
+ i = InStr( AbsPath, "\" )\r
+ ii = InStr( AbsPath, "/" )\r
+ If i > 0 Then\r
+ If ii > 0 Then\r
+ If i > ii Then sep_ch = "/" Else sep_ch = "\"\r
+ Else\r
+ sep_ch = "\"\r
+ End If\r
+ Else\r
+ If ii > 0 Then sep_ch = "/" Else sep_ch = "\"\r
End If\r
+\r
+\r
+ '// path = common parent folder path\r
+ path = BasePathU\r
+ If Right(BasePathU,1) = sep_ch Then path = Left(BasePathU,Len(BasePathU)-1)\r
+ Do\r
+ If path = Left( AbsPathU, Len(path) ) Then Exit Do\r
+ path = g_fs.GetParentFolderName( path )\r
+ Loop\r
+ If path = "" Then GetStepPath = AbsPath : Exit Function\r
+\r
+\r
+ '// GetStepPath = step path without ..\\r
+ GetStepPath = Mid( AbsPath, Len(path) + 2 )\r
+\r
+\r
+ '// GetStepPath: Add "..\"\r
+ path = Mid( BasePath, Len(path) + 2 )\r
+ Do\r
+ If path = "" Then Exit Do\r
+ path = g_fs.GetParentFolderName( path )\r
+ GetStepPath = ".." + sep_ch + GetStepPath\r
+ Loop\r
+\r
+ If GetStepPath = "" Then GetStepPath = "."\r
End Function\r
\r
\r
+ \r
+'********************************************************************************\r
+' <<< [IsWildcard] >>> \r
+'********************************************************************************\r
+Function IsWildcard( ByVal path )\r
+ IsWildcard = InStr( path, "?" ) <> 0 Or InStr( path, "*" ) <> 0\r
+End Function\r
+\r
\r
\r
'********************************************************************************\r
-' <<< [include] >>> \r
+' <<< [ExpandWildcard] >>> \r
'********************************************************************************\r
-Sub include( ByVal path )\r
- Dim sh, f\r
+Sub ExpandWildcard( ByVal wildcard_path, flags, folder, fnames )\r
+ Dim s, re\r
\r
- Set sh = WScript.CreateObject("WScript.Shell")\r
+ folder = g_fs.GetParentFolderName( g_fs.GetAbsolutePathName( wildcard_path ) )\r
+\r
+ Set re = CreateObject("VBScript.RegExp")\r
+ re.Global = True\r
+ s = g_fs.GetFileName( wildcard_path )\r
+ re.Pattern = "\\" : s = re.Replace( s, "\\" )\r
+ re.Pattern = "\." : s = re.Replace( s, "\." )\r
+ re.Pattern = "\$" : s = re.Replace( s, "\$" )\r
+ re.Pattern = "\^" : s = re.Replace( s, "\^" )\r
+ re.Pattern = "\{" : s = re.Replace( s, "\{" )\r
+ re.Pattern = "\}" : s = re.Replace( s, "\}" )\r
+ re.Pattern = "\[" : s = re.Replace( s, "\[" )\r
+ re.Pattern = "\]" : s = re.Replace( s, "\]" )\r
+ re.Pattern = "\(" : s = re.Replace( s, "\(" )\r
+ re.Pattern = "\)" : s = re.Replace( s, "\)" )\r
+ re.Pattern = "\|" : s = re.Replace( s, "\|" )\r
+ re.Pattern = "\+" : s = re.Replace( s, "\+" )\r
+ re.Pattern = "\*" : s = re.Replace( s, ".*" )\r
+ re.Pattern = "\?" : s = re.Replace( s, "." )\r
\r
- path = sh.ExpandEnvironmentStrings( path )\r
- chk_exist path\r
+ re.Pattern = "^" + s\r
+ If Left( re.Pattern, 3 ) = "^.*" Then re.Pattern = Mid( re.Pattern, 4 )\r
+ re.Global = False\r
+ ReDim fnames( -1 )\r
\r
- On Error Resume Next\r
+ ExpandWildcard_sub re, flags, folder, "", fnames\r
+End Sub\r
\r
- If Err=0 Then Set f = g_fs.OpenTextFile( g_fs.GetFileName( path ) ) : ExecuteGlobal f.ReadAll()\r
- If Err=&h411 Then Err.Clear ' Symbol Overrided\r
\r
- e.Copy( Err ) : On Error GoTo 0\r
- If e.num=&h400 Or e.num=&h3EA Then e.Description = e.Description + " " + path ' No Statement\r
- If e.num <> 0 Then e.Raise\r
+Sub ExpandWildcard_sub( re, flags, folder, step_folder, fnames )\r
+ Dim fo, f\r
+\r
+ Set fo = g_fs.GetFolder( folder )\r
+ If flags And F_File Then\r
+ For Each f in fo.Files\r
+ If re.Test( f.Name ) Then\r
+ ReDim Preserve fnames( UBound(fnames) + 1 )\r
+ fnames( UBound(fnames) ) = step_folder + f.Name\r
+ End If\r
+ Next\r
+ End If\r
+ If flags And F_Folder Then\r
+ For Each f in fo.SubFolders\r
+ If re.Test( f.Name ) Then\r
+ ReDim Preserve fnames( UBound(fnames) + 1 )\r
+ fnames( UBound(fnames) ) = step_folder + f.Name\r
+ End If\r
+ Next\r
+ End If\r
+\r
+ If flags And F_SubFolder Then\r
+ For Each f in fo.SubFolders\r
+ ExpandWildcard_sub re, flags, f.Path, step_folder + f.Name + "\", fnames\r
+ Next\r
+ End If\r
End Sub\r
+\r
+\r
\r
'********************************************************************************\r
-' <<< [env] Expand environment strings >>> \r
+' <<< [GetSubFolders] >>> \r
+' argument\r
+' - folders : (out) array of folder pathes\r
+' - path : base folder path\r
'********************************************************************************\r
-Function env( ByVal s )\r
- Set sh = WScript.CreateObject("WScript.Shell")\r
+Sub GetSubFolders( folders, ByVal path )\r
+ ReDim folders(-1)\r
+ EnumSubFolders folders, g_fs.GetFolder( path )\r
+End Sub\r
\r
- env = sh.ExpandEnvironmentStrings( s )\r
-End Function\r
+Sub EnumSubFolders( folders, fo )\r
+ Dim subfo\r
+\r
+ ReDim Preserve folders( UBound(folders) + 1 )\r
+ folders( UBound(folders) ) = fo.Path\r
+\r
+ For Each subfo in fo.SubFolders\r
+ EnumSubFolders folders, subfo\r
+ Next\r
+End Sub\r
\r
\r
\r
'********************************************************************************\r
-' <<< [devenv] Visual Studio 2005 command line build >>> \r
-' sample\r
-' pushd "src"\r
-' devenv "sample.sln /rebuild", "Release"\r
-' popd\r
+' <<< [RemoveWildcard] >>> \r
'********************************************************************************\r
-Sub devenv( ByVal param, ByVal config )\r
- Dim sh, r, cmdline\r
- Set sh = WScript.CreateObject("WScript.Shell")\r
+Sub RemoveWildcard( WildCard, fnames )\r
+ Dim s, path, fname, i, n, wc, wc_len\r
+\r
+\r
+ '//=== check by with wildcard\r
+ If Left( WildCard, 1 ) = "*" Then\r
+ wc = LCase( Mid( WildCard, 2 ) ) : wc_len = Len( wc )\r
+ n = UBound( fnames )\r
+ For i = 0 To n\r
+ path = fnames(i)\r
+ Do\r
+ fname = g_fs.GetFileName( path )\r
+ If LCase( Right( fname, wc_len ) ) = wc Then fnames(i) = Empty : Exit Do\r
+ path = g_fs.GetParentFolderName( path )\r
+ If path = "" Then Exit Do\r
+ Loop\r
+ Next\r
+\r
+\r
+ '//=== check by no wildcard\r
+ Else\r
+ wc = LCase( WildCard )\r
+ n = UBound( fnames )\r
+ For i = 0 To n\r
+ path = fnames(i)\r
+ Do\r
+ fname = g_fs.GetFileName( path )\r
+ If LCase( fname ) = wc Then fnames(i) = Empty : Exit Do\r
+ path = g_fs.GetParentFolderName( path )\r
+ If path = "" Then Exit Do\r
+ Loop\r
+ Next\r
+ End If\r
\r
- cmdline = Chr(34) + sh.RegRead( "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\VisualStudio\8.0\"+_\r
- "InstallDir" ) + "devenv.exe" + Chr(34) +_\r
- " " + param + " " + Chr(34) + config + Chr(34)\r
- r = call_exe( cmdline )\r
\r
- If r <> 0 Then raise E_BuildFail, "devenv failed " + param + " in " + sh.CurrentDirectory\r
+ '//=== shrink the array\r
+ n = 0\r
+ For i = 0 To UBound( fnames )\r
+ If not IsEmpty( fnames(i) ) Then fnames(n) = fnames(i) : n = n + 1\r
+ Next\r
+ Redim Preserve fnames( n - 1 )\r
End Sub\r
\r
\r
\r
'********************************************************************************\r
-' <<< [devenv_clean] Visual Studio 2005 clean >>> \r
-' sample\r
-' pushd "src"\r
-' devenv_clean "sample.sln"\r
-' popd\r
-'********************************************************************************\r
-Sub devenv_clean( ByVal sln )\r
- devenv sln+" /clean", "Release"\r
- del "Release"\r
- devenv sln+" /clean", "Debug"\r
- del "Debug"\r
- del "*.ncb"\r
- del "*.suo"\r
- del "*.user"\r
-End Sub\r
+' <<< [MeltCSV] >>> \r
+'********************************************************************************\r
+Function MeltCSV( Line, in_out_Start )\r
+ Dim s, i, c\r
+\r
+ i = in_out_Start\r
+\r
+ '//=== Skip space character\r
+ Do\r
+ c = Mid( Line, i, 1 )\r
+ If c<>" " and c<>vbTab Then Exit Do\r
+ i = i + 1\r
+ Loop\r
+\r
+ Select Case c\r
+\r
+ '//=== If enclosed by " "\r
+ Case """"\r
+ Do\r
+ i = i + 1\r
+ c = Mid( Line, i, 1 )\r
+ If c = "" Then Exit Do\r
+ If c = """" Then\r
+ i = i + 1\r
+ c = Mid( Line, i, 1 )\r
+ If c = """" Then s = s + c Else Exit Do\r
+ Else\r
+ s = s + c\r
+ End If\r
+ Loop\r
+\r
+ MeltCSV = s\r
+\r
+ Do\r
+ If c = "" Then in_out_Start = 0 : Exit Function\r
+ If c = "," Then in_out_Start = i+1 : Exit Function\r
+ i = i + 1\r
+ c = Mid( Line, i, 1 )\r
+ Loop\r
+\r
+\r
+ '//=== If no value\r
+ Case ","\r
+ in_out_Start = i+1 : Exit Function\r
+ Case ""\r
+ in_out_Start = 0 : Exit Function\r
+\r
+\r
+ '//=== If NOT enclosed by " "\r
+ Case Else\r
+ Do\r
+ If c = "" or c = "," Then Exit Do\r
+ s = s + c\r
+ i = i + 1\r
+ c = Mid( Line, i, 1 )\r
+ Loop\r
+\r
+ MeltCSV = Trim( s )\r
+\r
+ If c = "" Then in_out_Start = 0 : Exit Function\r
+ If c = "," Then in_out_Start = i+1 : Exit Function\r
+ End Select\r
+End Function\r
+\r
+\r
+ \r
+'*-------------------------------------------------------------------------*\r
+'* \81\9f<<<< \8aÖ\90\94\83R\81[\83\8b\82Æ include >>>> \r
+'*-------------------------------------------------------------------------*\r
+\r
+\r
\r
'********************************************************************************\r
-' <<< [SendKeys] Send keyboard code stroke to OS >>> \r
+' <<< [call_vbs] >>> \r
'********************************************************************************\r
-Sub SendKeys( ByVal window_title, ByVal keycords, ByVal late_time )\r
- Dim sh\r
- Set sh = WScript.CreateObject("WScript.Shell")\r
+Function call_vbs( path, func, param )\r
+ call_vbs = call_vbs_t( path, func, param )\r
+End Function\r
\r
- WScript.Sleep late_time\r
- sh.AppActivate( window_title )\r
- WScript.Sleep 100\r
- sh.SendKeys keycords\r
+\r
+ \r
+'*-------------------------------------------------------------------------*\r
+'* \81\9f<<<< \83v\83\8d\83Z\83X >>>> \r
+'*-------------------------------------------------------------------------*\r
+\r
+\r
+ \r
+'********************************************************************************\r
+' <<< [env] Expand environment strings >>> \r
+'********************************************************************************\r
+Function env( s )\r
+ env = g_sh.ExpandEnvironmentStrings( s )\r
+End Function\r
+\r
+\r
+ \r
+'********************************************************************************\r
+' <<< [start] >>> \r
+'********************************************************************************\r
+Sub start( cmdline )\r
+ echo_c cmdline\r
+ cmdline = g_sh.ExpandEnvironmentStrings( cmdline )\r
+ g_sh.Run cmdline,, FALSE\r
End Sub\r
+ \r
+'********************************************************************************\r
+' <<< [RunProg] >>> \r
+'********************************************************************************\r
+Function RunProg( ByVal cmdline, stdout_stderr_redirect )\r
+ Dim dbg_cmd\r
\r
+ '// Set debug mode\r
+ If stdout_stderr_redirect = "_debug" Then\r
+ dbg_cmd = "cmd /K " : stdout_stderr_redirect = ""\r
+ Else\r
+ dbg_cmd = ""\r
+ End If\r
+\r
+\r
+ '// Echo command line\r
+ If stdout_stderr_redirect = "" Then\r
+ echo_c cmdline\r
+ Else\r
+ echo_c cmdline+" >> """+stdout_stderr_redirect+""""\r
+ End If\r
+\r
+\r
+ '// Create new process\r
+ cmdline = g_sh.ExpandEnvironmentStrings( cmdline )\r
+\r
+ Dim ex\r
+ Set ex = g_sh.Exec( cmdline )\r
+ stdout_stderr_redirect = g_sh.ExpandEnvironmentStrings( stdout_stderr_redirect )\r
+ RunProg = WaitForFinishAndRedirect( ex, stdout_stderr_redirect )\r
+End Function\r
+\r
+\r
+ \r
+'********************************************************************************\r
+' <<< [WaitForFinishAndRedirect] >>> \r
+'********************************************************************************\r
+Function WaitForFinishAndRedirect( ex, path )\r
+ Dim f\r
+\r
+ If path <> "" and path <> "nul" Then _\r
+ Set f = g_fs.OpenTextFile( path, 8, True, False )\r
+\r
+ Do While ex.Status = 0\r
+ WScript.Sleep 200\r
+ If path = "" Then\r
+ Do Until ex.StdOut.AtEndOfStream : echo ex.StdOut.ReadLine : Loop\r
+ Do Until ex.StdErr.AtEndOfStream : echo ex.StdErr.ReadLine : Loop\r
+ ElseIf path = "nul" Then\r
+ Do Until ex.StdOut.AtEndOfStream : ex.StdOut.ReadLine : Loop\r
+ Do Until ex.StdErr.AtEndOfStream : ex.StdErr.ReadLine : Loop\r
+ Else\r
+ Do Until ex.StdOut.AtEndOfStream : f.WriteLine ex.StdOut.ReadLine : Loop\r
+ Do Until ex.StdErr.AtEndOfStream : f.WriteLine ex.StdErr.ReadLine : Loop\r
+ End If\r
+ Loop\r
+\r
+ If path = "" Then\r
+ Do Until ex.StdOut.AtEndOfStream : echo ex.StdOut.ReadLine : Loop\r
+ Do Until ex.StdErr.AtEndOfStream : echo ex.StdErr.ReadLine : Loop\r
+ ElseIf path = "nul" Then\r
+ Do Until ex.StdOut.AtEndOfStream : ex.StdOut.ReadLine : Loop\r
+ Do Until ex.StdErr.AtEndOfStream : ex.StdErr.ReadLine : Loop\r
+ Else\r
+ Do Until ex.StdOut.AtEndOfStream : f.WriteLine ex.StdOut.ReadLine : Loop\r
+ Do Until ex.StdErr.AtEndOfStream : f.WriteLine ex.StdErr.ReadLine : Loop\r
+ End If\r
+ WaitForFinishAndRedirect = ex.ExitCode\r
+End Function\r
+\r
+\r
+ \r
+'********************************************************************************\r
+' <<< [ArgumentExist] >>> \r
+'********************************************************************************\r
+Function ArgumentExist( name )\r
+ Dim key\r
+ For Each key in WScript.Arguments.Named\r
+ If key = name Then ArgumentExist = True : Exit Function\r
+ Next\r
+ ArgumentExist = False\r
+End Function\r
+\r
+\r
+ \r
+'*-------------------------------------------------------------------------*\r
+'* \81\9f<<<< \91Ò\82¿\81A\90§\8cä >>>> \r
+'*-------------------------------------------------------------------------*\r
\r
\r
\r
' <<< [Sleep] >>> \r
'********************************************************************************\r
Sub Sleep( ByVal msec )\r
- Dim sh\r
- Set sh = WScript.CreateObject("WScript.Shell")\r
-\r
WScript.Sleep msec\r
End Sub\r
\r
\r
-\r
\r
'********************************************************************************\r
' <<< [WaitForFile] Wait for make the file >>> \r
End Sub\r
\r
\r
+ \r
+'*-------------------------------------------------------------------------*\r
+'* \81\9f<<<< \94z\97ñ\81A\83R\83\8c\83N\83V\83\87\83\93 >>>> \r
+'*-------------------------------------------------------------------------*\r
+\r
\r
\r
'********************************************************************************\r
-' <<< [CreateFile] Create 1 line text file >>> \r
+' <<< [QuickSort_fromDic] >>> \r
+'dic as Scripting.Dictionary\r
+'out_arr as [out] object array\r
'********************************************************************************\r
-Sub CreateFile( ByVal path, ByVal text )\r
- Dim t, folder\r
-\r
- chk_in_workfolder path\r
+Sub QuickSort_fromDic( dic, out_arr, compare_func, param )\r
+ Dim i, i_last, elem\r
+ i_last = dic.Count - 1\r
+ Redim out_arr( i_last )\r
\r
- path = g_fs.GetAbsolutePathName( path )\r
- folder = g_fs.GetParentFolderName( path )\r
- mkdir folder\r
+ i=0\r
+ For Each elem In dic.Items\r
+ Set out_arr(i) = elem\r
+ i = i + 1\r
+ Next\r
\r
- Set t = g_fs.CreateTextFile( path, True, False )\r
- t.WriteLine text\r
- t.Close\r
+ QuickSort out_arr, 0, i_last, compare_func, param\r
End Sub\r
\r
\r
\r
'********************************************************************************\r
-' <<< [Array_toEmpty] >>> \r
+' <<< [QuickSort] >>> \r
'********************************************************************************\r
-Sub Array_toEmpty( arr )\r
- ReDim arr( -1 )\r
+Sub QuickSort( arr, i_left, i_right, compare_func, param )\r
+ Dim pivot, i_pivot, i_big, i_small, sw\r
+\r
+ If i_left >= i_right Then Exit Sub ' rule-b'\r
+\r
+ i_pivot = ( i_left + i_right ) \ 2\r
+ Set pivot = arr( i_pivot )\r
+\r
+\r
+ '//== for debug\r
+ ' Dim i, sym, value\r
+ ' echo "QuickSort start ----------------------"\r
+ ' For i = i_left To i_right\r
+ ' QuickSort_Debug_getSym arr, i, sym, value\r
+ ' If i = i_pivot Then value = value & " (pivot)"\r
+ ' echo "(" & i & ") " & sym & " = " & value\r
+ ' Next\r
+ 'Stop\r
+\r
+\r
+ i_big = i_left : i_small = i_right\r
+ Do\r
+ '// Set i_big on smaller than pivot\r
+ Do\r
+ If compare_func( arr(i_big), pivot, param ) >= 0 Then Exit Do\r
+ i_big = i_big + 1\r
+ Loop\r
+\r
+ '// Set i_small on equal or bigger than pivot\r
+ Do\r
+ If i_small < i_pivot and i_small < i_big Then\r
+ If i_big < i_pivot Then i_small = i_pivot : Exit Do _\r
+ Else Exit Sub ' rule-c\r
+ End If\r
+ If compare_func( arr(i_small), pivot, param ) < 0 Then Exit Do\r
+ i_small = i_small - 1\r
+ Loop\r
+\r
+ '// Swap\r
+ If i_big < i_small Then ' rule-a\r
+ Set sw = arr(i_big) : Set arr(i_big) = arr(i_small) : Set arr(i_small) = sw\r
+ If i_big = i_pivot Then i_pivot = i_small\r
+ If i_small = i_pivot Then i_big = i_big + 1 : Exit Do ' rule-c'\r
+ Else\r
+ Exit Do\r
+ End If\r
+ Loop\r
+\r
+\r
+ '//== for debug\r
+ ' echo "QuickSort middle ----------------------"\r
+ ' For i = i_left To i_right\r
+ ' QuickSort_Debug_getSym arr, i, sym, value\r
+ ' If i = i_big-1 Then value = value & " (i_big-1)"\r
+ ' If i = i_big Then value = value & " (i_big)"\r
+ ' echo "(" & i & ") " & sym & " = " & value\r
+ ' Next\r
+\r
+\r
+ QuickSort arr, i_left, i_big-1, compare_func, param ' rule-b\r
+ QuickSort arr, i_big, i_right, compare_func, param ' rule-b\r
+\r
+\r
+ '//== for debug\r
+ ' echo "QuickSort end ----------------------"\r
+ ' For i = i_left To i_right\r
+ ' QuickSort_Debug_getSym arr, i, sym, value\r
+ ' echo "(" & i & ") " & sym & " = " & value\r
+ ' Next\r
End Sub\r
+\r
+\r
+Sub QuickSort_Debug_getSym( Arr, Index, out_Symbol, out_Value )\r
+ out_Symbol = Index\r
+ out_Value = Arr(Index).id\r
+End Sub\r
+\r
+\r
\r
'********************************************************************************\r
-' <<< [Array_push] >>> \r
+' <<< [ShakerSort_fromDic] >>> \r
+'dic as Scripting.Dictionary\r
+'out_arr as [out] object array\r
'********************************************************************************\r
-Sub Array_push( arr, item )\r
- ReDim Preserve arr( UBound(arr) + 1 )\r
- arr( UBound(arr) ) = item\r
+Sub ShakerSort_fromDic( dic, out_arr, sign, compare_func, param )\r
+ Dim i, i_last, elem\r
+ i_last = dic.Count - 1\r
+ Redim out_arr( i_last )\r
+\r
+ If sign >= 0 Then\r
+ i=0\r
+ For Each elem In dic.Items\r
+ Set out_arr(i) = elem\r
+ i = i + 1\r
+ Next\r
+ Else\r
+ i=i_last\r
+ For Each elem In dic.Items\r
+ Set out_arr(i) = elem\r
+ i = i - 1\r
+ Next\r
+ End If\r
+\r
+ ShakerSort out_arr, 0, i_last, compare_func, param\r
End Sub\r
+\r
+\r
\r
'********************************************************************************\r
-' <<< [Array_pop] >>> \r
+' <<< [ShakerSort] >>> \r
'********************************************************************************\r
-Function Array_pop( arr )\r
- Array_pop = arr( UBound(arr) )\r
- ReDim Preserve arr( UBound(arr) - 1 )\r
-End Function\r
+Sub ShakerSort( arr, i_left, i_right, compare_func, param )\r
+ Dim i_swap, i, sw\r
+\r
+ Do\r
+ i_swap = i_left+1\r
+ For i=i_left+1 To i_right\r
+ If compare_func( arr(i-1), arr(i), param ) > 0 Then\r
+ Set sw = arr(i-1) : Set arr(i-1) = arr(i) : Set arr(i) = sw\r
+ i_swap = i\r
+ End If\r
+ Next\r
+ If i_swap = i_left+1 Then Exit Do\r
+ i_right = i_swap-1\r
+\r
+ i_swap = i_right-1\r
+ For i=i_right-1 To i_left Step -1\r
+ If compare_func( arr(i), arr(i+1), param ) > 0 Then\r
+ Set sw = arr(i) : Set arr(i) = arr(i+1) : Set arr(i+1) = sw\r
+ i_swap = i\r
+ End If\r
+ Next\r
+ If i_swap = i_right-1 Then Exit Do\r
+ i_left = i_swap+1\r
+ Loop\r
+End Sub\r
+\r
\r
'********************************************************************************\r
-' <<< [Array_count] >>> \r
+' <<< [CInt2] >>> \r
+' - no exception\r
'********************************************************************************\r
-Function Array_count( arr )\r
- Array_count = UBound(arr) + 1\r
+Function CInt2( v )\r
+ Dim en, ed\r
+\r
+ On Error Resume Next\r
+ CInt2 = CInt( v )\r
+ en = Err.Number : ed = Err.Description : On Error GoTo 0\r
+ If en = 13 Then '// if sym is not number\r
+ CInt2 = 0\r
+ ElseIf en <> 0 Then Err.Raise en,,ed End If\r
End Function\r
+\r
+\r
+ \r
+'*-------------------------------------------------------------------------*\r
+'* <<<< [ArrayClass] Class >>>> */ \r
+'*-------------------------------------------------------------------------*\r
+\r
+Class ArrayClass\r
+ Public m_Array()\r
+\r
+ Private Sub Class_Initialize\r
+ ReDim m_Array( -1 )\r
+ End Sub\r
+\r
+ Public Sub ToEmpty()\r
+ ReDim m_Array( -1 )\r
+ End Sub\r
+\r
+ Public Sub Add( elem )\r
+ Push elem\r
+ End Sub\r
+\r
+ Public Sub Push( elem )\r
+ ReDim Preserve m_Array( UBound(m_Array) + 1 )\r
+ If IsObject( elem ) Then\r
+ Set m_Array( UBound(m_Array) ) = elem\r
+ Else\r
+ m_Array( UBound(m_Array) ) = elem\r
+ End If\r
+ End Sub\r
+\r
+ Public Function Pop()\r
+ If IsObject( m_Array( UBound(m_Array) ) ) Then\r
+ Set Pop = m_Array( UBound(m_Array) )\r
+ Else\r
+ Pop = m_Array( UBound(m_Array) )\r
+ End If\r
+ ReDim Preserve m_Array( UBound(m_Array) - 1 )\r
+ End Function\r
+\r
+ Public Function Count()\r
+ Count = UBound(m_Array) + 1\r
+ End Function\r
+\r
+ Public Sub Echo()\r
+ Dim i, e\r
+ WScript.Echo "count = " & Count\r
+ For Each i In m_Array\r
+ If IsObject( i ) Then\r
+ WScript.Echo "Class " & TypeName( i )\r
+ On Error Resume Next\r
+ i.Echo\r
+ e = Err.Number\r
+ On Error GoTo 0\r
+ If e <> 0 And e <> 438 Then Err.Raise e\r
+ Else\r
+ WScript.Echo "each = " & i\r
+ End If\r
+ Next\r
+ End Sub\r
+End Class\r
+\r
+\r
+ \r
+'*-------------------------------------------------------------------------*\r
+'* <<<< [ArrayDictionary] Class >>>> */ \r
+'*-------------------------------------------------------------------------*\r
+\r
+class ArrayDictionary\r
+\r
+ Public m_Dic\r
+\r
+ Private Sub Class_Initialize\r
+ Set m_Dic = CreateObject("Scripting.Dictionary")\r
+ End Sub\r
+\r
+ Public Sub ToEmpty\r
+ m_Dic.RemoveAll\r
+ End Sub\r
+\r
+ Public Sub Add( key, item )\r
+ Dim dic_item\r
+\r
+ If m_Dic.Exists( key ) Then\r
+ m_Dic.Item( key ).Add item\r
+ Else\r
+ Set dic_item = New ArrayClass\r
+ dic_item.Add item\r
+ m_Dic.Add key, dic_item\r
+ End If\r
+ End Sub\r
+\r
+ Public Function Count\r
+ Dim i\r
+ Count = 0\r
+ For Each i in m_Dic.Items()\r
+ Count = Count + i.Count\r
+ Next\r
+ End Function\r
+\r
+ Public Sub Echo\r
+ Dim i, n\r
+\r
+ WScript.Echo "--- ArrayDictionary ------------------------------"\r
+ WScript.Echo "key count = " & m_Dic.Count\r
+\r
+ WScript.Echo "item count = " & Count\r
+\r
+ For Each i in m_Dic.Keys()\r
+ WScript.Echo "key=""" & i & """"\r
+ m_Dic.Item(i).Echo\r
+ Next\r
+ WScript.Echo ""\r
+ End Sub\r
+\r
+End Class\r
+\r
+\r
+ \r
+'*-------------------------------------------------------------------------*\r
+'* \81\9f<<<< \83G\83\89\81[\8f\88\97\9d \81iErr2\81j >>>> \r
+'*-------------------------------------------------------------------------*\r
+\r
+\r
\r
'********************************************************************************\r
-' <<< [Array_echo] >>> \r
+' <<< [Finish] >>> \r
'********************************************************************************\r
-Sub Array_echo( arr )\r
- Dim i\r
-\r
- WScript.Echo "count = " & Array_count( arr )\r
- ' WScript.Echo "LBound = " & LBound( arr ) & ", UBound = " & UBound( arr )\r
- For Each i In arr\r
- WScript.Echo "each = " & i\r
- Next\r
+Sub Finish\r
+ WScript.Quit 9\r
End Sub\r
+\r
+\r
\r
'********************************************************************************\r
-' <<< [raise] >>> \r
-' argument\r
-' - e_num : E_AssertFail, E_TestFail ...\r
+' <<< [Error] >>> \r
'********************************************************************************\r
-Sub raise( ByVal e_num, ByVal e_desc )\r
- Err.Raise e_num, "[ERROR] VBSLib", e_desc\r
+Sub Error\r
+ Stop\r
+ WScript.Echo "[ERROR] Unknown"\r
+ pause2\r
+ WScript.Quit 1\r
End Sub\r
\r
\r
'********************************************************************************\r
Class Err2\r
\r
+ Public Number ' Err.Number\r
Public num ' Err.Number\r
Public Description ' Err.Description (Error Message)\r
+ Public desc ' Err.Description (Error Message)\r
Public Source ' Err.Source\r
Public ErrID ' count of (num <> 0) in each first Copy after Clear\r
Public RaiseID ' count of (num <> 0) in Copy\r
+ Public BreakErrID ' as integer\r
+ Public BreakRaiseID ' as integer\r
\r
Private Sub Class_Initialize\r
num = 0 : Description = "" : ErrID = 0 : RaiseID = 0\r
End Sub\r
\r
- Public Sub Copy( err )\r
- num = err.Number\r
- Description = err.Description\r
- Source = err.Source\r
- if num <> 0 Then RaiseID = RaiseID + 1 : if RaiseID = 1 Then ErrID = ErrID + 1\r
-\r
- 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
-\r
+ Public Sub OnSuccessFinish\r
+ If num <> 0 Then Err.Raise num, Source, Description\r
+ If Err.Number <> 0 Then echo GetErrStr( Err.Number, Err.Description, Err.Source )\r
End Sub\r
\r
- Public Sub Echo\r
- Dim msg\r
- msg = "[ERROR] 0x" & Hex(num) & " " & Description & " ErrID=" & ErrID\r
- WScript.Echo msg\r
- If Not IsEmpty( g_log ) Then g_log.WriteLine msg\r
+ Public Sub Copy( err )\r
+ Me.Number = err.Number\r
+ Me.num = err.Number\r
+ Me.Description = err.Description\r
+ Me.desc = err.Description\r
+ Me.Source = err.Source\r
+ if Me.num <> 0 Then Me.RaiseID = Me.RaiseID + 1 : if Me.RaiseID = 1 Then Me.ErrID = Me.ErrID + 1\r
+ BreakByID\r
End Sub\r
\r
+ Public Function Value\r
+ Value = GetErrStr( num, Description, Source )\r
+ End Function\r
+\r
Public Sub OverRaise( e_num, e_desc )\r
- num = vbObjectError + e_num\r
+ num = e_num\r
Description = e_desc\r
Raise\r
End Sub\r
\r
Public Sub Raise\r
- Err.Raise num, Source, Description\r
+ If num = 0 Then\r
+ Err.Raise 1\r
+ Else\r
+ Err.Raise num, Source, Description\r
+ End If\r
End Sub\r
\r
Public Sub Clear\r
End Sub\r
End Class\r
\r
+\r
\r
'********************************************************************************\r
-' <<< [Test_init] >>> \r
+' <<< [Raise] >>> \r
'********************************************************************************\r
-Dim Test_nPass\r
-Dim Test_nSkip\r
-Dim Test_nNG\r
-Const Test_DefLogFName = "test_log.txt"\r
-\r
-Sub Test_init\r
- Dim sub_test ' Boolean\r
+Sub Raise( ErrNum, Description )\r
+ g_Err2.num = ErrNum\r
+ g_Err2.Source = ""\r
+ g_Err2.Description = Description\r
+ g_Err2.RaiseID = g_Err2.RaiseID + 1 : if g_Err2.RaiseID = 1 Then g_Err2.ErrID = g_Err2.ErrID + 1\r
+ If g_debug Then echo "ErrID = " & g_Err2.ErrID & ", RaiseID = " & g_Err2.RaiseID\r
+ BreakByID\r
+ Err.raise g_Err2.num, g_Err2.Source, g_Err2.Description\r
+End Sub\r
\r
- Set g_log = g_fs.CreateTextFile( Test_DefLogFName, True, False )\r
\r
- sub_test = False\r
- If WScript.Arguments.Count >= 1 Then\r
- If WScript.Arguments(0) = "-sub_test" Then sub_test = True\r
- End If\r
+ \r
+'********************************************************************************\r
+' <<< [SetErrBreak] >>> \r
+'********************************************************************************\r
+Sub SetErrBreak( ErrID, RaiseID )\r
+ g_Err2.BreakErrID = ErrID\r
+ g_Err2.BreakRaiseID = RaiseID\r
+End Sub\r
\r
- If Not sub_test Then echo "Test Start"\r
\r
- Test_nPass = 0\r
- Test_nSkip = 0\r
- Test_nNG = 0\r
+ \r
+'********************************************************************************\r
+' <<< [BreakByID] >>> \r
+'********************************************************************************\r
+Sub BreakByID\r
+ If g_Err2.ErrID = g_Err2.BreakErrID And g_Err2.RaiseID >= g_Err2.BreakRaiseID Then\r
+ echo "ErrID = " & g_Err2.ErrID & ", RaiseID = " & g_Err2.RaiseID\r
+ Stop\r
+ End If\r
End Sub\r
\r
\r
\r
'********************************************************************************\r
-' <<< [Test_do] >>> \r
-' comment\r
-' If test failed, raise E_TestFail, ""\r
+' <<< [NestPos] >>> \r
'********************************************************************************\r
-Sub Test_do( ByVal vbs_path, ByVal func, ByVal param )\r
- echo "=========================================================="\r
- echo "Test: " & vbs_path & " - " & func & " " & param\r
+Class NestPos\r
+ Public m_HereArr()\r
\r
- On Error Resume Next\r
- call_vbs vbs_path, func, param\r
- e.Copy( Err ) : On Error GoTo 0 : If e.num <> 0 Then\r
- if e.num = vbObjectError Then\r
- echo "[SKIP] " & e.Description\r
- Test_nSkip = Test_nSkip + 1\r
- Else\r
- e.Echo\r
- Test_nNG = Test_nNG + 1\r
- End If\r
- e.Clear\r
- Else\r
- Test_nPass = Test_nPass + 1\r
- echo "Pass."\r
- End If\r
+ Private Sub Class_Initialize ' \83R\83\93\83X\83g\83\89\83N\83^\r
+ Redim m_HereArr(0)\r
+ m_HereArr(0) = 0\r
+ End Sub\r
\r
-End Sub\r
+ Public Function GetPos( arr )\r
+ Dim u, i\r
+ u = UBound( m_HereArr )\r
+\r
+ Redim Preserve arr(u-1)\r
+\r
+ For i=0 To u-1\r
+ arr(i) = m_HereArr(i)\r
+ Next\r
+ End Function\r
+\r
+ Public Sub OnBlockStart\r
+ Dim u\r
+ u = UBound( m_HereArr )\r
+ m_HereArr(u) = m_HereArr(u) + 1\r
+ Redim Preserve m_HereArr(u+1)\r
+ m_HereArr(u+1) = 0\r
+ End Sub\r
+\r
+ Public Sub OnBlockEnd\r
+ Redim Preserve m_HereArr( UBound( m_HereArr ) - 1 )\r
+ End Sub\r
+End Class\r
\r
\r
\r
'********************************************************************************\r
-' <<< [Test_exe] >>> \r
-'comment\r
-' - func and param is dummy.\r
+' <<< [GetErrStr] >>> \r
'********************************************************************************\r
-Sub Test_exe( ByVal vbs_path, ByVal func, ByVal param )\r
+Function GetErrStr( en, ed, es )\r
+ If en = 0 Then\r
+ GetErrStr = "no error"\r
+ Else\r
+ Dim n\r
+ If en > 0 And en <= &h7FFF Then n = &h800A0000 + en Else n = en\r
+ GetErrStr = "[ERROR] " & Hex(n) & " " & ed & " " & es\r
+ End If\r
+End Function\r
\r
- On Error Resume Next\r
- call_vbs_exe vbs_path\r
- e.Copy( Err ) : On Error GoTo 0 : If e.num <> 0 Then\r
- if e.num = vbObjectError Then\r
- echo "[SKIP] " & e.Description\r
- Test_nSkip = Test_nSkip + 1\r
+\r
+ \r
+'********************************************************************************\r
+' <<< [TryStart] >>> \r
+'********************************************************************************\r
+Function TryStart( e )\r
+ Set e = g_Err2\r
+ If g_debug Then\r
+ If e.ErrID >= e.BreakErrID - 1 Then\r
+ TryStart = False\r
Else\r
- e.Echo\r
- Test_nNG = Test_nNG + 1\r
+ TryStart = True\r
End If\r
- e.Clear\r
Else\r
- Test_nPass = Test_nPass + 1\r
+ TryStart = True\r
End If\r
-\r
-End Sub\r
+End Function\r
\r
\r
\r
'********************************************************************************\r
-' <<< [Test_skip] >>> \r
+' <<< [Trying] >>> \r
'********************************************************************************\r
-Sub Test_skip( ByVal desc )\r
- Err.Raise vbObjectError, "VBSLib", desc\r
-End Sub\r
+Function Trying\r
+ Trying = (Err.Number=0)\r
+End Function\r
\r
\r
\r
'********************************************************************************\r
-' <<< [Test_finish] >>> \r
+' <<< [TryEnd] >>> \r
'********************************************************************************\r
-Sub Test_finish\r
- Dim sub_test ' Boolean\r
+Function TryEnd\r
+' Do not have parameters.\r
+' Because "If TryEnd(e) Then On Error Goto 0" cannot get error, if e is not Dim.\r
\r
- sub_test = False\r
- If WScript.Arguments.Count >= 1 Then\r
- If WScript.Arguments(0) = "-sub_test" Then sub_test = True\r
- End If\r
-\r
- If sub_test Then\r
- echo "=========================================================="\r
- echo "Test Finish (Pass=" & Test_nPass & ", SKIP=" & Test_nSkip & ", ERROR=" & Test_nNG & ")"\r
- Else\r
- If Test_nNG = 0 Then WScript.Quit 0 Else WScript.Quit 1 End If\r
- End If\r
-\r
- g_log = Empty\r
-End Sub\r
+ If Err.Number <> 0 Then g_Err2.Copy Err\r
+ If g_debug = 1 Then TryEnd = False Else TryEnd = True\r
+End Function\r
\r
\r
\r
+'********************************************************************************\r
+' <<< [chk_exist_in_lib] >>> \r
+' comment\r
+' - If there is not path in vbslib folder, raise error of E_FileNotExist.\r
+'********************************************************************************\r
+Sub chk_exist_in_lib( ByVal path )\r
+ If not exist( g_vbslib_folder + path ) Then Err.Raise E_FileNotExist,, _\r
+ "Not found """ + g_vbslib_folder + path + """"\r
+End Sub\r
+ \r
OSDN Git Service
