ab.com コミュニティ

コード: 全て選択

'共有メモリの実現で使うAPIの宣言（ファイルマッピング）
Declare Function CreateFileMapping Lib "kernel32" Alias "CreateFileMappingA" ( _
	ByVal hFile As Long, _
	lpAttributes As SECURITY_ATTRIBUTES, _
	ByVal flProtect As DWord, _
	ByVal dwMaximumSizeHigh As DWord, ByVal dwMaximumSizeLow As DWord, _
	ByVal strName As String ) As Long
Declare Function OpenFileMapping Lib "kernel32" Alias "OpenFileMappingA" ( _
	ByVal dwDesiredAccess As DWord, _
	ByVal bInheritHandle As Long, _
	ByVal strName As String ) As Long

Declare Function MapViewOfFile Lib "kernel32" ( _
	ByVal hFileMappingObject As Long, _
	ByVal dwDesiredAccess As DWord, _
	ByVal dwFileOffsetHigh As DWord, ByVal dwFileOffsetLow As DWord, _
	ByVal dwNumberOfBytesToMap As DWord ) As Long
Declare Function UnmapViewOfFile Lib "kernel32" ( ByVal lpBaseAddress As Long ) As Long

Const SECTION_QUERY			= &H0001
Const SECTION_MAP_WRITE		= &H0002
Const SECTION_MAP_READ		= &H0004
Const SECTION_MAP_EXECUTE	= &H0008
Const SECTION_EXTEND_SIZE	= &H0010

Const FILE_MAP_COPY 		= SECTION_QUERY
Const FILE_MAP_WRITE		= SECTION_MAP_WRITE
Const FILE_MAP_READ			= SECTION_MAP_READ
Const FILE_MAP_ALL_ACCESS	= SECTION_ALL_ACCESS

Declare Function FlushViewOfFile Lib "kernel32" ( ByVal lpBaseAddress As Long, ByVal dwNumberOfBytesToFlush As Long ) As Long


Declare Function GetLastError Lib "kernel32" () As DWord '※一般のエラー取得にも利用されます。
Const ERROR_ALREADY_EXISTS	= 183

'-------------------

'今後の多重起動を禁止し、既存の窓をアクティブにする（最前列へ）。
'成功時は識別ハンドル（共有メモリのハンドル）、失敗時（多重起動時）はNULLが返る。
'解除時は、戻り値の識別ハンドルをNoMultipleBootButActiveUnset()へ渡す。
'試行関数としてNoMultipleBootButActiveIsBooted()もある。
Function NoMultipleBootButActiveSet( ByVal hTargetWnd As Long, ByVal strMapName As String ) As Long
	Dim pMapWinHandle As Long
	Dim hMapWinHandle As Long
	Dim hMap As Long

	'共有メモリを8Byte確保（※使うのは4Byteだけですが、なんとなく多めに＾＾；）。
	hMap = CreateFileMapping( &Hffffffff , ByVal NULL, _
								PAGE_READWRITE , 0 , 8 , strMapName )
	'共有メモリへの読み書き用ポインタを得る。
	pMapWinHandle = MapViewOfFile( hMap , FILE_MAP_WRITE , 0 , 0 , 0 )

	hMapWinHandle = NULL
	If( GetLastError()=ERROR_ALREADY_EXISTS )Then
		'既に同名（strMapName）の共有メモリが存在していた場合。
		memcpy( ByVal VarPtr(hMapWinHandle), ByVal pMapWinHandle, 4 ) 'トップ4Byteの内容＝窓ハンドルを読み出す。
	Else
		'新規に共有メモリを作成したとき。
		memcpy( ByVal pMapWinHandle, ByVal VarPtr(hTargetWnd), 4 ) 'トップ4Byteに窓ハンドルを書き込む。
	EndIf

	'データのフラッシュ。
	FlushViewOfFile( pMapWinHandle, 4 )
	'共有メモリの読み書き用ポインタを破棄（遅延書き込みで結果が反映される？）。
	UnmapViewOfFile( pMapWinHandle )

	If(	hMapWinHandle<>NULL )Then
		'多重起動時の処理
		NoMultipleBootButActiveSet = NULL
		NoMultipleBootButActive_ActiveBootedWin( hMapWinHandle )
	Else
		'一つ目の起動のとき
		NoMultipleBootButActiveSet = hMap
	EndIf
