home *** CD-ROM | disk | FTP | other *** search
/ DOS/V Power Report 1998 January (DVD) / VPR980100.ISO / OLS / WIN16 / ESAVER04 / ESAVER04.LZH / ESSRC04.LZH / EXESAVER.BAS < prev    next >
BASIC Source File  |  1995-06-03  |  11KB  |  284 lines
  1. Option Explicit
  2.  
  3. 'カーソルの表示状態を変更する
  4. Declare Function ShowCursor Lib "User" (ByVal fShow As Integer) As Integer
  5. 'fShow      : True の時、表示カウンタを１増やします。その他の場合は表示カウンタを１減らします。
  6. '戻り値：　設定後の表示カウンタがセットされます。
  7.  
  8. 'POINT構造体
  9. Type POINTAPI
  10.     X As Integer
  11.     Y As Integer
  12. End Type
  13. 'カーソルの位置取得
  14. Declare Sub GetCursorPos Lib "User" (lpPOINT As POINTAPI)
  15. '引数    : lpPOINT : POINT構造体へのポインタ
  16. '戻り値  : なし
  17.  
  18. 'マウスカーソルを新しい位置に移す
  19. Declare Sub SetCursorPos Lib "User" (ByVal X As Integer, ByVal Y As Integer)
  20. '引数    : X マウスカーソルの水平位置（スクリーン座標）
  21. '          Y マウスカーソルの垂直位置（スクリーン座標）
  22.  
  23. 'プロファイル(INI File)への書き込み
  24. Declare Function WritePrivateProfileString Lib "Kernel" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpString As String, ByVal lpFileName As String) As Integer
  25. '引数    : In  lpAppName  アプリケーションの名称(セクションのタイトル)であるNULLで終わる
  26. '文字列 lpKeyName  キーの名前となるNULLで終わる文字列
  27. '       lpString   既存のキー名と置き換える新しい文字列
  28. '       lpFileName 初期化ファイルの名前となる文字列
  29.  
  30. 'セクション削除用に設定したWritePrivateProfileString  lpKeyName と lpFileName が Any
  31. Declare Function WritePrivateProfileDelSection% Lib "Kernel" Alias "WritePrivateProfileString" (ByVal lpAppName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String)
  32.     'lpAppNameはINI Fileのセクション名  ByVal 0& を指定
  33.     'lpKeyNameはINI FileのKeyアイテム（なんたら=　のなんたら）  ByVal 0& を指定
  34.     'lpStringは書き込む内容
  35.     'lpFNameはINI Fileのフルパス
  36.  
  37. 'プロファイル(INI File)の読み込み(文字列)
  38. Declare Function GetPrivateProfileString Lib "Kernel" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpRetStr As String, ByVal nSize%, ByVal lpFName As String) As Integer
  39. '引数    : In  lpAppName  アプリケーションの名称(セクションのタイトル)であるNULLで終わる
  40. '文字列 lpKeyName  キーの名前となるNULLで終わる文字列
  41. '       lpDefault  指定された初期化ファイル内にみつからない時のデフォルト値
  42. '       nSize      バッファにコピーする文字数(最後のNULLを含む)
  43. '       lpFileName 初期化ファイルの名前となる文字列
  44. '       Out lpRetStr   文字列を受け取るバッファ
  45. '戻り値  : バッファにコピーされた(終端のNULLを含まない)文字数
  46.  
  47.  
  48. 'INIファイルの数値読み込み用
  49. Declare Function GetPrivateProfileInt% Lib "Kernel" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal nDefault%, ByVal lpFileName As String)
  50.     'lpAppNameはINI Fileのセクション名
  51.     'lpKeyNameはINI FileのKeyアイテム（なんたら=　のなんたら）
  52.     'lpDefaultはKeyがないときのデフォルト
  53.     'lpFNameはINI Fileのフルパス
  54.  
  55. 'Windows Dir の取得
  56. Declare Function GetWindowsDirectory Lib "Kernel" (ByVal lpBuffer As String, ByVal nSize As Integer) As Integer
  57. '引数    :lpBuffer ディレクトリ名が入るバッファ（最長の場合を予想)少なくとも nSize 必要nSize バッファにコピーする最大文字数
  58. '戻り値  : lpBuffer に書き込まれる文字数
  59.  
  60. 'ウインドウハンドルを次々検索
  61. Declare Function GetWindow% Lib "User" (ByVal hWnd%, ByVal wFlag%)
  62. '引数    : In  hWnd       検索の基準となるウィンドウハンドル
  63. '              wFlag      検索方向
  64. '返り値　ウインドウハンドル
  65. 'wFlag
  66. Const GW_HWNDFIRST = 0
  67. Const GW_HWNDLAST = 1
  68. Const GW_HWNDNEXT = 2     '(0x0002):次のウィンドウハンドルを検索します
  69. Const GW_HWNDPREV = 3     '(0x0003):前のウィンドウハンドルを検索します
  70. Const GW_OWNER = 4
  71. Const GW_CHILD = 5
  72.  
  73. 'GetWindowWord 指定されたウィンドウの補足ウィンドウメモリ内にある、指定されたオフセットのワード値を取得
  74. Declare Function GetWindowWord Lib "User" (ByVal hWnd As Integer, ByVal nIndex As Integer) As Integer
  75. '引数 hWnd:ウインドウハンドル nIndex:バイトオフセット
  76. 'nIndex
  77. Const GWL_WNDPROC = (-4)
  78. Const GWW_HINSTANCE = (-6)
  79. Const GWW_ID = (-12)
  80. '返り値 各nIndexに対応した値
  81.  
  82. 'GetModuleUsage
  83. Declare Function GetModuleUsage Lib "Kernel" (ByVal hModule As Integer) As Integer
  84. '引数 モジュールのインスタンスハンドル
  85.  
  86. 'ウインドウの位置を指定する
  87. Declare Function SetWindowPos Lib "User" (ByVal hWnd As Integer, ByVal hWndInsertAfter As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal cx As Integer, ByVal cy As Integer, ByVal wFlags As Integer) As Integer
  88. '引数    : hWnd 影響を受けるウィンドウのハンドル
  89. '　　　　  hWndInsertAfter hWnd が挿入される次のウィンドウのハンドル
  90. '　　　　　X 移動後のhWndの左上隅の水平位置
  91. '　　　　　Y 移動後のhWndの左上隅の垂直位置
  92. '　　　　　cx 変更後のhWndウィンドウの幅
  93. '　　　　　cy 変更後のhWndウィンドウの高さ
  94. '　　　　　wFlags 下に示すフラグの任意の組み合わせ．Or 演算子を使って指定．
  95. '戻り値  : なし
  96. ' SetWindowPos Flags
  97. Global Const HWND_TOPMOST = -1
  98. Global Const HWND_NOTOPMOST = -2
  99. Global Const SWP_NOSIZE = &H1
  100. Global Const SWP_NOMOVE = &H2
  101. Global Const SWP_NOZORDER = &H4
  102. Global Const SWP_NOREDRAW = &H8
  103. Global Const SWP_NOACTIVATE = &H10
  104. Global Const SWP_DRAWFRAME = &H20
  105. Global Const SWP_SHOWWINDOW = &H40
  106. Global Const SWP_HIDEWINDOW = &H80
  107. Global Const SWP_NOCOPYBITS = &H100
  108. Global Const SWP_NOREPOSITION = &H200
  109.  
  110. 'ウインドウにメッセージを送って、すぐにもどる
  111. Declare Function PostMessage Lib "User" (ByVal hWndVB As Integer, ByVal wMsg As Integer, ByVal wParam As Any, ByVal lParam As Any) As Integer    ' As Integer
  112. '引数    : In hWndVB% メッセージを送るウィンド
  113. '             wMsg%   メッセージタイプ
  114. '             wParam% メッセージの付加情報その１
  115. '             lParam& メッセージの付加情報その２
  116. '戻り値  : 正常 メッセージが送られれば 0 以外 異常 0 (メッセージが送られなかった)
  117. 'メッセージ
  118. Global Const WM_SYSCOMMAND = &H112
  119. Global Const SC_CLOSE = &HF060
  120. Global Const WM_CLOSE = &H10
  121.  
  122. '指定されたモジュールのモジュールハンドルを取得します
  123. Declare Function GetModuleHandle Lib "Kernel" (ByVal lpModuleName As String) As Integer
  124. '引数 lpModuleName    I  モジュールを指定するNULLで終わる文字列
  125. '戻り値  : = NULL  ハンドルが取得できなかった場合の戻り値
  126. '          <> NULL モジュールを識別するハンドル
  127.  
  128. '指定モジュールの参照カウントを返します
  129. Declare Function GetModuleUsage Lib "Kernel" (ByVal hModule As Integer) As Integer
  130. '引数    : hModule モジュールあるいはモジュールのインスタンス
  131. '戻り値  : モジュールの参照カウント
  132.  
  133. '指定されたウィンドウがアイコン状態かどうかを判断する
  134. Declare Function IsIconic% Lib "User" (ByVal hWnd%)
  135. '引数     : In   hWnd  ウィンドウのハンドル
  136. '戻り値   : アイコン状態の場合は０以外の値,それ以外の場合は０を返す
  137.  
  138. '指定されたウィンドウが画面上に存在するかどうかを判定します
  139. Declare Function IsWindowVisible% Lib "User" (ByVal hWnd%)
  140. '引数    : In  hWnd       判定するウィンドウハンドル
  141. '戻り値  : = 0  指定したウィンドウが画面上に存在しない <> 0 指定したウィンドウが画面上に存在する
  142.  
  143. '定数
  144. ' Check Value
  145. Global Const UNCHECKED = 0 ' 0 - 未チェック
  146. Global Const CHECKED = 1   ' 1 - チェック
  147. Global Const GRAYED = 2    ' 2 - 無効
  148.  
  149. 'グローバル変数
  150. Global MoveCheck  'ランダムに動かすかどうか？
  151.  
  152. '変数
  153. Dim RunInstance  '実行したプログラムのインスタンスハンドル（Ｓｈｅｌｌ関数の返り値）
  154. Dim ErrMsg       '表示するエラーメッセージ
  155.  
  156. Function GetRun_hWnd (RunhWnd(), i)
  157. Dim hWndBase, hInstWin
  158.  
  159. i = 0
  160.  
  161. '自分のウインドウを基準として、リストの最初にさかのぼる
  162.     hWndBase = GetWindow(ESMain.hWnd, GW_HWNDFIRST)
  163. '今度はリストの最初から、ウインドウハンドルを取得
  164.     ReDim Preserve RunhWnd(0)
  165.     Do
  166.         hInstWin = GetWindowWord(hWndBase, GWW_HINSTANCE)'インスタンスハンドルの取得
  167.         If hInstWin = RunInstance Then '実行したプログラムのインスタンスハンドルが見つかったら
  168.             If GetWindow(hWndBase, GW_OWNER) = 0 Then  'Ownerか？
  169.                 RunhWnd(0) = hWndBase 'OWnerなら配列の最初にいれる
  170.                 'もしオーナーウインドウがアイコンか見えなければ返り値はFalse,でなければTrue
  171.                 If IsIconic(RunhWnd(0)) = 0 And IsWindowVisible(RunhWnd(0)) <> 0 Then
  172.                     GetRun_hWnd = True
  173.                 Else
  174.                     GetRun_hWnd = False
  175.                 End If
  176.             Else
  177.                 'ウインドウがアイコンでなく見える時だけ取得
  178.                 If IsIconic(RunhWnd(0)) = 0 And IsWindowVisible(RunhWnd(0)) <> 0 Then
  179.                     i = i + 1
  180.                     ReDim Preserve RunhWnd(i)
  181.                     RunhWnd(i) = hWndBase
  182.                 End If
  183.             End If
  184.         End If
  185.         hWndBase = GetWindow(hWndBase, GW_HWNDNEXT) '見つからなければ次へ
  186.     Loop Until hWndBase = 0
  187. End Function
  188.  
  189. Function INIFileName ()
  190.  
  191. Dim Rtn, Buffer As String * 256
  192. Dim WinDir
  193.  
  194. 'Windows Dirの取得
  195.     Rtn = GetWindowsDirectory(Buffer, 512)
  196.     WinDir = LeftB(Buffer, Rtn)
  197.     'プロファイルのフルパスを作成
  198.     If Right$(WinDir, 1) = "\" Then
  199.         INIFileName = WinDir & "Control.INI" & Chr$(0)
  200.     Else
  201.         INIFileName = WinDir & "\" & "Control.INI" & Chr$(0)
  202.     End If
  203.  
  204. End Function
  205.  
  206. Sub Main ()
  207. Dim Rtn, Buffer As String * 512
  208. Dim List, RunEXE, i, RunEXEBody
  209. Dim ScrCenterX, ScrCenterY
  210.  
  211. '多重起動の禁止
  212. If App.PrevInstance <> 0 Then
  213.     End
  214. End If
  215.  
  216. 'コマンドラインオプションのチェック
  217. If Command$ <> "/s" Then 'コマンドラインオプション
  218.     ESSetup.Show       '設定画面を表示
  219.     Exit Sub
  220. End If
  221.  
  222. '設定ファイルを実行
  223.     'プロファイルの取得-何個登録されてるか？
  224.     List = GetPrivateProfileInt("ScreenSaver.EXESaver", "List", 0, INIFileName())
  225.     'Listが０なら登録されていない
  226.     If List = 0 Then
  227.         MoveCheck = "×"
  228.         ESErrBox.Show
  229.         ESErrBox.lblErrMsg.Caption = "プログラムが指定されていません"
  230.         ESMain.Show    'セーバーを起動
  231.         Exit Sub
  232.     End If
  233.     'プロファイルの取得-ランダムに登録実行ファイルを読みだす
  234.     Randomize (Timer)
  235.     i = Int(Rnd * List)
  236.     Rtn = GetPrivateProfileString("ScreenSaver.EXESaver", "Run" & i, "", Buffer, 512, INIFileName())
  237.     MoveCheck = Left$(Buffer, 1)
  238.     RunEXE = Mid$(Buffer, 2, Rtn)
  239.     RunEXEBody = Left$(RunEXE, InStr(RunEXE, " "))
  240.     '実行
  241.     Rtn = Dir(RunEXEBody)
  242.     If Rtn = "" Then
  243.         MoveCheck = "×"
  244.         ESErrBox.Show
  245.         ESErrBox.lblErrMsg.Caption = "指定されたファイルが見つかりません"
  246.         ESMain.Show    'セーバーを起動
  247.         Exit Sub
  248.     End If
  249.  
  250.     Rtn = GetModuleHandle(RunEXEBody)
  251.     If GetModuleUsage(Rtn) >= 1 Then
  252.         MoveCheck = "×"
  253.         ESErrBox.Show
  254.         ESErrBox.lblErrMsg.Caption = "指定されたファイルは既に起動されています"
  255.         ESMain.Show    'セーバーを起動
  256.         Exit Sub
  257.     End If
  258.  
  259.     RunInstance = Shell(RunEXE, 4)
  260.  
  261.     ESMain.Show    'セーバーを起動
  262.  
  263. End Sub
  264.  
  265. Sub SaverEnd ()
  266. Dim Rtn, RunhWnd(), i
  267.  
  268.     If ESErrBox.Visible = True Then
  269.         Unload ESErrBox
  270.     Else
  271.         Rtn = SetWindowPos(ESErrBox.hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE Or SWP_NOMOVE Or SWP_NOSIZE)
  272.         '実行ファイルのウインドウハンドルを得て
  273.         Rtn = GetRun_hWnd(RunhWnd(), i)
  274.         'セーバーから実行したプログラムにクローズのメッセージを送る
  275.         Rtn = PostMessage(RunhWnd(0), WM_SYSCOMMAND, SC_CLOSE, 0&)
  276.     End If
  277.     'カーソルを表示する
  278.     Rtn = ShowCursor(True)
  279.     '終了
  280.     End
  281.  
  282. End Sub
  283.  
  284.