Attribute VB_Name = "OLInfoGet"
Option Explicit

Global Const SERVICE_NAME = "BuzzScript"
Global Const NONE = 0

' Clipboard formats
Global Const CF_LINK = &HBF00
Global Const CF_TEXT = 1
Global Const CF_BITMAP = 2
Global Const CF_METAFILE = 3
Global Const CF_DIB = 8

Global Const MODAL = 1

' ErrNum (LinkError)
Global Const WRONG_FORMAT = 1
Global Const DDE_SOURCE_CLOSED = 6
Global Const TOO_MANY_LINKS = 7
Global Const DATA_TRANSFER_FAILED = 8

' MousePointer
Global Const DEFAULT = 0
Global Const HOURGLASS = 11

' LinkMode (forms and controls)
Global Const LINK_SOURCE = 1
Global Const LINK_AUTOMATIC = 1
Global Const LINK_MANUAL = 2

' Run time errors
Global Const NO_APP_RESPONDED = 282
Global Const DDE_REFUSED = 285

' Button parameter masks
Global Const LEFT_BUTTON = 1
Global Const RIGHT_BUTTON = 2

Global Const MB_YESNO = 4
Global Const MB_ICONQUESTION = 32
Global Const IDYES = 6

Type SAFEARRAYBOUND
    cElements As Long  ' # of elements in the array dimension
    lLbound   As Long  ' lower bounds of the array dimension
End Type

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal cBytes As Long)
Public Declare Function SafeArrayCreate Lib "oleaut32" (ByVal vt As Integer, ByVal nDims As Long, rgsabound As SAFEARRAYBOUND) As Long 'SAFEARRAY pointer

Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Public Const WM_KEYDOWN = &H100
Public Const WM_KEYUP = &H101

Public Const KEYEVENTF_KEYUP = &H2

Public Declare Function OemKeyScan Lib "user32" (ByVal wOemChar As Integer) As Long
Public Declare Function CharToOem Lib "user32" Alias "CharToOemA" (ByVal lpszSrc As String, ByVal lpszDst As String) As Long
Public Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long

Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpszClassName As String, ByVal lpszWindow As String) As Long
Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long

Public Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
    
'not exytended but invisible keycode. boo, i want your babies in my belly
Public Const keyEscape = &H1
Public Const keyBackspace = &HE
Public Const keyShiftLeft = &H2A
Public Const keyShiftRight = &H36
Public Const keyEnter = &H1C
Public Const keyLeftBrace = &H1A
Public Const keyRightBrace = &H1B
Public Const keyTab = &HF
Public Const keyComma = &H33
Public Const keyPeriod = &H34
Public Const keyQuestion = &H35
Public Const keyAsterisk = &H37

Public Const keyAdd = &H4E
Public Const keySubtract = &H4A

'extended key codes... man.. I love monotony...
Public Const keyControlRight = &H1D
Public Const keyForwardSlash = &H35
Public Const keyAltRight = &H38

Public Const keyHome = &H47
Public Const keyPageUp = &H49
Public Const keyEnd = &H4F
Public Const keyPageDown = &H51
Public Const keyInsert = &H52
Public Const keyDelete = &H53

Public Const VK_APPS = &H5D

Public Const keyArrowUp = &H48
Public Const keyArrowLeft = &H4B
Public Const keyArrowRight = &H4D
Public Const keyArrowDown = &H50
Public MyStr As String

Public WindowHandle As Long
Public Type RECT
  Left    As Long
  Top     As Long
  Right   As Long
  Bottom  As Long
End Type

Public usex$

Public Type POINTAPI
  x       As Long
  y       As Long
End Type

Public Type WINDOWPLACEMENT
  Length            As Long
  flags             As Long
  showCmd           As Long
  ptMinPosition     As POINTAPI
  ptMaxPosition     As POINTAPI
  rcNormalPosition  As RECT
End Type

Public Const LB_SETTABSTOPS = &H192

Public Const GW_HWNDNEXT = 2
Public Const GW_CHILD = 5
Public Const GWW_ID = (-12)

Public Const SW_SHOWNORMAL = 1
Public Const SW_SHOWMINIMIZED = 2
Public Const SW_SHOWMAXIMIZED = 3
Public Const SW_SHOWNOACTIVATE = 4
  
Public Declare Function GetDesktopWindow Lib "user32" () As Long


'Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Public Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long

Public Declare Function GetWindow Lib "user32" _
  (ByVal hwnd As Long, _
   ByVal wCmd As Long) As Long

Public Declare Function GetWindowPlacement Lib "user32" _
  (ByVal hwnd As Long, _
   lpwndpl As WINDOWPLACEMENT) As Long

Public Declare Function GetWindowRect Lib "user32" _
  (ByVal hwnd As Long, _
   lpRect As RECT) As Long

Public Declare Function GetWindowText Lib "user32" _
   Alias "GetWindowTextA" _
  (ByVal hwnd As Long, _
   ByVal lpString As String, _
   ByVal cch As Long) As Long

Public Declare Function GetClassName Lib "user32" _
   Alias "GetClassNameA" _
  (ByVal hwnd As Long, _
   ByVal lpClassName As String, _
   ByVal nMaxCount As Long) As Long

Public Declare Function MoveWindow Lib "user32" _
   (ByVal hwnd As Long, _
    ByVal x As Long, ByVal y As Long, _
    ByVal nWidth As Long, ByVal nHeight As Long, _
    ByVal bRepaint As Long) As Long