EndFunction

Function NoMultipleBootButActiveIsBooted( ByVal strMapName As String ) As Long
	Dim pMapWinHandle As Long
	Dim hMapWinHandle As Long
	Dim hMap As Long

	'共有メモリを読み取りモードで呼び出す（成功すれば、多重起動ということ）
	hMap = OpenFileMapping( FILE_MAP_READ, FALSE , strMapName )
	If( hMap<>NULL )Then
		NoMultipleBootButActiveIsBooted = TRUE

		'共有メモリへの読み取り用ポインタを得る。
		pMapWinHandle = MapViewOfFile( hMap , FILE_MAP_READ , 0 , 0 , 0 )
			memcpy( ByVal VarPtr(hMapWinHandle), ByVal pMapWinHandle, 4 ) 'トップ4Byteの内容＝窓ハンドルを読み出す。
		'共有メモリの読み書き用ポインタを破棄。
		UnmapViewOfFile( pMapWinHandle )

		'起動済みの窓をアクティブにする。
		NoMultipleBootButActive_ActiveBootedWin( hMapWinHandle )

	Else
		NoMultipleBootButActiveIsBooted = FALSE
	EndIf
	
EndFunction

'読み出した窓ハンドルをアクティブにする。
Sub NoMultipleBootButActive_ActiveBootedWin( ByVal hMapWinHandle As Long )
		'※最小化以外の非アクティブの場合は、ShowWindow()を受け付けないみたい（Ver2.xのみ？）なので、
		'  SetWindowPos()＋最前面ウィンドウ（WS_EX_TOPMOST）指定の利用によって、最前列に表示させる。
		ShowWindow( hMapWinHandle, SW_SHOWNORMAL ) '最小化の解除。SW_SHOW でもよい？
		SetWindowPos( hMapWinHandle, HWND_TOPMOST or HWND_TOP, -1, -1, -1, -1, SWP_SHOWWINDOW or SWP_NOMOVE or SWP_NOSIZE ) '最前列指定＋Ｚ順位をトップへ変更。
		SetWindowPos( hMapWinHandle, HWND_NOTOPMOST, -1, -1, -1, -1, SWP_SHOWWINDOW or SWP_NOMOVE or SWP_NOSIZE ) '最前列解除
EndSub

'多重起動の禁止を解除する。
Function NoMultipleBootButActiveUnset( ByVal hMap As Long ) As Long
	NoMultipleBootButActiveUnset = CloseHandle( hMap )
EndFunction

コード: 全て選択

Const FileMapName = "多重起動させないでアクティブにする-Test"
Dim hMap As Long

Dim hThisWnd As Long
Dim Message As Long
Dim wParam As Long
Dim lParam As Long
Dim hWnd As Long

If( FALSE=NoMultipleBootButActiveIsBooted( FileMapName ) )Then
	Window hWnd, 0, -1, -1, 320, 240, _
			"多重起動テスト", _
			WS_OVERLAPPEDWINDOW or WS_VISIBLE, "NORMAL"

	hMap = NoMultipleBootButActiveSet( hWnd , FileMapName )

	Message = MessageBeep( MB_OK )
	TargetWnd hWnd
	TextOut 16, 16, Str$(hWnd), 0
	While TRUE
		GetWndMsg hThisWnd, Message, wParam, lParam
		SelectCase Message
				'終了操作
				Case WM_CLOSE
					ExitWhile
		EndSelect
	Wend

	NoMultipleBootButActiveUnset( hMap )
EndIf

DelWnd hWnd
End