小物ツール

前のページに戻る

リハビリ兼ねてます。

WSH+VBSを利用したツール

Timer.Vbs

'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
'名前：Timer.Vbs
'Ver.：2003/12/28
'内容：指定の時間になったらメッセージボックスを表示します。
'補足：引数での指定もできます。
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
 
'宣言
Set objArgs   = WScript.Arguments
 
'入力
If ObjArgs.Count=0 Then 
    InpData=inputbox("時間を入力してください。"+chr(13)+"（例1） 3    ※3分後"+chr(13)+"（例2）14:20 ※14時20分")
ElseIf ObjArgs.Count=1 Then 
    InpData=ObjArgs(0)
Else
    MsgBox "引数を1つ以上指定することは出来ません。"
End If
 
'待つ
If InpData<>"" Then 
    If IsDate(InpData)=True Then
        CallTime=CDate(InpData)
    Else
        CallTime=DateAdd("n",CInt(InpData),Time)
    End If
    Do While Time<CallTime
        WScript.Sleep 100
    Loop
    Msgbox "時間になりました。",4096
End If


SendOpen.Vbs

'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
'名前：SendOpen.Vbs
'Ver.：2003/12/28
'内容：送られたファイルが存在するフォルダを開く。予めSendToに置いておくこと。
'補足：スタートメニューの『検索』結果などに使用すると便利。
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
 
Set objArgs   = WScript.Arguments
Set FSO       = WScript.CreateObject("Scripting.FileSystemObject")
Set WshShell  = WScript.CreateObject("WScript.Shell")
 
Call Main
 
Set objargs  = Nothing
Set FSO      = Nothing
Set WshShell = Nothing
 
Sub Main
    '引数の処理
    If objArgs.Count=0 Then 
        MsgBox"このスクリプトは『送る』メニューなどにショートカットを登録して使ってください"
        Exit Sub
    ElseIf objArgs.Count>1 Then 
        RET=MsgBox(CStr(objArgs.Count)+"個のファイルを同時に開きますか？",vbYesNo)
        If RET<>vbYes Then Exit Sub
    End If
    
    '実行
    For Each Obj In objargs
        If Instr(ObjList,vbCr+Obj+vbCr)=0 Then 
            WshShell.Run "explorer "+FSO.GetParentFolderName(Obj)
            ObjList=ObjList+VbCr+Obj+VbCr
        End If
    Next
End Sub


BackCopy.Vbs

'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
'名前：BackCopy.Vbs
'Ver.：2003/12/28
'内容：同フォルダにバックアップを取ります。
'補足：ファイル名に実施日時が付加されます。
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
 
Set FSO     = WScript.CreateObject("Scripting.FileSystemObject")
Set objArgs = WScript.Arguments
 
If objArgs.Count=0 Then 
    MsgBox"このスクリプトは『送る』メニューなどにショートカットを登録して使ってください"
ElseIf objArgs.Count<>0 Then 
    For Each FName In ObjArgs
        FolderName = FSO.GetParentFolderName(FName)
        BaseName   = FSO.GetBaseName(FName)
        ExtName    = FSO.GetExtensionName(FName)
        TimeString = CStr(Year(Now))+"年"+CStr(Month(Now))+"月"+CStr(Day(Now))+"日"+ _
                     CStr(Hour(Now))+"時"+CStr(Minute(Now))+"分"+CStr(Second(Now))+"秒"
        NewName    = FSO.BuildPath(FolderName,BaseName+"("+TimeString+")."+ExtName)
'        msgbox FName+CHr(13)+NewName
        FSO.CopyFile FName,NewName
    Next
End If


ReExt.Vbs

'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
'名前：ReExt.Vbs
'Ver.：2003/12/28
'内容：拡張子の変更。一括変更もできます。
'補足：Exploler使用者には無用かも。
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
 
Set ObjArgs = WScript.Arguments
Set FSO     = WScript.CreateObject("Scripting.FileSystemObject")
 
Call Main
 
Set ObjArgs = Nothing
Set FSO     = Nothing
 
Sub Main
    if objArgs.Count=0 then 
        msgbox"このスクリプトは『送る』メニューなどにショートカットを登録して使ってください"
        Exit Sub
    End If
    Std=FSO.GetExtensionName(ObjArgs(0))
    For Each FName In ObjArgs
        If UCase(FSO.GetExtensionName(FName))<>UCase(Std) Then
            MsgBox"一斉変換は同一の拡張子が指定されている場合にしか行えません。"
            Exit Sub
        End If
    Next
    
    NewExt=InputBox("新しい拡張子を入力してください。"+chr(13)+"（対象ファイル数="+CStr(ObjArgs.Count)+"）",,Std)
    If NewExt="" Then Exit Sub
    
    For Each FName In ObjArgs
        NewName=FSO.BuildPath(FSO.GetParentFolderName(FName),FSO.GetBaseName(FName)+"."+NewExt)
        Fso.MoveFile FName,NewName
