010504

タイトル	スクリーンセーバーの情報を取得する
対象言語	VB4.0, Access95以降
動作確認ＯＳ	Windows95,98,NT4.0
使用関数	GetPrivateProfileString SystemParametersInfo
改築日	1998/03/17
Source Download

コントロールパネルで設定している
スクリーンセーバーの設定値を取得します。

スクリーンセーバーの情報（ファイル名、起動ステータス、
起動するまでの待ち時間）をレジストリ及び　
SYSTEM.INI から取得します。

1. フォームを作成し、テキストボックス(Text1)とコマンドボタン（Command1）を貼り付けてください。
2. コマンドボタンのClick時のイベントに下のソースを入力してください。

Option Explicit

Private Sub Command1_Click()

　　 Dim ScrInfo As ScrSaverInfo
　　 Dim text As TextBox
　　 Dim iti(1) As String

　　 iti(0) = "オフ"
　　 iti(1) = "オン"

　　 Set text = Me!Text1

　　 ScrInfo = Y_GetScreenSaverInfo()
　　 text = "ファイル = " & ScrInfo.ScrSaveName & vbCrLf
　　 text = Text1 & "起動 = " & iti(ScrInfo.ScrSaveFlg) & vbCrLf
　　 text = Text1 & "実行までの待ち時間 = " & ScrInfo.ScrSaveTime / 60 & "分"

End Sub

3.モジュールウインドウを作成し、下のソースを入力してください。

Option Explicit

'INIファイルから値を取得する
Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, _
ByVal lpKeyName As Any, ByVal lpDefault As String, _
ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long

'スクリーンセーバー情報を取得する
Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, _
lpvParam As Any, ByVal fuWinIni As Long) As Long

Public Const SPI_GETSCREENSAVEACTIVE = 16 'セーバーが起動ONかを取得
Public Const SPI_GETSCREENSAVETIMEOUT = 14 'セーバー起動までの待ち時間(秒)を取得する

Public Const SPIF_SENDWININICHANGE = &H2

Public Const MAX_PATH = 260

Type ScrSaverInfo
　　 ScrSaveName As String 'スクリーンセーバーファイル名
　　 ScrSaveFlg As Long '0:スクリーンセーバーOFF 1:ON
　　 ScrSaveTime As Long '実行までの待ち時間（秒）
End Type

Public Function Y_GetScreenSaverInfo() As ScrSaverInfo
'***********************************************************
'機能 : スクリーンセーバー設定情報を取得する
'戻り値: スクリーンセーバー情報
'***********************************************************

　　 Dim ScrInfo As ScrSaverInfo
　　 Dim secion As String
　　 Dim file As String

　　 secion = "boot"
　　 file = "SYSTEM.INI"

　　 With ScrInfo
　　　　 .ScrSaveName = Y_GetINIValue(secion, "SCRNSAVE.EXE", MAX_PATH, file)
　　　　 .ScrSaveFlg = Y_GetSystemParameters(SPI_GETSCREENSAVEACTIVE)
　　　　 .ScrSaveTime = Y_GetSystemParameters(SPI_GETSCREENSAVETIMEOUT)
　　 End With

　　 Y_GetScreenSaverInfo = ScrInfo

End Function

Public Function Y_GetINIValue(SecionName As String, KeyName As String, BufSize As Long, INIFile As String) As String
'***********************************************************
'機能 : INIファイルの値を取得する
'引数 :　 SecionName　　= 取得するセッション名
'　　　　　KeyName　　　 = 取得するキー名
'　　　　　BufSize　　　 = データを受け取るバッファの最大サイズ
'　　　　　INIFile = 取得するINIファイルのフルパス
'戻り値: キーの値
'備考　: INIFileにフルパスを指定しなければ Windowsフォルダ
'　　　　がデフォルトになります。
'***********************************************************

　　 Dim StrBuf As String
　　 Dim longret As Long

　　 StrBuf = Space$(BufSize)

'INIファイルから値を取得する
　　 longret = GetPrivateProfileString(SecionName, KeyName, "", StrBuf, BufSize, INIFile)

　　 Y_GetINIValue = BufEdit(StrBuf)

End Function

Public Function BufEdit(Buf As String) As String
'***********************************************************
'機能 : 引数 Bufの文字列中の Nullコードを検索し、Nullコードを
' 除いた文字列を返す
'引数 : Buf = Nullコードを含む文字列
'戻り値: Nullコードを除いた文字列
'***********************************************************

　　 Dim i As Long

　　 i = InStr(Buf, vbNullChar)
　　 If i <> 0 Then
　　　　 BufEdit = Left$(Buf, i - 1)
　　 Else
　　　　 BufEdit = Buf
　　 End If

End Function

Public Function Y_GetSystemParameters(Action As Long) As Long
'***********************************************************
'機能 : GetSystemParametersInfo関数を呼び、指定したアクション
'　　　　の結果を取得する
'引数 : Action = 取得するシステムパラメータ
'戻り値: システムパラメータの値
'***********************************************************

　　 Dim UpdateProfile As Long
　　 Dim pvParam As Long

　　 UpdateProfile = SPIF_SENDWININICHANGE

　　 If SystemParametersInfo(Action, 0, pvParam, UpdateProfile) = 1 Then
　　　　 Y_GetSystemParameters = pvParam
　　 Else
　　　　 Call MsgBox("SystemParametersInfo関数取得に失敗しました。")
　　 End If

End Function