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

  




yahoo  google  MSDN  MSDN(us)  WinFAQ  Win Howto  tohoho  ie_DHTML  vector  wdic  辞書  天気 


[PROvbFunction]
claudebot
24/04/18 14:19:27
InfoBoard Version 1.00 : Language=Perl

1 BatchHelper COMprog CommonSpec Cprog CprogBase CprogSAMPLE CprogSTD CprogSTD2 CprogWinsock Cygwin GameScript HTML HTMLcss InstallShield InstallShieldFunc JScript JScriptSAMPLE Jsfuncs LLINK OldProg OracleGold OracleSilver PRO PRObrowser PROc PROconePOINT PROcontrol PROftpclient PROjscript PROmailer PROperl PROperlCHAT PROphp PROphpLesson PROphpLesson2 PROphpLesson3 PROphpfunction PROphpfunctionArray PROphpfunctionMisc PROphpfunctionString PROsql PROvb PROvbFunction PROvbString PROvbdbmtn PROvbonepoint PROwebapp PROwin1POINT PROwinSYSTEM PROwinYOROZU PROwindows ProjectBoard RealPHP ScriptAPP ScriptMaster VBRealtime Vsfuncs a1root access accreq adsi ajax amazon argus asp aspSample aspVarious aspdotnet aw2kinst cappvariety centura ckeyword classStyle cmaterial cmbin cmdbapp cmenum cmlang cmlistbox cmstd cmstdseed cmtxt cs daz3d db dbCommon dbaccess dnettool dos download flex2 flex3 flex4 framemtn framereq freeWorld freesoft gimp ginpro giodownload google hdml home hta htmlDom ie9svg install java javaSwing javascript jetsql jquery jsp jspTest jspVarious lightbox listasp listmsapi listmsie listmsiis listmsnt listmspatch listmsscript listmsvb listmsvc memo ms msde mysql netbeans oraPlsql oracle oracleWiper oraclehelper orafunc other panoramio pear perl personal pgdojo pgdojo_cal pgdojo_holiday pgdojo_idx pgdojo_ref pgdojo_req php phpVarious phpguide plsql postgres ps r205 realC realwebapp regex rgaki ruby rule sboard sc scprint scquest sdb sdbquest seesaa setup sh_Imagick sh_canvas sh_dotnet sh_google sh_tool sh_web shadowbox shgm shjquery shvbs shweb sjscript skadai skywalker smalltech sperl sqlq src systemdoc tcpip tegaki three toolbox twitter typeface usb useXML vb vbdb vbsfunc vbsguide vbsrc vpc wcsignup webanymind webappgen webclass webparts webtool webwsh win8 winofsql wmi work wp youtube