WSH

  WSH.bas



  
Global WSH As Variant
Global Wshn As Variant
Global WshEnv As Variant
' ******************************************************
' レジストリ読み込み
' ******************************************************
Public Function RegRead( _
    strRoot As String, _
    strPath As String, _
    strName As String _
) As Variant

    WshInit

    RegRead = WSH.RegRead(strRoot & "\" & strPath & "\" & strName)

End Function

' ******************************************************
' レジストリ書き込み
' ******************************************************
Public Function RegWrite( _
    strRoot As String, _
    strPath As String, _
    strName As String, _
    strValue As String, _
    strType As String _
)

    WshInit

    Call WSH.RegWrite(strRoot & "\" & strPath & "\" & strName, strValue, strType)

End Function

' ******************************************************
' レジストリ削除
' ******************************************************
Public Function RegDelete( _
    strRoot As String, _
    strPath As String, _
    strName As String _
)

    WshInit

    Call WSH.RegDelete(strRoot & "\" & strPath & "\" & strName)

End Function

' ******************************************************
' 外部プログラム実行
' ******************************************************
Public Function Run(strPath As String)

    WshInit

    Call WSH.Run(strPath)

End Function

' ******************************************************
' 環境変数取得
' ******************************************************
Public Function GetEnv(strEnv As String)

    Dim strWork

    WshInit

    Set WshEnv = WSH.Environment()
    strWork = WshEnv(strEnv)
    
    If InStr(strWork, "%") <> 0 Then
        strWork = WSH.ExpandEnvironmentStrings(strWork)
    End If
    
    Set WshEnv = Nothing

    GetEnv = strWork

End Function

' ******************************************************
' ユーザ名取得
' ******************************************************
Public Function UserName() As String

    WshInitn

    UserName = Wshn.UserName

End Function

' ******************************************************
' コンピュータ名取得
' ******************************************************
Public Function ComputerName() As String

    WshInitn

    ComputerName = Wshn.ComputerName

End Function

' ******************************************************
' オブジェクト作成(Shell)
' ******************************************************
Public Function WshInit()

    If Not IsObject(WSH) Then
        Set WSH = CreateObject("WScript.Shell")
    End If

End Function

' ******************************************************
' オブジェクト作成(Network)
' ******************************************************
Public Function WshInitn()

    If Not IsObject(Wshn) Then
        Set Wshn = CreateObject("WScript.Network")
    End If

End Function

' ******************************************************
' ネットワークドライブ一覧
' ******************************************************
Public Function WshGetNetworkDrives(Grid As Object)

    Call WshInitn

    Dim cNetwork
    Dim i
    Dim RowCount

    Set cNetwork = Wshn.EnumNetworkDrives
    Grid.Cols = 3
    Grid.Clear
    RowCount = 0
    For i = 0 To cNetwork.Count - 1 Step 2
        Grid.Rows = RowCount + 2
        Grid.TextMatrix(RowCount + 1, 1) = cNetwork.Item(i)
        Grid.TextMatrix(RowCount + 1, 2) = cNetwork.Item(i + 1)
        
        RowCount = RowCount + 1
    Next


End Function

' ******************************************************
' ネットワーク接続
' ******************************************************
Public Function WshMapNetworkDrive( _
    TargetDrive As String, _
    TargetUNC As String, _
    TargetUser As String, _
    TargetPassword As String _
) As Boolean

    Call WshInitn
    
    On Error Resume Next
    Wshn.MapNetworkDrive TargetDrive, TargetUNC, , TargetUser, TargetPassword
    If Err.Number <> 0 Then
        WshMapNetworkDrive = False
    Else
        WshMapNetworkDrive = True
    End If
    
End Function

' ******************************************************
' ネットワーク接続の解除
' ******************************************************
Public Function WshRemoveNetworkDrive(TargetDrive As String)

    Call WshInitn
    
    On Error Resume Next
    Wshn.RemoveNetworkDrive TargetDrive, True
    If Err.Number <> 0 Then
        WshRemoveNetworkDrive = False
    Else
        WshRemoveNetworkDrive = True
    End If
    
End Function

  



  処理サンプル



  
Private Sub Command2_Click()

    Dim ret As Variant
    Dim i As Integer

    ret = RegRead("HKLM", _
            "SOFTWARE\Microsoft\Windows NT\CurrentVersion", _
            "ProductId" _
          )

    If IsArray(ret) Then
        For i = 0 To UBound(ret) - 1
            MsgBox (ret(i))
        Next
    Else
        MsgBox (ret)
    End If

End Sub

Private Sub Command3_Click()

    Call RegWrite("HKLM", _
       "SOFTWARE\Microsoft\Windows NT\CurrentVersion", _
       "TEST", "10", "REG_DWORD" _
    )
    
    Call RegWrite("HKLM", _
       "SOFTWARE\Microsoft\Windows NT\CurrentVersion", _
       "TEST2", "10", "REG_SZ" _
    )

End Sub

Private Sub Command4_Click()

    Call RegDelete("HKLM", _
       "SOFTWARE\Microsoft\Windows NT\CurrentVersion", _
       "TEST" _
    )
    Call RegDelete("HKLM", _
       "SOFTWARE\Microsoft\Windows NT\CurrentVersion", _
       "TEST2" _
    )

End Sub

Private Sub Command5_Click()

    Call Run("notepad.exe")

End Sub

Private Sub Command6_Click()

    MsgBox (UserName)

End Sub

Private Sub Command7_Click()

    MsgBox (ComputerName)

End Sub

Private Sub Command8_Click()

    MsgBox (GetEnv("TMP"))

End Sub

  










  infoboard   管理者用   
このエントリーをはてなブックマークに追加





フリーフォントWEBサービス
SQLの窓WEBサービス

SQLの窓フリーソフト

素材

一般WEBツールリンク

SQLの窓

フリーソフト

JSライブラリ