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