'        MsgBox FName+Chr(13)+NewName
    Next
    msgbox "処理を完了しました。"
End Sub


WSH+VBSを利用したコマンドラインツール

TextProc.Vbs

'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
'名前：TextProc.Vbs
'Ver.：2003/12/14
'内容：標準入力を加工して標準出力します。VBSの命令がほぼ使えます。
'補足：コマンドラインでのみ実行可能。
'例１：cscript textproc.vbs /?
'例２：Type C:\Autoexec.Bat | CScript /Nologo textproc.vbs "cmdLine='>'+cmdline"
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
 
'宣言
Set objArgs   = WScript.Arguments '
Set objOutput = WScript.StdOut
Set objInput  = WScript.StdIn
Set objErr    = WScript.StdErr
Set FSO       = WScript.CreateObject("Scripting.FileSystemObject")
 
'実行
Call Main
 
'後片付け
objOutput.Close          'ストリームを閉じる
objInput.Close
objErr.Close
Set objArgs   = Nothing  'オブジェクトの解放
Set objOutput = Nothing
Set objInput  = Nothing
Set objErr    = Nothing
Set FSO       = Nothing
 
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Sub Main
    'コマンドラインの解釈
    if objArgs.Count=0 then ShowHelp:Exit Sub
    For Each arg In objArgs
        AnalyzeCommandLine arg,IsOpt,OptType,OptData
        If IsOpt=True Then
            Select Case OptType
            Case "c"
                If Code<>"" Then
                    objErr.WriteLine "コマンドを多重に指定しています。-'"+OptData+"'":Exit Sub
                ElseIf FSO.FileExists(OptData)=False Then 
                    objErr.WriteLine "ファイルが見つかりません。-'"+OptData+"'":Exit Sub
                Else
                    Set TFS=FSO.OpenTextFile(OptData,ForReading)
                    Code=TFS.ReadAll
                    TFS.Close
                    Set TFS=Nothing
                End If
            Case "i"
                If FSO.FileExists(OptData)=False Then 
                    objErr.WriteLine "ファイルが見つかりません。-'"+OptData+"'":Exit Sub
                Else
                    Set TFS=FSO.OpenTextFile(OptData,ForReading)
                    Src=TFS.ReadAll
                    TFS.Close
                    Set TFS=Nothing
                End If
            Case "?"
                ShowHelp:Exit Sub
            Case Else
                objErr.WriteLine"無効な引数です。-'"+arg+"'":Exit Sub
            End Select
        Else
            If Code<>"" Then
                objErr.WriteLine "コマンドを多重に指定しています。-'"+OptData+"'":Exit Sub
            End If
            Code=arg
            Code=Replace(Code,"'",chr(34))
            Code=Replace(Code,"|",vbCrLf)
        End If
    next
 
    '標準入力
    If Src="" Then Src=objInput.ReadAll
    If Right(Src,2)=vbCrLf Then Src=Left(Src,Len(Src)-2)
 
    '実行
    Line=Split(Src,vbCrLf)
    For Each cmdLine In Line
        flagLine=True
        Execute Code
        If flagLine=True Then 
             objOutput.WriteLine cmdLine
        Else
             objOutput.Write cmdLine
        End If
    Next
    
End Sub
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Sub ShowHelp 'ヘルプの表示
    objOutput.WriteLine "TextProc 2003/12/14"
    objOutput.WriteLine "機能：標準入力を加工して標準出力します。"
    objOutput.WriteLine "引数：CSript textproc.vbs [オプション] [コマンド]"
    objOutput.WriteLine "Opt.：/c[ファイル名] 処理コマンドが記されたファイルを読み込みます。"
    objOutput.WriteLine "      /i[ファイル名] 標準入力ではなくファイルを読みます。"
    objOutput.WriteLine " 例 ：Type C:\Autoexec.Bat | CScript /Nologo " + _
                        "textproc.vbs ""cmdLine='>'+cmdline"""
    objOutput.WriteLine "文法：VBSに準じます。"
    objOutput.WriteLine "      ・/c以外のときは0x22の代わりに ' を使います。"
    objOutput.WriteLine "      ・/c以外のときはCrLfの代わりに | を使います。"
    objOutput.WriteLine "      ・cmdLineが各行の文字列です。代入も可。"
    objOutput.WriteLine "      ・flagLine=Falseでその行は改行を省略します。"
End Sub
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Sub AnalyzeCommandLine(ByVal CmdLine,ByRef IsOpt,ByRef OptType,ByRef OptData) 'コマンドラインの解析
    CmdLine=Trim(CmdLine)
    If Instr("/-",Left(cmdline,1))<>0 Then 
        IsOpt=True
        OptType=LCase(Mid(CmdLine,2,1))
        OptData=Mid(CmdLine,3)
    Else
        IsOpt=False
        OptType=Null
        OptData=Null
    End If
