コンピュータ名・ユーザー名を取得!!

セキュリティ・利用ログ等に使用できる(かなぁ(^^;))


'===========================================================================
'    ファイル名    : 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