Public Declare Function SetWindowPlacement Lib "user32" _
  (ByVal hwnd As Long, _
   lpwndpl As WINDOWPLACEMENT) As Long

Public Declare Function ShowWindow Lib "user32" _
  (ByVal hwnd As Long, _
   ByVal nCmdShow As Long) As Long



Public Sub BuzzWindowHandle(ByVal NewHwnd As Long)
    WindowHandle = NewHwnd
End Sub

Public Function GetNumberOfRows()
    GetNumberOfRows = SendMessage(WindowHandle, 19034, 1, 0)
End Function
Public Function BuzzTitle()
  MyStr = String(GetWindowTextLength(WindowHandle) + 1, Chr$(0))
    'Get the window's text
    GetWindowText WindowHandle, MyStr, Len(MyStr)
    BuzzTitle = MyStr
End Function

Function WinTitle(hwnd)
  MyStr = String(GetWindowTextLength(hwnd) + 1, Chr$(0))
    'Get the window's text
    GetWindowText hwnd, MyStr, Len(MyStr)
    WinTitle = MyStr
End Function

Private Function GetTempDataFolder(ByVal number As Integer) As String
'Dim str As String
'Dim newval As Long
'str = Space$(255)
'newval = GetTempPath(Len(str), str)
'str = Left$(str, newval)
'GetTempDataFolder = str & "opswi" & number & ".tmp"
End Function
Public Function xpos()
Dim dummy
 dummy = SendMessage(WindowHandle, 19034, 12, 0)
    xpos = SendMessage(WindowHandle, 19034, 2, 0) - 1
End Function
Public Function goto_row(dest)
'Dim dummy
'Dim yposy
'Dim ctr
'dbug Str$(WindowHandle)
'ctr = 0
' dummy = SendMessage(WindowHandle, 19034, 12, 0)
'Do While dest <> yposy
'ctr = ctr + 1
'If ctr > 8192 Then MsgBox ("script failure-failed to find row :(")
'If ctr > 8192 Then End
'yposy = SendMessage(WindowHandle, 19034, 1, 0) - 1
'If dbg_disable <> 1 Then dbug "the dest=" & Str$(dest) & " and the current ypos=" & Str$(yposy)
'If yposy > dest Then SendKeys ("{UP}")
'If yposy < dest Then SendKeys ("{DOWN}")
'If mt_disable <> 1 Then DoEvents
'
'Loop

'----------------------------------------------------------
Dim d
For d = 1 To 64
SendKeys ("{PGUP}")
Next d
If dest > 0 Then

For d = 2 To dest
SendKeys ("{DOWN}")
Next

End If
End Function
Public Function ypos()
Dim dummy
 dummy = SendMessage(WindowHandle, 19034, 12, 0)
    ypos = SendMessage(WindowHandle, 19034, 1, 0) - 1
End Function

Public Function GetNumberOfTracks()
    GetNumberOfTracks = SendMessage(WindowHandle, 19034, 2, 0)
End Function

Public Function BlockStart()
        BlockStart = SendMessage(WindowHandle, 19034, 4, 0)
End Function

Public Function BlockEnd()
        BlockEnd = SendMessage(WindowHandle, 19034, 5, 0)
End Function


Public Function GlobalExist()
        GlobalExist = SendMessage(WindowHandle, 19034, 6, 0)
End Function

Public Function NoteUnderCursor()
NoteUnderCursor = SendMessage(WindowHandle, 19034, 7, 0)
End Function
Function FindWindowLike(hWndArray() As Long, _
                        ByVal hWndStart As Long, _
                        WindowText As String, _
                        Classname As String) As Long
   
    Dim hwnd As Long
    Dim sWindowText As String
    Dim sClassname As String
    Dim r As Long
      
   'Hold the level of recursion and
   'hold the number of matching windows
    Static level As Long
    Static found As Long
  
   'Initialize if necessary
    If level = 0 Then
      found = 0
      ReDim hWndArray(0 To 0)
      If hWndStart = 0 Then hWndStart = GetDesktopWindow()
    End If
  
   'Increase recursion counter
    level = level + 1
  
   'Get first child window
    hwnd = GetWindow(hWndStart, GW_CHILD)

    Do Until hwnd = 0
      
       'Search children by recursion
        Call FindWindowLike(hWndArray(), hwnd, WindowText, Classname)
      
       'Get the window text and class name
        sWindowText = Space(255)
        r = GetWindowText(hwnd, sWindowText, 255)
        sWindowText = Left(sWindowText, r)
        
        sClassname = Space(255)
        r = GetClassName(hwnd, sClassname, 255)
        sClassname = Left(sClassname, r)
      
       'Check that window matches the search parameters
        If (sWindowText Like WindowText) And (sClassname Like Classname) Then
         
            found = found + 1
            ReDim Preserve hWndArray(0 To found)
            hWndArray(found) = hwnd
            usex$ = sWindowText

        End If
      
       'Get next child window
        hwnd = GetWindow(hwnd, GW_HWNDNEXT)
        
    Loop
  
   'Decrement recursion counter
    level = level - 1
  
   'Return the number of windows found
    FindWindowLike = found

End Function

Function FindWindowName(srch$)
Dim hwnds() As Long
Dim rlim As Long

rlim = FindWindowLike(hwnds(), 0, srch$, "*")
  FindWindowName = rlim
End Function

