SAK 図書館

SAK Streets メインストリート 図書館・カフェ 一覧 SAK Streets 検索
| VB | SQL | Perl | PHP | ASP | JSP | C | PC | HP | FAQ | フリーソフト |

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 ビジュアル編資料
| VB | SQL | Perl | PHP | ASP | JSP | C | PC | HP | FAQ | フリーソフト |

SAK Streets メインストリート 図書館・カフェ 一覧 SAK Streets 検索



Copyright (C) 1999-2017 Y.SAK