WSH

WSH

Shell

CopyHere Method

コンソール

VBScript

外部ファイルのインクルード方法

  • Execute ステートメントを使うことで外部ファイルを取り込むことが可能。

サンプル

  • Include.vbs
    Const g_strA = "AAA"
    Const g_strB = "BBB"
  • ExecuteTest.vbs
    Option Explicit
    Main
    
    Sub Main
      Dim fso
      Set fso = CreateObject("Scripting.FileSystemObject")
    
      Dim f
      Set f = fso.OpenTextFile( "d:\home\edu\VBScript\ExecuteTest\include.vbs", 1, False )
      Dim strBuf
      strBuf = f.ReadAll
      WScript.Echo "<内容確認>"
      WScript.Echo strBuf
      Execute strBuf
      WScript.Echo "<Execute の実行結果>"
      WScript.Echo g_strA
      WScript.Echo g_strB
    End Sub
  • 実行結果
    <内容確認>
    Const g_strA = "AAA"
    Const g_strB = "BBB"
    
    <Execute の実行結果>
    AAA
    BBB

FileSystemObject

テキストファイルを連結するサンプル

  • コード
    ' AppendFile.vbs
    ' 使い方:
    ' 1. DIR_SRC にコピー元のファイルがあるフォルダ名を指定します。
    ' 2. DIR_DST にコピー先のフォルダ名を指定します。
    ' 3. FILE_ADD に追加するテキストファイルを記述します。
    ' 4. AppendFile.vbs をダブルクリックします。
    '    DIR_DST の場所に連結されたファイルが作成されます。
    ' 
    Const DIR_SRC = "D:\home\edu\VBScript\AppendFile\src" ' コピー元のフォルダ名
    Const DIR_DST = "D:\home\edu\VBScript\AppendFile\dst" ' コピー先のフォルダ名
    Const FILE_ADD = "D:\home\edu\VBScript\AppendFile\add.txt" ' 追加するテキストファイル
    
    AppendFile
    
    Sub AppendFile
         Dim fso
         Set fso = CreateObject("Scripting.FileSystemObject")
         Dim folder
         Set folder = fso.GetFolder( DIR_SRC )
         Dim strFileName ' コピー元のファイル名が入ります
         Dim txtFile1
         Dim txtFile2
         Dim txtFile3
         Dim strMargeText ' 文字列連結用変数
         For Each strFileName In folder.Files
             Set txtFile1 = fso.OpenTextFile( strFileName, 1, False )
             Set txtFile2 = fso.OpenTextFile( FILE_ADD, 1, False )
             strMargeText = txtFile1.ReadAll & txtFile2.ReadAll
             Set txtFile3 = fso.CreateTextFile( DIR_DST & "\" & fso.GetFileName(strFileName) , True)
             txtFile3.WriteLine( strMargeText )
         Next
    End Sub

ログファイル

ADO

ADOレコードセットをXMLに出力するサンプル

  • コード
    ' RecordsetToXml.vbs
    Const adVarChar = 200
    Const adFldIsNullable = 32
    Const adPersistXML = 1
    Const adReadAll = -1
    
    RecordsetToXml
    
    Sub RecordsetToXml()
        Dim rsTmp
        Set rsTmp = CreateObject("ADODB.Recordset")
        
        With rsTmp.Fields
            .Append "Field1", adVarChar, 80, adFldIsNullable
            .Append "Field2", adVarChar, 80, adFldIsNullable
        End With
        
        rsTmp.Open
    
        Dim vFieldList
        vFieldList = Array("Field1", "Field2")
        Dim vValues
        vValues = Array("aaa", "bbb")
        rsTmp.AddNew vFieldList, vValues
        
        vValues = Array("CCC", "DDD")
        rsTmp.AddNew vFieldList, vValues
        
        rsTmp.MoveFirst
        
        Dim fld
        Dim strLine
        Dim strName
        strLine = ""
        For Each fld In rsTmp.Fields
            strName = fld.Name
            strLine = strLine & strName & vbTab
        Next
        WScript.Echo strLine
        
        Dim strValue
        While Not rsTmp.BOF And Not rsTmp.EOF
            strLine = ""
            For Each fld In rsTmp.Fields
                strValue = fld.Value
                strLine = strLine & "[" & strValue & "]" & vbTab
            Next
            WScript.Echo strLine
            rsTmp.MoveNext
        Wend
        
        Dim stm
        Set stm = CreateObject("ADODB.Stream")
        rsTmp.Save stm, adPersistXML
        Dim strResult
        strResult = stm.ReadText(adReadAll)
        WScript.Echo strResult
    
    End Sub
  • 結果
    <xml xmlns:s='uuid:BDC6E3F0-6DA3-11d1-A2A3-00AA00C14882'
       xmlns:dt='uuid:C2F41010-65B3-11d1-A29F-00AA00C14882'
       xmlns:rs='urn:schemas-microsoft-com:rowset'
       xmlns:z='#RowsetSchema'>
    <s:Schema id='RowsetSchema'>
       <s:ElementType name='row' content='eltOnly' rs:updatable='true'>
           <s:AttributeType name='Field1' rs:number='1' rs:nullable='true'
                rs:write='true'>
               <s:datatype dt:type='string' rs:dbtype='str' dt:maxLength='80'
                rs:precision='0' rs:maybenull='false'/>
           </s:AttributeType>
           <s:AttributeType name='Field2' rs:number='2' rs:nullable='true'
                rs:write='true'>
               <s:datatype dt:type='string' rs:dbtype='str' dt:maxLength='80'
                rs:precision='0' rs:maybenull='false'/>
           </s:AttributeType>
           <s:extends type='rs:rowbase'/>
       </s:ElementType>
    </s:Schema>
    <rs:data>
       <rs:insert>
           <z:row Field1='aaa' Field2='bbb'/>
           <z:row Field1='CCC' Field2='DDD'/>
       </rs:insert>
    </rs:data>
    </xml>

ADO でテキストファイルをソートするサンプル

  • コード
    Option Explicit
    
    Main
    
    Sub Main()
        Dim named
        Set named = WScript.Arguments.Named
        
        Dim strTable
        If named.Exists("file") Then
            strTable = named("file")
            WScript.Echo "Table = [" & strTable & "]"
        Else
            WScript.Echo "Usage : CScript //Nologo SortFile.vbs /File:<filename.txt>"
            WScript.Quit()
        End If
        
        Dim cn
        Set cn = CreateObject("ADODB.Connection")
        With cn
            .Provider = "Microsoft.Jet.OLEDB.4.0"
            .Properties("Data Source") = "."
            .Properties("Extended Properties") =  "TEXT;HDR=No;"
        End With
        cn.Open
        
        Dim strSQL
        strSQL = "SELECT F1 FROM " & strTable & " ORDER BY F1 ASC"
        Dim rs
        Set rs = cn.Execute( strSQL )
        While Not rs.BOF And Not rs.EOF
            WScript.Echo rs(0)
            rs.MoveNext
        Wend
    End Sub

CDO

CDO でメールを送るサンプル。

  • コード
    'SendMailTest.vbs
    Option Explicit
    'On Error Resume Next
    
    const cdoBasic = 1
    const cdoPostUsingPort = 2
    const cdoSendUsingMethod = "http://schemas.microsoft.com/cdo/configuration/sendusing"
    const cdoSMTPServer = "http://schemas.microsoft.com/cdo/configuration/smtpserver"
    const cdoSMTPConnectionTimeout = "http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout"
    const cdoSMTPAuthenticate = "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate"
    const cdoSendUserName = "http://schemas.microsoft.com/cdo/configuration/sendusername"
    const cdoSendPassword = "http://schemas.microsoft.com/cdo/configuration/sendpassword"
    
    Dim iMsg
    Set iMsg = CreateObject("CDO.Message")
    Dim iConf
    Set iConf = CreateObject("CDO.Configuration")
    
    Dim Flds
    Set Flds = iConf.Fields
    
    With Flds
      ' assume constants are defined within script file
      .Item(cdoSendUsingMethod)       = 2 ' cdoSendUsingPort
      .Item(cdoSMTPServer)            = "smtp.example.co.jp"
      .Item(cdoSMTPConnectionTimeout) = 10 ' quick timeout
      .Item(cdoSMTPAuthenticate)      = cdoBasic
      .Item(cdoSendUserName)          = "username"
      .Item(cdoSendPassword)          = "password"
      .Update
    End With
    
    With iMsg
      Set .Configuration = iConf
      .From     = "sender@example.co.jp"
      .To       = "receiver@example.co.jp"
      .Subject  = "test"
      .TextBody = "This is a test."
      .Send
    End With

WMI

メモ帳を終了させるプログラム

  • コード
    ' KillNotepad.vbs
    Main
    
    Sub Main()
      For Each Process In GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery("select * from Win32_Process where Name='NOTEPAD.EXE'") 
         Set oProcess = Process 
         WScript.Echo oProcess.ExecutablePath
         Process.Terminate
      Next
    End Sub

隣のPCでプログラムを実行させる方法。

  • コード
    Set args = Wscript.Arguments
    If args.Count < 1 Then
        Wscript.StdOut.WriteLine "xstart <command> [<computer>]"
    Else
        '--- コマンド指定
        strCommand = args(0)
        '--- コンピュータ指定
        strComputerPath = ""
        If args.Count = 2 Then
            strComputer = args(1)
            If InStr(strComputer, "\\") = 1 Then
                strComputer = Mid(strComputer, 3)
            End If
            strComputerPath = "\\" & strComputer & "\root\cimv2:"
        End If
        '--- WMI に接続 Wim32_Process クラスを取り出す
        Set clsProcess = GetObject("winmgmts:{impersonationLevel=impersonate}" _
            & "!" & strComputerPath & "Win32_Process")
       '--- プロセスの作成
        lngResult = clsProcess.Create(strCommand)
        Wscript.StdOut.WriteLine strCommand & " :" & lngResult
    End If

XML

正規表現

URIを解析するサンプル

  • コード
    Option Explicit
    
    Dim strData
    Dim regExp
    Set regExp = New RegExp
    strData = "http://www.hondarer-soft.com/cx/"
    regExp.Pattern = "(\w+):\/\/([^/:]+)(:\d*)?([^# ]*)"
    
    Dim matches
    Dim match
    Dim strValue
    Dim i
    
    Set matches = regExp.Execute( strData )
    For Each match In matches
        For i = 0 To match.SubMatches.Count -1
            strValue = match.SubMatches(i)
            WScript.Echo "match.SubMatches(" & i & ") = [" & strValue & "]"
        Next
    Next
  • 実行結果
    match.SubMatches(0) = [http]
    match.SubMatches(1) = [www.hondarer-soft.com]
    match.SubMatches(2) = []
    match.SubMatches(3) = [/cx/]

関連リンク

その他

コマンド

Runas

関連リンク


トップ   編集 凍結 差分 バックアップ 添付 複製 名前変更 リロード   新規 一覧 単語検索 最終更新   ヘルプ   最終更新のRSS
Last-modified: 2010-02-27 (土) 14:20:04 (2848d)