End Sub
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
'                             End Of File.
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=


FileList.Vbs

'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
'名前：FileList.Vbs
'Ver.：2003/12/14
'内容：Dir /b /s のようなもの。
'補足：コマンドラインでのみ実行可能。
'例１：cscript treeview.vbs /?
'例２：cscript treeview.vbs c:\ /d
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
 
'宣言
Public MaxStep,FlagCSV            'Public宣言
Set objArgs   = WScript.Arguments '
Set objOutput = WScript.StdOut
Set objErr    = WScript.StdErr
Set FSO       = WScript.CreateObject("Scripting.FileSystemObject")
MaxStep = 255
 
'実行
Call Main
 
'後片付け
objOutput.Close          'ストリームを閉じる
objErr.Close
Set FSO       = Nothing  'オブジェクトの解放
Set objArgs   = Nothing
Set objOutput = Nothing
Set objErr    = Nothing
 
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Sub Main
    'コマンドラインの解釈
    if objArgs.Count=0 then ShowHelp:Exit Sub
    For Each arg In objArgs
        AnalyzeCommandLine arg,IsOpt,OptType,OptData
        If IsOpt=True Then
            Select Case OptType
            Case "f","d"
                If IsEmpty(modeFolder)=False Then
                    objErr.WriteLine"'/d'と'/f'は併用できません。-'"+arg+"'":Exit Sub
                Else 
                    modeFolder=(OptType="f")-(OptType="d")
                End If
            Case "c"
                flagCSV=True
            Case "n"
                If IsNumeric(OptData)=True Then
                    MaxStep=CLng(OptData)
                Else
                    MaxStep=0
                End If
                If MaxStep<1 or MaxStep>255 Then
                    objErr.WriteLine"'/n'引数の範囲は1〜255です。":Exit Sub
                End If
            Case "?"
                ShowHelp:Exit Sub
            Case Else
                objErr.WriteLine"無効な引数です。-'"+arg+"'":Exit Sub
            End Select
        Else
            TargetFolder=arg
        End If
    next
    
    '検索の下準備
    If TargetFolder="" Then 
        objErr.WriteLine"パスを指定してください。":Exit Sub
    ElseIf FSO.FolderExists(TargetFolder) Then 
        'OK!
    ElseIf FSO.FileExists(TargetFolder) Then 
        objErr.WriteLine"ファイル名は指定できません。":Exit Sub
    Else
        objEr.WriteLine"パスが無効です。":Exit Sub
    End If
    Call ReDir(TargetFolder,modeFolder,0)
    
End Sub
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Sub ShowHelp 'ヘルプの表示
    objOutput.WriteLine "FileList 2003/12/14"
    objOutput.WriteLine "機能：再帰的なファイルリストを標準出力します。"
    objOutput.WriteLine "引数：CSript treeview.vbs [フォルダ名] [オプション]"
    objOutput.WriteLine "Opt.：/f  フォルダは出力しません。"
    objOutput.WriteLine "      /d  フォルダのみ出力します。"
    objOutput.WriteLine "      /n3 3階層先までチェックします。範囲は1〜255。"
    objOutput.WriteLine "      /c  階層ごとにCSV区切りを付けます。"
End Sub
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Sub ReDir(TargetFolder,modeFolder,NowStep) '再帰検索を標準出力へ
    If NowStep>=MaxStep Then Exit Sub
    Set FO=FSO.GetFolder(TargetFolder)
    Set FiL=FO.Files
    Set FoL=FO.SubFolders
    If modeFolder<>1 then 
        For Each q In FiL
            WriteLine q.Path
        Next
    End If
    For Each q In FoL
        If modeFolder<>-1 then WriteLine q.Path
        Call ReDir(q.Path,modeFolder,NowStep+1)
    Next
    Set FO  = Nothing
    Set FiL = Nothing
    Set FoL = Nothing
End Sub
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Sub WriteLine(ByVal arg1)
    If flagCSV=True Then 
        objOutput.WriteLine chr(34)+Replace(arg1,"\",chr(34)+","+chr(34))+chr(34)
    Else
        objOutput.WriteLine arg1
    End If
End Sub
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Sub AnalyzeCommandLine(ByVal CmdLine,ByRef IsOpt,ByRef OptType,ByRef OptData) 'コマンドラインの解析
    CmdLine=Trim(CmdLine)
    If Instr("/-",Left(cmdline,1))<>0 Then 
        IsOpt=True
        OptType=LCase(Mid(CmdLine,2,1))
        OptData=Mid(CmdLine,3)
    Else
        IsOpt=False
        OptType=Null
        OptData=Null
    End If
End Sub
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
'                             End Of File.
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=


判明している障害

• 簡易ファイラでファイルを複数選択してリネームを試みるとやばい。
• CrFilerで詰めて抽出が機能しない？

前のページに戻る
トップページに飛ぶ