'===========================================================================
' ファイル名 : basGetComputerAndUserName.bas
' ファイル説明 : コンピュータ名とユーザー名を取得
' 作成者 : Uz
' 作成日 : 1998/02/10 (Tue)
' 修正日 : 1998/02/10 (Tue)
' 備考 : なし
'===========================================================================
Option Explicit
' -- API 関数宣言
Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" ( _
ByVal lpBuffer As String, _
nSize As Long _
) As Long
Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" ( _
ByVal lpBuffer As String, _
nSize As Long _
) As Long
'///////////////////////////////////////////////////////////////////////////
' 関数名 : GetComputerNameString
' 目的説明 : コンピュータ名を取得
' 前提条件 : なし
' 結果 : なし
' 引数 : なし
' 戻り値 : String : コンピュータ名を返す
' 備考 ; なし
'///////////////////////////////////////////////////////////////////////////
Public Function GetComputerNameString() As String
Dim strName As String * 256 '文字列バッファ
Dim lngSize As Long '文字列の長さ
Dim lngRet As Long 'API関数の戻り値
On Error GoTo ErrorHandle
lngSize = Len(strName) - 1 '文字列バッファサイズを設定
lngRet = GetComputerName(strName, lngSize) 'API関数によりコンピュータ名を取得
If lngRet = 0 Then
'エラーが発生した場合
GetComputerNameString = ""
Else
'API関数正常終了
GetComputerNameString = Left(strName, lngSize) '有効文字列のみを返す
'GetUserNameは第2引数にヌル文字を省いた文字数を格納する
End If
ErrorHandle:
'エラーが発生した場合
GetComputerNameString = ""
End Function
'///////////////////////////////////////////////////////////////////////////
' 関数名 : GetUserNameString
' 目的説明 : ユーザー名を取得
' 前提条件 : なし
' 結果 : なし
' 引数 : なし
' 戻り値 : String : ユーザー名を返す
' 備考 ; なし
'///////////////////////////////////////////////////////////////////////////
Public Function GetUserNameString() As String
Dim strName As String * 256 '文字列バッファ
Dim lngSize As Long '文字列の長さ
Dim lngRet As Long 'API関数の戻り値
On Error GoTo ErrorHandle
lngSize = Len(strName) - 1 '文字列バッファサイズを設定
lngRet = GetUserName(strName, lngSize) 'API関数によりコンピュータ名を取得
If lngRet = 0 Then
'エラーが発生した場合
GetUserNameString = ""
Else
'API関数正常終了
GetUserNameString = Left(strName, lngSize - 1) '有効文字列のみを返す
'GetUserNameは第2引数にヌル文字を含めた文字数を格納する
End If
ErrorHandle:
'エラーが発生した場合
GetUserNameString = ""
End Function
'===========================================================================
' ファイル名 : frmTest.frm
' ファイル説明 : コンピュータ名とユーザー名を取得関数をテスト
' 作成者 : Uz
' 作成日 : 1998/02/10 (Tue)
' 修正日 : 1998/02/10 (Tue)
' 備考 : なし
'===========================================================================
Option Explicit
Private Sub FormLoad()
Call MsgBox("コンピュータ名:" & vbTab & GetComputerNameString & vbCrLf & _
"ユーザー名:" & vbTab & GetUserNameString)
End Sub
|