SAK 図書館
SAK 図書館
VB テクニック編1 - Windows API、OS 判定、ユーザ取得、初期化ファイル
■SAK 関数利用規程
・テクニック編で紹介する関数は、私こと Y.SAK の開発関数である。
・著作権明示部分の改編は認めない。
・個人、企業がこれらの関数を使用したり、一部を使用して新たなシステムや
プログラムを開発することは自由です。
・但し、これらの関数を一部でも使用しているソフトウェアをシェアウェア、
その他有償プロダクトとして配布・販売するには、私の許可が必要です。
(無償のフリーソフトウェアなら、自由に配布しても良い。)
・これらの関数を使用して発生した、いかなる形での損害も私こと Y.SAK は
賠償しません。
■OS プラットフォーム情報取得
【説明】
・Windows NT 系では、文字列操作 API が UNICODE 対応になっている。
従って、VB から文字列操作 API を呼び出す場合、UNICODE API を呼び出す
かどうか判定する必要がある。
【使い方】
if GetOS() = VER_PLATFORM_WIN32_NT then
msgbox "Windows NT 系"
else
msgbox "Windows 98 系"
end if
'=======================================================================
'** Windows API 構造体宣言
Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
'** Windows API 定数宣言
Public Const VER_PLATFORM_WIN32_WINDOWS = 1
Public Const VER_PLATFORM_WIN32_NT = 2
'** Windows API 定義
Public Declare Function GetVersionExA Lib "kernel32" (verinfo As OSVERSIONINFO) As Long
Public Declare Function GetVersionExW Lib "kernel32" (verinfo As OSVERSIONINFO) As Long
'=======================================================================
' OS プラットフォーム情報取得
'=======================================================================
'【引数】
' なし
'【戻り値】
' long = OS プラットフォーム情報
' VER_PLATFORM_WIN32_WINDOWS = Windows 95、98
' VER_PLATFORM_WIN32_NT = Windows NT
'【処理】
' ・OS バージョン情報を取得して、プラットフォーム情報を返します。
'【著作権】
' GetOS() ver 1.00 Copyright (C) 1999 Y.SAK
'【履歴】
' 1999.04.17 sak ver 1.00 新規作成
'=======================================================================
Public Function GetOS() As Long
Static osinfo As OSVERSIONINFO
Static init As Boolean
Dim rcd As Long
'** OS バージョン情報取得
If init = False Then
osinfo.dwOSVersionInfoSize = LenB(osinfo)
On Local Error Resume Next
If GetVersionExA(osinfo) = False Then osinfo.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS
rcd = Err
On Local Error GoTo 0
If rcd <> 0 Then
If GetVersionExW(osinfo) = False Then osinfo.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS
End If
init = True
End If
'** OS プラットフォーム情報セット
GetOS = osinfo.dwPlatformId
End Function
■ネットワークユーザ名取得
【説明】
・ネットワークログインユーザ名を取得する。
ジョブログの記録などに使用すると良い。
【使い方】
dim s as string
dim i as integer
s = Space(128)
i = GetUserName(s, Len(s))
if i <> 0 then
s = lcase(Trim(Left(s, InStr(s, Chr(0)) - 1)))
else
s = "エラー"
end if
msgbox s
'=======================================================================
'** Windows API 定義
Public Declare Function GetUserNameA Lib "advapi32" (ByVal buf as string, size as long) As Long
Public Declare Function GetUserNameW Lib "advapi32" (ByVal buf as string, size as long) As Long
'=======================================================================
' ネットワークユーザ名取得
'=======================================================================
Public Function GetUserName(buf As string, size As Long) As Long
on local error resume next
If GetOS() = VER_PLATFORM_WIN32_NT Then
GetUserName = GetUserNameW(buf, size)
Else
GetUserName = GetUserNameA(buf, size)
End If
if err <> 0 then
buf = ""
GetUserName = 0
end if
on local error goto 0
End Function
■Windows フォルダ取得
【説明】
・Windows のインストールフォルダ名を取得する。
【使い方】
dim s as string
dim i as integer
s = Space(200)
i = GetWindowsDirectory(s, len(s))
If i = 0 Then
s = ""
else
s = Trim(Left(s, InStr(s, Chr(0)) - 1))
end if
msgbox s
'=======================================================================
'** Windows API 定義
Public Declare Function GetWindowsDirectoryA Lib "kernel32" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Declare Function GetWindowsDirectoryW Lib "kernel32" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
'=======================================================================
' Windows フォルダ取得
'=======================================================================
Public Function GetWindowsDirectory(lpBuffer As String, nSize As Long) As Long
If GetOS() = VER_PLATFORM_WIN32_NT Then
GetWindowsDirectory = GetWindowsDirectoryW(lpBuffer, nSize)
Else
GetWindowsDirectory = GetWindowsDirectoryA(lpBuffer, nSize)
End If
End Function
■初期化文字列取得
【ini ファイル構造】
[セクション名1]
エントリ1=データ
エントリ2=データ
[セクション名2]
エントリ1=データ
エントリ2=データ
確か、セクション名とエントリキーは日本語に対応していなかった。
実際は次のようになる。
[file]
readfile=test1.txt
writefile=test2.txt
[options]
add=yes
user=あいうえお
【説明】
・初期化ファイル(ini) からデータを取得する。
レジストリに記録するのも良いが、レジストリはシステム移行時に問題が多
い。初期化ファイルなら、簡単に新システムに移行することができる。
【使い方】
dim s as string
dim i as integer
dim sec as string
dim ent as string
dim def as string
dim ininame as string
sec = "sectionname"
ent = "entrykey"
def = ""
ininame = curdir() & "\test.ini"
s = Space(200)
i = GetPrivateProfileString(sec, ent, "", s, len(s), ininame)
If i = 0 Then
s = ""
else
s = Trim(Left(s, InStr(s, Chr(0)) - 1))
end if
msgbox s
'=======================================================================
'** Windows API 定義
Public Declare Function GetPrivateProfileStringA Lib "kernel32" (ByVal section As String, ByVal entry As String, ByVal def As String, ByVal buf As String, ByVal size As Long, ByVal ininm As String) As Long
Public Declare Function GetPrivateProfileStringW Lib "kernel32" (ByVal section As String, ByVal entry As String, ByVal def As String, ByVal buf As String, ByVal size As Long, ByVal ininm As String) As Long
'=======================================================================
' 初期化文字列取得
'=======================================================================
Public Function GetPrivateProfileString(section As String, entry As String, def As String, buf As String, size As Long, ininm As String) As Long
If GetOS() = VER_PLATFORM_WIN32_NT Then
GetPrivateProfileString = GetPrivateProfileStringW(section, entry, def, buf, size, ininm)
Else
GetPrivateProfileString = GetPrivateProfileStringA(section, entry, def, buf, size, ininm)
End If
End Function
■初期化文字列書き込み
【説明】
・初期化ファイル(ini) にデータを書き込む。
レジストリに記録するのも良いが、レジストリはシステム移行時に問題が多
い。初期化ファイルなら、簡単に新システムに移行することができる。
【使い方】
dim s as string
dim i as integer
dim sec as string
dim ent as string
dim ininame as string
sec = "sectionname"
ent = "entrykey"
ininame = curdir() & "\test.ini"
s = "data1"
i = WritePrivateProfileString(sec, ent, s, ininame)
If i = 0 Then msgbox "エラー"
msgbox "OK"
'=======================================================================
'** Windows API 定義
Public Declare Function WritePrivateProfileStringA Lib "kernel32" (ByVal section As String, ByVal entry As String, ByVal buf As String, ByVal ininm As String) As Long
Public Declare Function WritePrivateProfileStringW Lib "kernel32" (ByVal section As String, ByVal entry As String, ByVal buf As String, ByVal ininm As String) As Long
'=======================================================================
' 初期化文字列書き込み
'=======================================================================
Public Function WritePrivateProfileString(section As String, entry As String, buf As String, ininm As String) As Long
If GetOS() = VER_PLATFORM_WIN32_NT Then
WritePrivateProfileString = WritePrivateProfileStringW(section, entry, buf, ininm)
Else
WritePrivateProfileString = WritePrivateProfileStringA(section, entry, buf, ininm)
End If
End Function
■VB テクニック編資料
■VB 入門編資料
■VB 基礎編資料
■VB ビジュアル編資料
Copyright (C) 1999-2018 Y.SAK