ник: Волшебник
alvk говорит:
Александр Маркин,
неработаить нифига под Акцесс 2003!
Там было так...
Option Compare Database
Option Explicit
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetWindow Lib "user32" _
(ByVal hWnd As Long, _
ByVal wCmd As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
(ByVal hWnd As Long, _
ByVal lpString As String, _
ByVal aint As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" _
(ByVal hWnd As Long, _
ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" _
(ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Private Const GetWin = 5
Private Const GetWinNext = 2
Private Const GetStyle = (-16)
Private Const GetVisible = &H10000000
Private Const MaxLen = 128
Type WinInfo
strCaption As String
hWnd As Long
strClass As String
End Type
Public Function WindowList()
Dim WI() As WinInfo
Dim blnVisibleOnly As Boolean
Dim hWnd As Long
Dim strCaption As String
Dim lngStyle As Long
Dim intCount As Integer
hWnd = GetDesktopWindow()
hWnd = GetWindow(hWnd, GetWin)
Do While hWnd <> 0
strCaption = GetCaption(hWnd)
If Len(strCaption) > 0 Then
lngStyle = GetWindowLong(hWnd, GetStyle)
If blnVisibleOnly Imp (GetVisible And lngStyle) Then
ReDim Preserve WI(0 To intCount)
WI(intCount).strCaption = strCaption
WI(intCount).hWnd = hWnd
WI(intCount).strClass = ClassName(hWnd)
intCount = intCount + 1
End If
End If
If strCaption = "Сетевые подключения" Then
CloseWindow (hWnd)
End If
hWnd = GetWindow(hWnd, GetWinNext)
Loop
WindowList = intCount
End Function
Public Function GetCaption(hWnd As Long)
Dim strBuffer As String
Dim intLen As Integer
If hWnd <> 0 Then
strBuffer = Space(MaxLen)
intLen = GetWindowText(hWnd, strBuffer, MaxLen)
GetCaption = Left(strBuffer, intLen)
End If
End Function
Private Function ClassName(hWnd As Long)
Dim strBuffer As String
Dim intCount As Integer
strBuffer = Space(MaxLen)
intCount = GetClassName(hWnd, strBuffer, MaxLen)
ClassName = Left(strBuffer, intCount)
End Function
Function CloseWindow(ByVal hWnd As Long)
Const GetClose = &H10
CloseWindow = PostMessage(hWnd, GetClose, 0, vbNullString)
End Function