Portal:AOL-Files/Articles/Add Buddies

(Originally by AOL-Files staff member Tau)

Purpose: This code will add all of the users buddies to a listbox. The code supports multiple categories and lagged connections.

Requirements: This code requires a ListBox named List1 and a Command Button named Command1. Both of these names can be modified in the last Sub.

System: This code will function on Visual Basic versions 5.0 and 6.0, is to be used with no BAS file, and on America Online versions 4.0 and 5.0

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private 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
Private Declare Function GetTickCount& Lib "kernel32" ()
Private Declare Function SendMessageByString Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, ByVal lpBuffer As String, ByVal nSize As Long, ByRef lpNumberOfBytesWritten As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function SendMessageLong& Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long)
Private 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


Private Const WM_GETTEXT = &HD
Private Const WM_GETTEXTLENGTH = &HE
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_CLOSE = &H10

Private Const LB_GETITEMDATA = &H199
Private Const LB_SETCURSEL = &H186
Private Const LB_GETCOUNT = &H18B


Private Const CB_GETCOUNT = &H146
Private Const WM_CHAR = &H102
Private Const WM_SETTEXT = &HC
Private Const VK_RETURN = &HD
Private Const VK_SPACE = &H20


Private Sub Keyword(Keyword As String)
    Dim AOL As Long, tool As Long, Toolbar As Long
    Dim Combo As Long, EditWin As Long
    AOL& = FindWindow("AOL Frame25", vbNullString)
    tool& = FindWindowEx(AOL&, 0&, "AOL Toolbar", vbNullString)
    Toolbar& = FindWindowEx(tool&, 0&, "_AOL_Toolbar", vbNullString)
    Combo& = FindWindowEx(Toolbar&, 0&, "_AOL_Combobox", vbNullString)
    EditWin& = FindWindowEx(Combo&, 0&, "Edit", vbNullString)
    Do: DoEvents
        Call SendMessageByString(EditWin&, WM_SETTEXT, 0&, Keyword$)
        sText$ = GetText(EditWin&)
    Loop Until sText$ = Keyword$
    Call SendMessageLong(EditWin&, WM_CHAR, VK_SPACE, 0&)
    Call SendMessageLong(EditWin&, WM_CHAR, VK_RETURN, 0&)
End Sub

Private Function GetText(hwnd As Long) As String
    Dim GetLen As Long, StringText As String, GetString As Long
    GetLen& = SendMessage(hwnd&, WM_GETTEXTLENGTH, 0&, 0&)
    If hwnd& = 0 Then GetText$ = 0: Exit Function
    StringText$ = String$(GetLen& + 1, Chr$(0))
    Call SendMessageByString(hwnd&, WM_GETTEXT, GetLen& + 1, StringText$)
        Do: DoEvents
            If Right(StringText$, 1) = Chr(0) Then StringText$ = Left(StringText$, Len(StringText$) - 1)
        Loop Until Right(StringText$, 1) <> Chr(0)
        GetText = StringText$
End Function

Private Function AOLListItem(aoList As Long, index As Long) As String
    Dim cProcess As Long, itmHold As Long, ScreenName As String
    Dim psnHold As Long, rBytes As Long, Room As Long
    Dim rList As Long, sThread As Long, mThread As Long
    Dim lIndex As Long
            rList& = aoList
            sThread& = GetWindowThreadProcessId(rList, cProcess&)
            mThread& = OpenProcess(0, False, cProcess&)
            pSN$ = String$(4, vbNullChar)
            itmHold& = SendMessage(rList, LB_GETITEMDATA, ByVal CLng(index&), ByVal 0&)
            itmHold& = itmHold& + 24
            Call ReadProcessMemory(mThread&, itmHold&, pSN$, 4, rBytes)
            Call CopyMemory(psnHold&, ByVal pSN$, 4)
            psnHold& = psnHold& + 6
            pSN$ = String$(16, vbNullChar)
            Call ReadProcessMemory(mThread&, psnHold&, pSN$, Len(pSN$), rBytes&)
            If InStr(pSN$, vbNullChar) = 0 Then AOLListItem = pSN$: Exit Function
            pSN$ = Left$(pSN$, InStr(pSN$, vbNullChar) - 1)
            Do: DoEvents
                If Right(pSN$, 1) = Chr(0) Then pSN$ = Left(pSN$, Len(pSN$) - 1)
            Loop Until Right(pSN$, 1) <> Chr(0)
            AOLListItem = pSN$
End Function

Private Sub BuddiesAddToList(List As ListBox)
'Declare all of the variables
Dim AOL&, MDI&, BuddyLists&, AOLStatic&, AOLBuddyLists&
Dim GroupItem$, GroupCount&, GetGroup&, GroupName$, WinTitle$
Dim EditGroup&, BuddyGroup&, GroupAmount%, GetBuddy&
'Open up the Buddy List control panel that has the
'Create, Edit, and Delete features
Keyword "Buddy"
'Obtain the handle of the main AOL window and the MDIClient
'Also see AOL Class Names Tutorial
AOL = FindWindow("AOL Frame25", vbNullString)
MDI = FindWindowEx(AOL, 0, "MDIClient", vbNullString)
'Set up a loop to wait for the Buddy List Edit window
'to open. This code waits for the label(_AOL_Staic) that
'contains the text "Buddy List Setup".
Do: DoEvents
'BuddyLists     = The AOL Child which is the Buddy List control panel
'AOLStatic     = Handle of the label that says "Buddy List Setup"
'AOLBuddyLists = Handle of the list box that has the different Buddy categories
    BuddyLists = FindWindowEx(MDI, 0, "AOL Child", vbNullString)
    AOLStatic = FindWindowEx(BuddyLists, 0, "_AOL_Static", vbNullString)
    AOLBuddyLists = FindWindowEx(BuddyLists, 0, "_AOL_Listbox", vbNullString)
Loop Until GetText(AOLStatic) = "Buddy List Setup" And AOLBuddyLists And BuddyLists
'GroupCount     = how many Buddy List categories there are
GroupCount = SendMessage(AOLBuddyLists&, LB_GETCOUNT, 0, 0)
'Now we set up a loop to go through all the different categories
'based upon the number obtained by GroupCount
For GetGroup = 0 To GroupCount& - 1
'The Buddy category list is set up as follows:
'(Category Name) + Tab + (Category Count)
'Group Item = The entire thing
'Group Name = The Category Name
'Group Amount = Category Count GroupItem = AOLListItem(AOLBuddyLists, GetGroup) GroupName = Left(GroupItem, InStr(GroupItem, Chr(9)) - 1) GroupAmount = Val(Mid(GroupItem, InStr(GroupItem, Chr(9)) + 1))



'Set the focus to the group that is about to be obtained
Call PostMessage(AOLBuddyLists, LB_SETCURSEL, GetGroup, 0&)
'Double click the group that is about to be obtained
'Which will open up the group with all the buddies in that category
Call PostMessage(AOLBuddyLists, WM_LBUTTONDBLCLK, 0&, 0&)
'The title window for each category window is "Edit List " + The Name of the Category WinTitle = "Edit List " & GroupName

'Set up a loop to ensure that the list box is loaded with all of the
'buddies in that category. We can tell when all are loaded because
'before we found how many buddies were in the group via the category list
'So this loop continues until the number of items in the screen name list
'is the same as the number
Do: DoEvents
'EditGroup = The edit a specific buddy category window
'BuddyGroup = The list box with all the screen names in it         EditGroup = FindWindowEx(MDI, 0, "AOL Child", WinTitle)         BuddyGroup = FindWindowEx(EditGroup, 0, "_AOL_Listbox", vbNullString)


Loop Until SendMessage(BuddyGroup, LB_GETCOUNT, 0, 0) = GroupAmount
'Set up a loop to go through the screen name list box
'and retreive all the screen names in it
For GetBuddy = 0 To GroupAmount - 1         Buddy = AOLListItem(BuddyGroup, GetBuddy&)

'As long as the screen name isn't blank, add it to the list box         
If Buddy <> "" Then List.AddItem Buddy
Next GetBuddy
'Now we go to the next category
Next GetGroup
'Close the edit specific category window SendMessage EditGroup, WM_CLOSE, 0, 0

'Close the Buddy List control panel window SendMessage BuddyLists, WM_CLOSE, 0, 0

End Sub

Private Sub Command1_Click() BuddiesAddToList List1 Me.Caption = "Count: " & List1.ListCount


End Sub