Skip to content

Instantly share code, notes, and snippets.

@tizmagik

tizmagik/magik_aol8.bas

Created July 20, 2017 17:42
Show Gist options
  • Save tizmagik/4a2d01226aa2580f5da67e73a78657a4 to your computer and use it in GitHub Desktop.
Save tizmagik/4a2d01226aa2580f5da67e73a78657a4 to your computer and use it in GitHub Desktop.
Download ZIP
My very first open source project 😆
Raw
magik_aol8.bas
Attribute VB_Name = "magik_aol8"
'*****************************************************************************
'Programmer: magik
'
'WWW: http://magikweb.cjb.net
'
'E-Mail: xvmagikxv@hotmail.com
'
'Date: [Origional] 6/28/02
' [Current v1.3] 8/15/02
'
'BAS For: AOL 8.0 (BETA Revision 4129.50 and Later)
'
'BAS Versions: v1.0 - 6/25/02
' v1.3 - 8/15/02
'
'Notes: Many of the Window Find functions are made using PAT or JK's
' API Spy v5.1. Lots of ideas are from various other BAS Files
' and I will try to give credit where credit is due. I will try
' to use popular/familiar function names for simplicity
' If for some reason I forget your credit somewhere on a
' function that you have made, feel free to let me know by
' dropping me a line at xvmagikvx@hotmail.com. Also, if any of
' these functions generate errors or simply do not work, e-mail
' me and I'll fix them or walk you through something.
' Enjoy! Oh, BTW, I tried to keep this module soleley for AOL
' Subs and Functions. I believe in quality, not quantity :)
'
'Copyright: Feel free to use and distribute this BAS (non-profit *ONLY*)
' and use in any of your proggs. If you do use it, make sure
' you put my name and/or website on the credits somewhere. :)
'
'Updates: Send me Feedback and you'll be sure to find updates as
' AOL8.0 reaches GM. No feedback = No Updates people! :P
' If there are updates, they can be found on my website:
' http://magikweb.cjb.net
'
'Bug Fiexes: [8/15/02] - [Version 1.3] - Fixed for AOL 8.0 Revision 4129.50:
' \ Fixed RunMenu(s) Functions; IMSend(); IMRespond();
' \ BuddyChatWhereTo(); SignOnAsGuest(); FindMailBox();
' \ ValidSN();
'
'Additions: [8/15/02] - [Version 1.3] - Added:
' \ ProfileOpen()
'
'*****************************************************************************
Option Explicit 'should always have this, requires you to declare your variables
'%% 32-bit code declarations from PAT or JK's API Spy 5.1 - www.patorjk.com
'%% And other bas files.
'
'Window API Decs
Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Public Declare Function EnableWindow Lib "user32" (ByVal hwnd As Long, ByVal fEnable As Long) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName 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 GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function IsWindowVisible Lib "user32" (ByVal hwnd As Long) As Long
'Process API Decs
Public Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Public 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
'Message API Decs
Public Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags 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 SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function SendMessageLong& Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long)
Public 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
Public Declare Function SendMessageByNum& Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long)
'Menu API Decs
Public Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
Public Declare Function GetMenuItemID Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Public Declare Function GetMenuString Lib "user32" Alias "GetMenuStringA" (ByVal hMenu As Long, ByVal wIDItem As Long, ByVal lpString As String, ByVal nMaxCount As Long, ByVal wFlag As Long) As Long
Public Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
'INI Read/Write API Decs
Public Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Public Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
'Misc. API Decs
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (destination As Any, source As Any, ByVal Length As Long)
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Public Declare Function ReleaseCapture Lib "user32" () As Long
'Public Constants for use with API Decs
Public Const BM_SETCHECK = &HF1
Public Const BM_GETCHECK = &HF0
Public Const HWND_NOTOPMOST = -2
Public Const HWND_TOPMOST = -1
Public Const CB_GETCOUNT = &H146
Public Const CB_GETLBTEXT = &H148
Public Const CB_SETCURSEL = &H14E
Public Const CB_GETITEMDATA = &H150
Public Const GW_HWNDFIRST = 0
Public Const GW_HWNDNEXT = 2
Public Const GW_CHILD = 5
Public Const LB_GETCOUNT = &H18B
Public Const LB_GETTEXT = &H189
Public Const LB_GETTEXTLEN = &H18A
Public Const LB_SETCURSEL = &H186
Public Const LB_GETITEMDATA = &H199
Public Const SW_HIDE = 0
Public Const SW_MAXIMIZE = 3
Public Const SW_MINIMIZE = 6
Public Const SW_NORMAL = 1
Public Const SW_SHOW = 5
Public Const SWP_NOMOVE = &H2
Public Const SWP_NOSIZE = &H1
Public Const VK_SPACE = &H20
Public Const VK_DOWN = &H28
Public Const VK_RETURN = &HD
Public Const WM_CHAR = &H102
Public Const WM_CLOSE = &H10
Public Const WM_COMMAND = &H111
Public Const WM_SYSCOMMAND = &H112
Public Const WM_GETTEXT = &HD
Public Const WM_GETTEXTLENGTH = &HE
Public Const WM_KEYDOWN = &H100
Public Const WM_KEYUP = &H101
Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const WM_MOVE = &HF012
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP = &H205
Public Const WM_SETTEXT = &HC
Public Const WM_USER = &H400
Public Const PROCESS_READ = &H10
Public Const RIGHTS_REQUIRED = &HF0000
Public Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE
'End API Declarations
'/
Global silent As Boolean
'\
'Start Subs/Functions
Public Sub SetText(hWndToSet As Long, TextToSet As String)
'%% Sets text of a window, can be used to set Captions, Chat Boxes, etc.
'clear text
Call SendMessageByString(hWndToSet, WM_SETTEXT, 0&, "")
Call SendMessageByString(hWndToSet, WM_SETTEXT, 0&, TextToSet)
End Sub
Public Sub GotoKeyWord(strKeyWord As String)
'%% Alternate way to go to a KeyWord in AOL8 (strKeyWord)
'%% Ex:
'%% Call KeyWord("aol://2719:2-2-magik")
'
'Find the KeyWord Box
Dim aolframe As Long, aoltoolbar As Long, AOLCombobox As Long
Dim editx As Long
aolframe = FindWindow("aol frame25", vbNullString)
aoltoolbar = FindWindowEx(aolframe, 0&, "aol toolbar", vbNullString)
aoltoolbar = FindWindowEx(aoltoolbar, 0&, "_aol_toolbar", vbNullString)
AOLCombobox = FindWindowEx(aoltoolbar, 0&, "_aol_combobox", vbNullString)
editx = FindWindowEx(AOLCombobox, 0&, "edit", vbNullString)
'Edit the text
Call SetText(editx, strKeyWord)
'go to keyword
Call SendMessage(editx, WM_CHAR, VK_SPACE, 0)
Call SendMessage(editx, WM_CHAR, VK_RETURN, 0)
End Sub
Public Sub GotoSearch(strSearch As String)
'%% Goes to a specific strSearch in AOL8's search box
'%% Ex:
'%% Call GoToSearch("magik proggs")
'Find the Search Box
Dim aolframe As Long, aoltoolbar As Long, aoledit As Long
aolframe = FindWindow("aol frame25", vbNullString)
aoltoolbar = FindWindowEx(aolframe, 0&, "aol toolbar", vbNullString)
aoltoolbar = FindWindowEx(aoltoolbar, 0&, "_aol_toolbar", vbNullString)
aoledit = FindWindowEx(aoltoolbar, 0&, "_aol_edit", vbNullString)
aoledit = FindWindowEx(aoltoolbar, aoledit, "_aol_edit", vbNullString)
aoledit = FindWindowEx(aoltoolbar, aoledit, "_aol_edit", vbNullString)
aoledit = FindWindowEx(aoltoolbar, aoledit, "_aol_edit", vbNullString)
aoledit = FindWindowEx(aoltoolbar, aoledit, "_aol_edit", vbNullString)
'Edit the text
Call SetText(aoledit, strSearch)
'Hit Enter
Call SendMessage(aoledit, WM_CHAR, VK_SPACE, 0)
Call SendMessage(aoledit, WM_CHAR, VK_RETURN, 0)
End Sub
Public Function GetUser() As String
'%% Returns the User's SN by getting the caption of the Welcome Window
'%% Preserves the case but if you want it lower/upper just do:
'%% strUserSN = LCase(GetUser) '<- Lower Case... or
'%% strUserSN = UCase(GetUser) '<- Upper Case
Dim strUserSN As String, lngWelcWin As Long
lngWelcWin = FindWelcomeWin
If lngWelcWin = 0& Then
'user is not even online
GetUser = "[not online]" 'return "[not online]"
Else
strUserSN = GetText(FindWelcomeWin)
strUserSN = Replace(strUserSN, "Welcome, ", "") 'Remove "Welcome, "
GetUser = Replace(strUserSN, "!", "") 'Remove "!" and return
End If
End Function
Public Function AOLURL(strURL As String, strDesc As String) As String
'%% Formats strAddress and strDesc into aol-compatible hyperlink
'%% Ex:
'%% strLink = AOLURL("http://magikweb.cjb.net", "magik's site, click here")
'
AOLURL = "< a href=" & Chr(34) & strURL & Chr(34) & ">" & strDesc & "</a>"
End Function
Public Function ChatPeopleHereList() As Long
'%% Returns the "People Here" list handle in a chat room
'%% Ex:
'%% Call ListCount(ChatPeopleHereList)
'
ChatPeopleHereList = FindWindowEx(FindRoom, 0&, "_aol_listbox", vbNullString)
End Function
Public Function ChatNumPeople() As Integer
'%% Returns number of people in chat room
'%% Ex:
'%% intNumPeople = ChatNumPeople()
'%% ..or.. you could just do ListCount(ChatPeopleHereList)
'
Dim lngRoom As Long, AOLStatic As Long
lngRoom = FindRoom
'Find AOL's "people here"
AOLStatic = FindWindowEx(lngRoom, 0&, "_aol_static", vbNullString)
AOLStatic = FindWindowEx(lngRoom, AOLStatic, "_aol_static", vbNullString)
AOLStatic = FindWindowEx(lngRoom, AOLStatic, "_aol_static", vbNullString)
'Return number of people by using AOL's "people here" :)
ChatNumPeople = Int(GetText(AOLStatic))
'..or simply..
'ChatNumPeople = ListCount(ChatPeopleHereList)
End Function
Public Sub ChatAddListToList(lstListToAddTo As ListBox)
'%% This will add all screen names to a listbox, excluding the actual user
'%% Conventional, its a really cheesy way, but incase the other doesn't work..
'%% Ex:
'%% Call ChatAddListToList(lstChatters)
'
On Local Error Resume Next
Dim lngList As Long, i As Integer, strSN As String
Dim lngChatUserInfo As Long, strUserSN As String
strUserSN = GetUser
'Find "People Here" List
lngList = FindWindowEx(FindRoom, 0&, "_aol_listbox", vbNullString)
'loop through each person in chatroom
For i = 0 To (ChatNumPeople - 1)
'DblClick SN
Call ListDblClick(lngList, i)
'make sure we find window
Do: DoEvents
lngChatUserInfo = FindChatUserInfo
Loop Until lngChatUserInfo <> 0&
'the caption is the user's sn, how convenient :)
strSN = GetText(FindChatUserInfo)
'if its not the actual user then add to lst
If strUserSN <> strSN Then
lstListToAddTo.AddItem strSN
End If
'close that window
Call closewin(lngChatUserInfo)
Next i
'just incase somone signed off/exited while we were gathering sns
'we will loop through and remove any blank sns
For i = 0 To lstListToAddTo.listcount - 1
If lstListToAddTo.List(i) = "" Or lstListToAddTo.List(i) = " " Then
lstListToAddTo.RemoveItem (i)
End If
Next i
End Sub
Public Sub ProfileEdit(strname As String, strLoc As String, sglSex As Single, strMStatus As String, _
strhobbies As String, strComps As String, strOccu As String, strquote As String, Optional blnIncLinkToHomePage As Boolean = False)
'%% Edits/Sets a user's profile
'%% sglSex has 3 values --> 0=Male, 1=Female, 2=No Response
'%% blnIncLinkToHomePage has 2 --> True/False for including a link to users homepage
'%% Ex:
'%% Call ProfileEdit("somedude", "USA", 2, "STAT", "I do stuff", "Dell", "hitman", "go to: http://magikweb.cjb.net :)", False)
'
Dim lngMDir As Long, lngProf As Long, lngname As Long, lngLoc As Long, lngmstatus As Long
Dim lngComp As Long, lngOccu As Long, lngquote As Long, lnghobbies As Long, lngProceed As Long
Dim oMale As Long, oFemale As Long, oNoRes As Long
Dim lngCheckBox As Long
Dim aolframe As Long, aolmodal As Long, AOLIcon As Long, AOLCheckbox As Long
'goto profile
Call GotoKeyWord("profile")
'find member dir
Do: DoEvents
lngMDir = FindMemberDir
Loop Until lngMDir <> 0&
'click my profile to edit profile
lngProceed = FindWindowEx(lngMDir, 0&, "_aol_icon", vbNullString)
Call ClickIcon(lngProceed)
'find profile window
Do: DoEvents
lngProf = FindProfileEdit
Loop Until lngProf <> 0&
'we can close the member directory
Call closewin(lngMDir)
Wait 0.5
'[kids privacy]
aolframe = FindWindow("aol frame25", vbNullString)
aolmodal = FindWindow("_aol_modal", vbNullString)
AOLIcon = FindWindowEx(aolmodal, 0&, "_aol_icon", vbNullString)
If GetText(AOLIcon) = "Kids' Privacy" Then
AOLIcon = FindWindowEx(aolmodal, AOLIcon, "_aol_icon", vbNullString)
End If
If GetText(AOLIcon) = "OK" Then
'find the checkbox
AOLCheckbox = FindWindowEx(aolmodal, 0&, "_aol_checkbox", vbNullString)
Call Check(AOLCheckbox, True)
ClickIcon (AOLIcon)
End If
'[kids privacy]
'find all textboxes
lngname = FindWindowEx(lngProf, 0&, "_aol_edit", vbNullString)
lngLoc = FindWindowEx(lngProf, lngname, "_aol_edit", vbNullString)
lngmstatus = FindWindowEx(lngProf, lngLoc, "_aol_edit", vbNullString)
lnghobbies = FindWindowEx(lngProf, lngmstatus, "_aol_edit", vbNullString)
lngComp = FindWindowEx(lngProf, lnghobbies, "_aol_edit", vbNullString)
lngOccu = FindWindowEx(lngProf, lngComp, "_aol_edit", vbNullString)
lngquote = FindWindowEx(lngProf, lngOccu, "_aol_edit", vbNullString)
'find radioboxes
oMale = FindWindowEx(lngProf, 0&, "_aol_radiobox", vbNullString)
oFemale = FindWindowEx(lngProf, oMale, "_aol_radiobox", vbNullString)
oNoRes = FindWindowEx(lngProf, oFemale, "_aol_radiobox", vbNullString)
'find checkbox
lngCheckBox = FindWindowEx(lngProf, 0&, "_aol_checkbox", vbNullString)
'set values
Call SetText(lngname, strname)
Call SetText(lngLoc, strLoc)
Call SetText(lngmstatus, strMStatus)
Call SetText(lnghobbies, strhobbies)
Call SetText(lngComp, strComps)
Call SetText(lngOccu, strOccu)
Call SetText(lngquote, strquote)
If sglSex = 0 Then
ClickIcon (oMale)
ElseIf sglSex = 1 Then
ClickIcon (oFemale)
Else
ClickIcon (oNoRes)
End If
Call Check(lngCheckBox, blnIncLinkToHomePage)
'find update icon
lngProceed = FindWindowEx(lngProf, 0&, "_aol_icon", vbNullString)
lngProceed = FindWindowEx(lngProf, lngProceed, "_aol_icon", vbNullString)
'click to update
ClickIcon (lngProceed)
'click ok on msg box
Dim x As Long, Button As Long
Do: DoEvents
x = FindWindow("#32770", vbNullString)
Button = FindWindowEx(x, 0&, "button", vbNullString)
Loop Until x <> 0& And Button <> 0&
Call PostMessage(Button, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(Button, WM_KEYUP, VK_SPACE, 0&)
'check again for kids privacy
'[kids privacy]
aolframe = FindWindow("aol frame25", vbNullString)
aolmodal = FindWindow("_aol_modal", vbNullString)
AOLIcon = FindWindowEx(aolmodal, 0&, "_aol_icon", vbNullString)
If GetText(AOLIcon) = "Kids' Privacy" Then
AOLIcon = FindWindowEx(aolmodal, AOLIcon, "_aol_icon", vbNullString)
End If
If GetText(AOLIcon) = "OK" Then
'find the checkbox
AOLCheckbox = FindWindowEx(aolmodal, 0&, "_aol_checkbox", vbNullString)
Call Check(AOLCheckbox, True)
ClickIcon (AOLIcon)
End If
'[kids privacy]
End Sub
Public Sub ProfileDelete()
'%% Deletes members profile
'%% Ex:
'%% Call ProfileDelete()
'
Dim lngMDir As Long, lngProceed As Long, lngProf As Long, lngmodal As Long
'goto profile
Call GotoKeyWord("profile")
'find member dir
Do: DoEvents
lngMDir = FindMemberDir
Loop Until lngMDir <> 0&
'click my profile to edit profile
lngProceed = FindWindowEx(lngMDir, 0&, "_aol_icon", vbNullString)
Call ClickIcon(lngProceed)
'find profile window
Do: DoEvents
lngProf = FindProfileEdit
Loop Until lngProf <> 0&
'we can close the member directory
Call closewin(lngMDir)
'find the delete button
lngProceed = FindWindowEx(lngProf, 0&, "_aol_icon", vbNullString)
lngProceed = FindWindowEx(lngProf, lngProceed, "_aol_icon", vbNullString)
lngProceed = FindWindowEx(lngProf, lngProceed, "_aol_icon", vbNullString)
'click it
Call ClickIcon(lngProceed)
'now wait and click the Yes for the confirmation
Do: DoEvents
lngmodal = FindModalWin
lngProceed = FindWindowEx(lngmodal, 0&, "_aol_icon", vbNullString)
lngProceed = FindWindowEx(lngmodal, lngProceed, "_aol_icon", vbNullString)
Loop Until lngmodal <> 0& And lngProceed <> 0&
'click yes
Call ClickIcon(lngProceed)
'click ok on msg box
Dim x As Long, Button As Long
Do: DoEvents
x = FindWindow("#32770", vbNullString)
Button = FindWindowEx(x, 0&, "button", vbNullString)
Loop Until x <> 0& And Button <> 0&
Call PostMessage(Button, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(Button, WM_KEYUP, VK_SPACE, 0&)
End Sub
Public Sub ProfileOpen(strSN As String)
'%% Just opens a member profile, does not return
'%% the text as ProfileGet() does.
'%% Ex:
'%% Call ProfileOpen("somedude")
'
Dim lngGetProfile As Long, lngSN As Long, lngok As Long, lngProfile As Long
Dim lngrich As Long, strGet As String
'click to get profile
Call RunMenuToolBar(1, 6)
'find get profile window
Do: DoEvents
lngGetProfile = FindChildByTitle("Get a Member's Profile")
Loop Until lngGetProfile <> 0&
'find textbox
lngSN = FindWindowEx(lngGetProfile, 0&, "_aol_edit", vbNullString)
'set text as sn
Call SetText(lngSN, strSN)
'click the ok button
lngok = FindWindowEx(lngGetProfile, 0&, "_aol_icon", vbNullString)
Call ClickIcon(lngok)
'close stuff
Call closewin(lngGetProfile)
End Sub
Public Function ProfileGet(strSN As String) As String
'%% Get members strSN's member profile and returns as String
'%% Ex:
'%% Text1.Text = ProfileGet("somedude")
'
Dim lngGetProfile As Long, lngSN As Long, lngok As Long, lngProfile As Long
Dim lngrich As Long, strGet As String
'click to get profile
Call RunMenuToolBar(1, 6)
'find get profile window
Do: DoEvents
lngGetProfile = FindChildByTitle("Get a Member's Profile")
Loop Until lngGetProfile <> 0&
'find textbox
lngSN = FindWindowEx(lngGetProfile, 0&, "_aol_edit", vbNullString)
'set text as sn
Call SetText(lngSN, strSN)
'click the ok button
lngok = FindWindowEx(lngGetProfile, 0&, "_aol_icon", vbNullString)
Call ClickIcon(lngok)
'wait for profile window
Do: DoEvents
lngProfile = FindChildByTitle("Member Profile")
Loop Until lngProfile <> 0&
'get profile text
lngrich = FindWindowEx(lngProfile, 0&, "richcntlreadonly", vbNullString)
strGet = GetText(lngrich)
'close stuff
Call closewin(lngProfile)
Call closewin(lngGetProfile)
'return it
ProfileGet = strGet
End Function
Public Sub AddAOL8ListToList(listtoget As Long, ListToAddTo As ListBox, Optional AddUser As Boolean = False)
'%% This sub was made by myst. However, I modified it slightly to allow
'%% for it to work with all AOL8 ListBox's (not just 'People Here' List
'%% I also added my own comments in hopes that you could learn how
'%% it works :) Works much faster and better than the other sub,
'%% so use this unless it stops working for ya.
'%% Ex:
'%% Call AddAOL8ListToList(ChatPeopleHereList, List1, False) '<- Adds to List1 w/o actual User
On Error Resume Next
Dim cProcess As Long, itmHold As Long, ScreenName As String
Dim psnHold As Long, rBytes As Long, index As Long
Dim sThread As Long, mThread As Long
sThread& = GetWindowThreadProcessId(listtoget, cProcess&)
'this 'OpenProcess' API Call allows for us to read the contents of the
'listbox in a nonconventional way, since conventional methods dont work :)
'We will read that tasks of the window (thread) into mThread&
mThread& = OpenProcess(PROCESS_READ Or RIGHTS_REQUIRED, False, cProcess&)
'If its valid, then commence adding
If mThread& Then
'Loop through the list items using my ListCount Procedure
'We must subtract 1 since its zero-based
For index& = 0 To listcount(listtoget) - 1
'Get the current screen name -the invalid characters
ScreenName$ = String$(4, vbNullChar)
'Get's the screen name from the list through itmHold&
itmHold& = SendMessage(listtoget, LB_GETITEMDATA, ByVal CLng(index&), ByVal 0&)
itmHold& = itmHold& + 28
'Read the data from itmHold with the ReadProcessMemory API Call,
'this will enable us to get the actual data via the "non-conventional" way :)
'heh, trying to explain as simple as possible.. basically its reading the data
'in a special way into th memory
Call ReadProcessMemory(mThread&, itmHold&, ScreenName$, 4, rBytes)
'Now we will read that memory-added data
Call CopyMemory(psnHold&, ByVal ScreenName$, 4)
psnHold& = psnHold& + 6
'Subtract invalid characters
ScreenName$ = String$(16, vbNullChar)
'Read into memory again
Call ReadProcessMemory(mThread&, psnHold&, ScreenName$, Len(ScreenName$), rBytes&)
'Finally, we've got our SN
ScreenName$ = Left$(ScreenName$, InStr(ScreenName$, vbNullChar) - 1)
'Make sure, if the user doesn't want to add the actual user, then
'dont add to list, otherwise, add :)
If ScreenName$ <> GetUser$ Or AddUser = True Then
ListToAddTo.AddItem ScreenName$
End If
'Move on to next SN :)
Next index&
'Close the processed memory thread
Call CloseHandle(mThread)
End If
End Sub
Public Sub ChatSend(strText As String)
'%% I'm sure you know what this is.. but for those newbs, it sends
'%% strText to an AOL8 Chat Room if present
'%% Ex:
'%% Call ChatSend("i'm using magik_aol8.bas!!")
'%% 'Might want to put 'Wait 0.3' to avoid getting logged off due to scrolling
Dim lngRoom As Long, lngInputBox As Long, i As Integer
'Find the Windows
lngRoom& = FindRoom
lngInputBox = FindWindowEx(lngRoom, 0&, "richcntl", vbNullString)
'Enter Text
Call SetText(lngInputBox, "") 'Clear text first, you can comment this out
Call SetText(lngInputBox, strText)
'Hit Enter (this will send the text, dont need to waste time
'looking for the send button then clicking send
Call SendMessageLong(lngInputBox, WM_CHAR, 13, 0&)
End Sub
Public Function FindRoom() As Long
'%% I used PAT or JK's API Spy 5.1 "Generate Function to Find Window" feature
'%% Incase you don't know how this works, what it does is look for the
'%% 'Siblings' of a Window, in other words, uses the parent to find every
'%% single object under that parent. In this case, the Parent here is the
'%% actual room, and the Siblings are the Chat InputBox, the Entered Chat Text
'%% The "People Here" list, the "Send" button, etc. If all of the siblings
'%% are present (sibling <> 0&, aka it has a handle) under that one window then
'%% we must have found the room, return it, otherwise return 0&
'
Dim aolframe As Long, mdiclient As Long, aolchild As Long
aolframe = FindWindow("aol frame25", vbNullString)
mdiclient = FindWindowEx(aolframe, 0&, "mdiclient", vbNullString)
aolchild = FindWindowEx(mdiclient, 0&, "aol child", vbNullString)
Dim Winkid1 As Long, Winkid2 As Long, Winkid3 As Long, Winkid4 As Long, Winkid5 As Long, Winkid6 As Long, Winkid7 As Long, Winkid8 As Long, Winkid9 As Long, FindOtherWin As Long
FindOtherWin = GetWindow(aolchild, GW_HWNDFIRST)
Do While FindOtherWin <> 0
DoEvents
Winkid1 = FindWindowEx(FindOtherWin, 0&, "_aol_static", vbNullString)
Winkid2 = FindWindowEx(FindOtherWin, 0&, "richcntlreadonly", vbNullString)
Winkid3 = FindWindowEx(FindOtherWin, 0&, "_aol_combobox", vbNullString)
Winkid4 = FindWindowEx(FindOtherWin, 0&, "_aol_icon", vbNullString)
Winkid5 = FindWindowEx(FindOtherWin, 0&, "_aol_static", vbNullString)
Winkid6 = FindWindowEx(FindOtherWin, 0&, "richcntl", vbNullString)
Winkid7 = FindWindowEx(FindOtherWin, 0&, "_aol_icon", vbNullString)
Winkid8 = FindWindowEx(FindOtherWin, 0&, "_aol_image", vbNullString)
Winkid9 = FindWindowEx(FindOtherWin, 0&, "_aol_static", vbNullString)
If (Winkid1 <> 0) And (Winkid2 <> 0) And (Winkid3 <> 0) And (Winkid4 <> 0) And (Winkid5 <> 0) And (Winkid6 <> 0) And (Winkid7 <> 0) And (Winkid8 <> 0) And (Winkid9 <> 0) Then
FindRoom = FindOtherWin
Exit Function
End If
FindOtherWin = GetWindow(FindOtherWin, GW_HWNDNEXT)
Loop
FindRoom = 0
' example on how to use:
'
' Dim TheWin As Long
' TheWin = FindRoom()
'
' If TheWin <> 0 Then
' What to do if window is there
' End If
End Function
Public Function FindIM() As Long
'%% I used PAT or JK's API Spy 5.1 "Generate Function to Find Window" feature
'%% to find the IM. It searches for all common siblings of an IM and returns
'%% the handle if found, if not, returns 0&. Very similar to FindRoom function.
'
Dim aolframe As Long, mdiclient As Long, aolchild As Long
aolframe = FindWindow("aol frame25", vbNullString)
mdiclient = FindWindowEx(aolframe, 0&, "mdiclient", vbNullString)
aolchild = FindWindowEx(mdiclient, 0&, "aol child", vbNullString)
aolchild = FindWindowEx(mdiclient, aolchild, "aol child", vbNullString)
Dim Winkid1 As Long, Winkid2 As Long, Winkid3 As Long, Winkid4 As Long, Winkid5 As Long, Winkid6 As Long, Winkid7 As Long, Winkid8 As Long, Winkid9 As Long, FindOtherWin As Long
FindOtherWin = GetWindow(aolchild, GW_HWNDFIRST)
Do While FindOtherWin <> 0
DoEvents
Winkid1 = FindWindowEx(FindOtherWin, 0&, "_aol_view", vbNullString)
Winkid2 = FindWindowEx(FindOtherWin, 0&, "_aol_static", vbNullString)
Winkid3 = FindWindowEx(FindOtherWin, 0&, "richcntlreadonly", vbNullString)
Winkid4 = FindWindowEx(FindOtherWin, 0&, "_aol_static", vbNullString)
Winkid5 = FindWindowEx(FindOtherWin, 0&, "_aol_editimage", vbNullString)
Winkid6 = FindWindowEx(FindOtherWin, 0&, "_aol_static", vbNullString)
Winkid7 = FindWindowEx(FindOtherWin, 0&, "_aol_icon", vbNullString)
Winkid8 = FindWindowEx(FindOtherWin, 0&, "_aol_static", vbNullString)
Winkid9 = FindWindowEx(FindOtherWin, 0&, "richcntl", vbNullString)
If (Winkid1 <> 0) And (Winkid2 <> 0) And (Winkid3 <> 0) And (Winkid4 <> 0) And (Winkid5 <> 0) And (Winkid6 <> 0) And (Winkid7 <> 0) And (Winkid8 <> 0) And (Winkid9 <> 0) Then
FindIM = FindOtherWin
Exit Function
End If
FindOtherWin = GetWindow(FindOtherWin, GW_HWNDNEXT)
Loop
FindIM = 0
' example on how to use:
'
' Dim TheWin As Long
' TheWin = FindIM()
'
' If TheWin <> 0 Then
' What to do if window is there
' End If
End Function
Public Function FindRecDelMail() As Long
'%% I used PAT or JK's API Spy 5.1 "Generate Function to Find Window" feature
'%% to find the Recently Deleted Mail window. It searches for all common siblings
'%% and returns the handle if found, if not, returns 0&. Very similar to FindRoom function.
'
Dim aolframe As Long, mdiclient As Long, aolchild As Long
aolframe = FindWindow("aol frame25", vbNullString)
mdiclient = FindWindowEx(aolframe, 0&, "mdiclient", vbNullString)
aolchild = FindWindowEx(mdiclient, 0&, "aol child", vbNullString)
Dim Winkid1 As Long, Winkid2 As Long, Winkid3 As Long, Winkid4 As Long, Winkid5 As Long, FindOtherWin As Long
FindOtherWin = GetWindow(aolchild, GW_HWNDFIRST)
Do While FindOtherWin <> 0
DoEvents
Winkid1 = FindWindowEx(FindOtherWin, 0&, "_aol_glyph", vbNullString)
Winkid2 = FindWindowEx(FindOtherWin, 0&, "_aol_image", vbNullString)
Winkid3 = FindWindowEx(FindOtherWin, 0&, "_aol_static", vbNullString)
Winkid4 = FindWindowEx(FindOtherWin, 0&, "_aol_tree", vbNullString)
Winkid5 = FindWindowEx(FindOtherWin, 0&, "_aol_icon", vbNullString)
If (Winkid1 <> 0) And (Winkid2 <> 0) And (Winkid3 <> 0) And (Winkid4 <> 0) And (Winkid5 <> 0) Then
FindRecDelMail = FindOtherWin
Exit Function
End If
FindOtherWin = GetWindow(FindOtherWin, GW_HWNDNEXT)
Loop
FindRecDelMail = 0
' example on how to use:
'
' Dim TheWin As Long
' TheWin = FindRecDelMail()
'
' If TheWin <> 0 Then
' What to do if window is there
' End If
End Function
Public Function FindSwitchSN() As Long
'%% I used PAT or JK's API Spy 5.1 "Generate Function to Find Window" feature
'%% to find the Switch SNs window (SignOff > Switch SN). It searches for all common siblings
'%% and returns the handle if found, if not, returns 0&. Very similar to FindRoom function.
'
Dim aolframe As Long, mdiclient As Long, aolchild As Long
aolframe = FindWindow("aol frame25", vbNullString)
mdiclient = FindWindowEx(aolframe, 0&, "mdiclient", vbNullString)
aolchild = FindWindowEx(mdiclient, 0&, "aol child", vbNullString)
Dim Winkid1 As Long, Winkid2 As Long, Winkid3 As Long, Winkid4 As Long, FindOtherWin As Long
FindOtherWin = GetWindow(aolchild, GW_HWNDFIRST)
Do While FindOtherWin <> 0
DoEvents
Winkid1 = FindWindowEx(FindOtherWin, 0&, "_aol_static", vbNullString)
Winkid2 = FindWindowEx(FindOtherWin, 0&, "_aol_listbox", vbNullString)
Winkid3 = FindWindowEx(FindOtherWin, 0&, "richcntlstatic", vbNullString)
Winkid4 = FindWindowEx(FindOtherWin, 0&, "_aol_icon", vbNullString)
If (Winkid1 <> 0) And (Winkid2 <> 0) And (Winkid3 <> 0) And (Winkid4 <> 0) Then
FindSwitchSN = FindOtherWin
Exit Function
End If
FindOtherWin = GetWindow(FindOtherWin, GW_HWNDNEXT)
Loop
FindSwitchSN = 0
' example on how to use:
'
' Dim TheWin As Long
' TheWin = FindSwitchSN()
'
' If TheWin <> 0 Then
' What to do if window is there
' End If
End Function
Public Function FindWelcomeWin() As Long
'%% I used PAT or JK's API Spy 5.1 "Generate Function to Find Window" feature
'%% This will find the WelcomeWin by making sure that its common siblings are there
'%% It's used with the GetUser() function to retreive the SN, it can also be
'%% used to tell whether the user is online or not, example at bottom
'
Dim aolframe As Long, mdiclient As Long, aolchild As Long
aolframe = FindWindow("aol frame25", vbNullString)
mdiclient = FindWindowEx(aolframe, 0&, "mdiclient", vbNullString)
aolchild = FindWindowEx(mdiclient, 0&, "aol child", vbNullString)
aolchild = FindWindowEx(mdiclient, aolchild, "aol child", vbNullString)
Dim Winkid1 As Long, Winkid2 As Long, Winkid3 As Long, Winkid4 As Long, Winkid5 As Long, Winkid6 As Long, Winkid7 As Long, Winkid8 As Long, Winkid9 As Long, FindOtherWin As Long
FindOtherWin = GetWindow(aolchild, GW_HWNDFIRST)
Do While FindOtherWin <> 0
DoEvents
Winkid1 = FindWindowEx(FindOtherWin, 0&, "_aol_icon", vbNullString)
Winkid2 = FindWindowEx(FindOtherWin, 0&, "_aol_glyph", vbNullString)
Winkid3 = FindWindowEx(FindOtherWin, 0&, "_aol_icon", vbNullString)
Winkid4 = FindWindowEx(FindOtherWin, 0&, "_aol_glyph", vbNullString)
Winkid5 = FindWindowEx(FindOtherWin, 0&, "richcntlstatic", vbNullString)
Winkid6 = FindWindowEx(FindOtherWin, 0&, "_aol_glyph", vbNullString)
Winkid7 = FindWindowEx(FindOtherWin, 0&, "_aol_icon", vbNullString)
Winkid8 = FindWindowEx(FindOtherWin, 0&, "_aol_glyph", vbNullString)
Winkid9 = FindWindowEx(FindOtherWin, 0&, "richcntlstatic", vbNullString)
If (Winkid1 <> 0) And (Winkid2 <> 0) And (Winkid3 <> 0) And (Winkid4 <> 0) And (Winkid5 <> 0) And (Winkid6 <> 0) And (Winkid7 <> 0) And (Winkid8 <> 0) And (Winkid9 <> 0) Then
FindWelcomeWin = FindOtherWin
Exit Function
End If
FindOtherWin = GetWindow(FindOtherWin, GW_HWNDNEXT)
Loop
FindWelcomeWin = 0
' example on how to use:
'
' Dim TheWin As Long
' TheWin = FindWelcomeWin()
'
' If TheWin <> 0 Then
' User is online since there is a WelcomeWin
' End If
End Function
Public Function FindChatUserInfo() As Long
'%% I used PAT or JK's API Spy 5.1 "Generate Function to Find Window" feature
'%% Finds the Chat User Info window based on its siblings
'%% Works just like FindChat, FindIM, FindWelcomeWin, etc.
'
Dim aolframe As Long, mdiclient As Long, aolchild As Long
aolframe = FindWindow("aol frame25", vbNullString)
mdiclient = FindWindowEx(aolframe, 0&, "mdiclient", vbNullString)
aolchild = FindWindowEx(mdiclient, 0&, "aol child", vbNullString)
Dim Winkid1 As Long, Winkid2 As Long, Winkid3 As Long, Winkid4 As Long, Winkid5 As Long, Winkid6 As Long, FindOtherWin As Long
FindOtherWin = GetWindow(aolchild, GW_HWNDFIRST)
Do While FindOtherWin <> 0
DoEvents
Winkid1 = FindWindowEx(FindOtherWin, 0&, "_aol_static", vbNullString)
Winkid2 = FindWindowEx(FindOtherWin, 0&, "_aol_glyph", vbNullString)
Winkid3 = FindWindowEx(FindOtherWin, 0&, "_aol_static", vbNullString)
Winkid4 = FindWindowEx(FindOtherWin, 0&, "_aol_checkbox", vbNullString)
Winkid5 = FindWindowEx(FindOtherWin, 0&, "_aol_glyph", vbNullString)
Winkid6 = FindWindowEx(FindOtherWin, 0&, "_aol_icon", vbNullString)
If (Winkid1 <> 0) And (Winkid2 <> 0) And (Winkid3 <> 0) And (Winkid4 <> 0) And (Winkid5 <> 0) And (Winkid6 <> 0) Then
FindChatUserInfo = FindOtherWin
Exit Function
End If
FindOtherWin = GetWindow(FindOtherWin, GW_HWNDNEXT)
Loop
FindChatUserInfo = 0
' example on how to use:
'
' Dim TheWin As Long
' TheWin = FindChatUserInfo()
'
' If TheWin <> 0 Then
' What to do if window is there
' End If
End Function
Public Function FindMailBox() As Long
'%% I used PAT or JK's API Spy 5.1 "Generate Function to Find Window" feature
'%% Finds the Chat User Info window based on its siblings
'%% Works just like FindChat, FindIM, FindWelcomeWin, etc.
'
Dim aolframe As Long, mdiclient As Long, aolchild As Long
aolframe = FindWindow("aol frame25", vbNullString)
mdiclient = FindWindowEx(aolframe, 0&, "mdiclient", vbNullString)
aolchild = FindWindowEx(mdiclient, 0&, "aol child", vbNullString)
Dim Winkid1 As Long, Winkid2 As Long, Winkid3 As Long, Winkid4 As Long, Winkid5 As Long, FindOtherWin As Long
FindOtherWin = GetWindow(aolchild, GW_HWNDFIRST)
Do While FindOtherWin <> 0
DoEvents
Winkid1 = FindWindowEx(FindOtherWin, 0&, "_aol_glyph", vbNullString)
Winkid2 = FindWindowEx(FindOtherWin, 0&, "_aol_icon", vbNullString)
Winkid3 = FindWindowEx(FindOtherWin, 0&, "_aol_image", vbNullString)
Winkid4 = FindWindowEx(FindOtherWin, 0&, "_aol_tabcontrol", vbNullString)
Winkid5 = FindWindowEx(FindOtherWin, 0&, "_aol_icon", vbNullString)
If (Winkid1 <> 0) And (Winkid2 <> 0) And (Winkid3 <> 0) And (Winkid4 <> 0) And (Winkid5 <> 0) Then
FindMailBox = FindOtherWin
Exit Function
End If
FindOtherWin = GetWindow(FindOtherWin, GW_HWNDNEXT)
Loop
FindMailBox = 0
' example on how to use:
'
' Dim TheWin As Long
' TheWin = FindMailBox()
'
' If TheWin <> 0 Then
' What to do if window is there
' End If
End Function
Public Function findaolmsgbox() As Long
'%% I modified PAT or JK's API Spy 5.1 "Generate Function to Find Window" feature
'%% I also added a validility, it checks the caption to make sure its an
'%% AOL message box and not any other applications
'%% Finds an AOL Message window based on its siblings
'%% Works just like FindChat, FindIM, FindWelcomeWin, etc.
'
Dim x As Long
x = FindWindow("#32770", vbNullString)
Dim Winkid1 As Long, Winkid2 As Long, FindOtherWin As Long
FindOtherWin = GetWindow(x, GW_HWNDFIRST)
Do While FindOtherWin <> 0
DoEvents
Winkid1 = FindWindowEx(FindOtherWin, 0&, "button", vbNullString)
Winkid2 = FindWindowEx(FindOtherWin, 0&, "static", vbNullString)
If (Winkid1 <> 0) And (Winkid2 <> 0) And GetText(FindOtherWin) = "America Online" Then
findaolmsgbox = FindOtherWin
Exit Function
End If
FindOtherWin = GetWindow(FindOtherWin, GW_HWNDNEXT)
Loop
findaolmsgbox = 0
' example on how to use:
'
' Dim TheWin As Long
' TheWin = FindAOLMsgBox()
' If TheWin <> 0 Then
' What to do if window is there
' You might want to close it by clicking the button
' lngButton = FindWindowEx(FindAOLMsgBox, 0&, "button", vbNullString)
' call clickicon(lngbutton)
' End If
End Function
Public Function FindProfileEdit() As Long
'%% I used PAT or JK's API Spy 5.1 "Generate Function to Find Window" feature
'%% Finds the Profile Edit window based on its siblings
'%% Works just like FindChat, FindIM, FindWelcomeWin, etc.
'
Dim aolframe As Long, mdiclient As Long, aolchild As Long
aolframe = FindWindow("aol frame25", vbNullString)
mdiclient = FindWindowEx(aolframe, 0&, "mdiclient", vbNullString)
aolchild = FindWindowEx(mdiclient, 0&, "aol child", "Edit Your Online Profile")
Dim Winkid1 As Long, Winkid2 As Long, Winkid3 As Long, Winkid4 As Long, Winkid5 As Long, Winkid6 As Long, Winkid7 As Long, Winkid8 As Long, Winkid9 As Long, FindOtherWin As Long
FindOtherWin = GetWindow(aolchild, GW_HWNDFIRST)
Do While FindOtherWin <> 0
DoEvents
Winkid1 = FindWindowEx(FindOtherWin, 0&, "_aol_static", vbNullString)
Winkid2 = FindWindowEx(FindOtherWin, 0&, "_aol_icon", vbNullString)
Winkid3 = FindWindowEx(FindOtherWin, 0&, "_aol_edit", vbNullString)
Winkid4 = FindWindowEx(FindOtherWin, 0&, "_aol_radiobox", vbNullString)
Winkid5 = FindWindowEx(FindOtherWin, 0&, "_aol_edit", vbNullString)
Winkid6 = FindWindowEx(FindOtherWin, 0&, "_aol_checkbox", vbNullString)
Winkid7 = FindWindowEx(FindOtherWin, 0&, "_aol_static", vbNullString)
Winkid8 = FindWindowEx(FindOtherWin, 0&, "_aol_icon", vbNullString)
Winkid9 = FindWindowEx(FindOtherWin, 0&, "_aol_edit", vbNullString)
If (Winkid1 <> 0) And (Winkid2 <> 0) And (Winkid3 <> 0) And (Winkid4 <> 0) And (Winkid5 <> 0) And (Winkid6 <> 0) And (Winkid7 <> 0) And (Winkid8 <> 0) And (Winkid9 <> 0) Then
FindProfileEdit = FindOtherWin
Exit Function
End If
FindOtherWin = GetWindow(FindOtherWin, GW_HWNDNEXT)
Loop
FindProfileEdit = 0
' example on how to use:
'
' Dim TheWin As Long
' TheWin = FindProfileEdit()
'
' If TheWin <> 0 Then
' What to do if window is there
' End If
End Function
Public Function FindMemberDir() As Long
'%% I used PAT or JK's API Spy 5.1 "Generate Function to Find Window" feature
'%% Finds the Member Directory window based on its siblings
'%% Works just like FindChat, FindIM, FindWelcomeWin, etc.
'
Dim aolframe As Long, mdiclient As Long, aolchild As Long
aolframe = FindWindow("aol frame25", vbNullString)
mdiclient = FindWindowEx(aolframe, 0&, "mdiclient", vbNullString)
aolchild = FindWindowEx(mdiclient, 0&, "aol child", vbNullString)
Dim Winkid1 As Long, Winkid2 As Long, Winkid3 As Long, Winkid4 As Long, Winkid5 As Long, Winkid6 As Long, Winkid7 As Long, Winkid8 As Long, Winkid9 As Long, FindOtherWin As Long
FindOtherWin = GetWindow(aolchild, GW_HWNDFIRST)
Do While FindOtherWin <> 0
DoEvents
Winkid1 = FindWindowEx(FindOtherWin, 0&, "_aol_static", vbNullString)
Winkid2 = FindWindowEx(FindOtherWin, 0&, "_aol_icon", vbNullString)
Winkid3 = FindWindowEx(FindOtherWin, 0&, "_aol_combobox", vbNullString)
Winkid4 = FindWindowEx(FindOtherWin, 0&, "_aol_icon", vbNullString)
Winkid5 = FindWindowEx(FindOtherWin, 0&, "_aol_static", vbNullString)
Winkid6 = FindWindowEx(FindOtherWin, 0&, "_aol_edit", vbNullString)
Winkid7 = FindWindowEx(FindOtherWin, 0&, "_aol_static", vbNullString)
Winkid8 = FindWindowEx(FindOtherWin, 0&, "_aol_edit", vbNullString)
Winkid9 = FindWindowEx(FindOtherWin, 0&, "_aol_static", vbNullString)
If (Winkid1 <> 0) And (Winkid2 <> 0) And (Winkid3 <> 0) And (Winkid4 <> 0) And (Winkid5 <> 0) And (Winkid6 <> 0) And (Winkid7 <> 0) And (Winkid8 <> 0) And (Winkid9 <> 0) Then
FindMemberDir = FindOtherWin
Exit Function
End If
FindOtherWin = GetWindow(FindOtherWin, GW_HWNDNEXT)
Loop
FindMemberDir = 0
' example on how to use:
'
' Dim TheWin As Long
' TheWin = FindMemberDir()
' If TheWin <> 0 Then
' What to do if window is there
' End If
End Function
Public Function FindKeyWord() As Long
'%% I used PAT or JK's API Spy 5.1 "Generate Function to Find Window" feature
'%% Finds the AOL KeyWord Window (ctrl+K) based on its siblings
'%% Works just like FindChat, FindIM, FindWelcomeWin, etc.
'
Dim aolframe As Long, mdiclient As Long, aolchild As Long
aolframe = FindWindow("aol frame25", vbNullString)
mdiclient = FindWindowEx(aolframe, 0&, "mdiclient", vbNullString)
aolchild = FindWindowEx(mdiclient, 0&, "aol child", vbNullString)
Dim Winkid1 As Long, Winkid2 As Long, Winkid3 As Long, Winkid4 As Long, Winkid5 As Long, FindOtherWin As Long
FindOtherWin = GetWindow(aolchild, GW_HWNDFIRST)
Do While FindOtherWin <> 0
DoEvents
Winkid1 = FindWindowEx(FindOtherWin, 0&, "_aol_glyph", vbNullString)
Winkid2 = FindWindowEx(FindOtherWin, 0&, "richcntlstatic", vbNullString)
Winkid3 = FindWindowEx(FindOtherWin, 0&, "_aol_edit", vbNullString)
Winkid4 = FindWindowEx(FindOtherWin, 0&, "_aol_icon", vbNullString)
Winkid5 = FindWindowEx(FindOtherWin, 0&, "richcntlstatic", vbNullString)
If (Winkid1 <> 0) And (Winkid2 <> 0) And (Winkid3 <> 0) And (Winkid4 <> 0) And (Winkid5 <> 0) Then
FindKeyWord = FindOtherWin
Exit Function
End If
FindOtherWin = GetWindow(FindOtherWin, GW_HWNDNEXT)
Loop
FindKeyWord = 0
' example on how to use:
'
' Dim TheWin As Long
' TheWin = FindKeyWord()
'
' If TheWin <> 0 Then
' What to do if window is there
' End If
End Function
Public Function FindBuddyChatInv() As Long
'%% I used PAT or JK's API Spy 5.1 "Generate Function to Find Window" feature
'%% Finds the Buddy Chat Invite window based on its siblings
'%% Works just like FindChat, FindIM, FindWelcomeWin, etc.
'
Dim aolframe As Long, mdiclient As Long, aolchild As Long
aolframe = FindWindow("aol frame25", vbNullString)
mdiclient = FindWindowEx(aolframe, 0&, "mdiclient", vbNullString)
aolchild = FindWindowEx(mdiclient, 0&, "aol child", vbNullString)
Dim Winkid1 As Long, Winkid2 As Long, Winkid3 As Long, Winkid4 As Long, Winkid5 As Long, Winkid6 As Long, FindOtherWin As Long
FindOtherWin = GetWindow(aolchild, GW_HWNDFIRST)
Do While FindOtherWin <> 0
DoEvents
Winkid1 = FindWindowEx(FindOtherWin, 0&, "_aol_static", vbNullString)
Winkid2 = FindWindowEx(FindOtherWin, 0&, "_aol_edit", vbNullString)
Winkid3 = FindWindowEx(FindOtherWin, 0&, "_aol_static", vbNullString)
Winkid4 = FindWindowEx(FindOtherWin, 0&, "_aol_edit", vbNullString)
Winkid5 = FindWindowEx(FindOtherWin, 0&, "_aol_icon", vbNullString)
Winkid6 = FindWindowEx(FindOtherWin, 0&, "_aol_radiobox", vbNullString)
If (Winkid1 <> 0) And (Winkid2 <> 0) And (Winkid3 <> 0) And (Winkid4 <> 0) And (Winkid5 <> 0) And (Winkid6 <> 0) Then
FindBuddyChatInv = FindOtherWin
Exit Function
End If
FindOtherWin = GetWindow(FindOtherWin, GW_HWNDNEXT)
Loop
FindBuddyChatInv = 0
' example on how to use:
'
' Dim TheWin As Long
' TheWin = FindBuddyChatInv()
'
' If TheWin <> 0 Then
' What to do if window is there
' End If
End Function
Public Function FindBuddyInvReq() As Long
'%% I used PAT or JK's API Spy 5.1 "Generate Function to Find Window" feature
'%% Finds the Buddy Invitation Request window (when somone sends you a buddy chat invitation)
'%% Works just like FindChat, FindIM, FindWelcomeWin, etc.
'
Dim aolframe As Long, mdiclient As Long, aolchild As Long
aolframe = FindWindow("aol frame25", vbNullString)
mdiclient = FindWindowEx(aolframe, 0&, "mdiclient", vbNullString)
aolchild = FindWindowEx(mdiclient, 0&, "aol child", vbNullString)
Dim Winkid1 As Long, Winkid2 As Long, Winkid3 As Long, Winkid4 As Long, Winkid5 As Long, Winkid6 As Long, Winkid7 As Long, Winkid8 As Long, Winkid9 As Long, FindOtherWin As Long
FindOtherWin = GetWindow(aolchild, GW_HWNDFIRST)
Do While FindOtherWin <> 0
DoEvents
Winkid1 = FindWindowEx(FindOtherWin, 0&, "_aol_static", vbNullString)
Winkid2 = FindWindowEx(FindOtherWin, 0&, "richcntlstatic", vbNullString)
Winkid3 = FindWindowEx(FindOtherWin, 0&, "_aol_static", vbNullString)
Winkid4 = FindWindowEx(FindOtherWin, 0&, "_aol_view", vbNullString)
Winkid5 = FindWindowEx(FindOtherWin, 0&, "_aol_static", vbNullString)
Winkid6 = FindWindowEx(FindOtherWin, 0&, "_aol_checkbox", vbNullString)
Winkid7 = FindWindowEx(FindOtherWin, 0&, "_aol_icon", vbNullString)
Winkid8 = FindWindowEx(FindOtherWin, 0&, "_aol_view", vbNullString)
Winkid9 = FindWindowEx(FindOtherWin, 0&, "_aol_static", vbNullString)
If (Winkid1 <> 0) And (Winkid2 <> 0) And (Winkid3 <> 0) And (Winkid4 <> 0) And (Winkid5 <> 0) And (Winkid6 <> 0) And (Winkid7 <> 0) And (Winkid8 <> 0) And (Winkid9 <> 0) Then
FindBuddyInvReq = FindOtherWin
Exit Function
End If
FindOtherWin = GetWindow(FindOtherWin, GW_HWNDNEXT)
Loop
FindBuddyInvReq = 0
'
' example on how to use:
'
' Dim TheWin As Long
' TheWin = FindBuddyInvReq()
' If TheWin <> 0 Then
' What to do if window is there
' Call BuddyInvReqRespond (False)
' End If
End Function
Public Function FindSendIM() As Long
'%% I used PAT or JK's API Spy 5.1 "Generate Function to Find Window" feature
'%% Finds the Send IM window (When you press Ctrl+I) based on its siblings
'%% Works just like FindChat, FindIM, FindWelcomeWin, etc.
'
Dim aolframe As Long, mdiclient As Long, aolchild As Long
aolframe = FindWindow("aol frame25", vbNullString)
mdiclient = FindWindowEx(aolframe, 0&, "mdiclient", vbNullString)
aolchild = FindWindowEx(mdiclient, 0&, "aol child", vbNullString)
Dim Winkid1 As Long, Winkid2 As Long, Winkid3 As Long, Winkid4 As Long, Winkid5 As Long, FindOtherWin As Long
FindOtherWin = GetWindow(aolchild, GW_HWNDFIRST)
Do While FindOtherWin <> 0
DoEvents
Winkid1 = FindWindowEx(FindOtherWin, 0&, "_aol_static", vbNullString)
Winkid2 = FindWindowEx(FindOtherWin, 0&, "_aol_edit", vbNullString)
Winkid3 = FindWindowEx(FindOtherWin, 0&, "_aol_icon", vbNullString)
Winkid4 = FindWindowEx(FindOtherWin, 0&, "richcntl", vbNullString)
Winkid5 = FindWindowEx(FindOtherWin, 0&, "_aol_icon", vbNullString)
If (Winkid1 <> 0) And (Winkid2 <> 0) And (Winkid3 <> 0) And (Winkid4 <> 0) And (Winkid5 <> 0) Then
FindSendIM = FindOtherWin
Exit Function
End If
FindOtherWin = GetWindow(FindOtherWin, GW_HWNDNEXT)
Loop
FindSendIM = 0
' example on how to use:
'
' Dim TheWin As Long
' TheWin = FindSendIM()
' If TheWin <> 0 Then
' What to do if window is there
' End If
End Function
Public Function FindChildByTitle(strTitle As String) As Long
'%% Don't usually like using this, but I made this function
'%% to allow you to find AOL window handles based on their titles
'%% makes it much easier to find AOL connection Window (which as 2 states)
'
Dim aolframe As Long, mdiclient As Long, aolchild As Long, FindOtherWin As Long
aolframe = FindWindow("aol frame25", vbNullString)
mdiclient = FindWindowEx(aolframe, 0&, "mdiclient", vbNullString)
aolchild = FindWindowEx(mdiclient, 0&, "aol child", strTitle)
FindChildByTitle = aolchild
End Function
Public Function FindAOLConnectWin() As Long
'%% Used my FindChildByTitle() function to get this window
'%% too difficult to find any other way, b/c there are 2 states
'%% and it gets confused with the connection sequence window
'
Dim lngConWin As Long
'state 1 (first opend aol)
lngConWin = FindChildByTitle("sign on")
'if not, then its state 2, (just signed off)
If lngConWin = 0& Then
lngConWin = FindChildByTitle("goodbye from america online!")
End If
'make sure we don't confuse with AOL Connection Sequence window
Dim aolframe As Long, aolmodal As Long, AOLStatic As Long, strStatic As String
aolframe = FindWindow("aol frame25", vbNullString)
aolmodal = FindWindow("_aol_modal", vbNullString)
AOLStatic = FindWindowEx(aolmodal, 0&, "_aol_static", vbNullString)
strStatic = LCase(GetText(AOLStatic))
If InStr(strStatic$, "step") Then
lngConWin = 0&
End If
FindAOLConnectWin = lngConWin
' example on how to use:
'
' Dim TheWin As Long
' TheWin = FindAOLConnectWin()
'
' If TheWin <> 0 Then
' What to do if window is there
' End If
End Function
Public Function FindAOLGuestPrompt() As Long
'%% I used PAT or JK's API Spy 5.1 "Generate Function to Find Window" feature
'%% Finds the Guest Prompt window (After clicking sign on Guest) based on siblings
'%% Works just like FindChat, FindIM, FindWelcomeWin, etc.
'
Dim aolframe As Long, aolmodal As Long
aolframe = FindWindow("aol frame25", vbNullString)
aolmodal = FindWindow("_aol_modal", vbNullString)
Dim Winkid1 As Long, Winkid2 As Long, Winkid3 As Long, Winkid4 As Long, Winkid5 As Long, Winkid6 As Long, FindOtherWin As Long
FindOtherWin = GetWindow(aolmodal, GW_HWNDFIRST)
Do While FindOtherWin <> 0
DoEvents
Winkid1 = FindWindowEx(FindOtherWin, 0&, "_aol_static", vbNullString)
Winkid2 = FindWindowEx(FindOtherWin, 0&, "_aol_edit", vbNullString)
Winkid3 = FindWindowEx(FindOtherWin, 0&, "_aol_static", vbNullString)
Winkid4 = FindWindowEx(FindOtherWin, 0&, "_aol_edit", vbNullString)
Winkid5 = FindWindowEx(FindOtherWin, 0&, "_aol_static", vbNullString)
Winkid6 = FindWindowEx(FindOtherWin, 0&, "_aol_icon", vbNullString)
If (Winkid1 <> 0) And (Winkid2 <> 0) And (Winkid3 <> 0) And (Winkid4 <> 0) And (Winkid5 <> 0) And (Winkid6 <> 0) Then
FindAOLGuestPrompt = FindOtherWin
Exit Function
End If
FindOtherWin = GetWindow(FindOtherWin, GW_HWNDNEXT)
Loop
FindAOLGuestPrompt = 0
' example on how to use:
'
' Dim TheWin As Long
' TheWin = FindAOLGuestPrompt()
'
' If TheWin <> 0 Then
' What to do if window is there
' End If
End Function
Public Function FindAOLConnectSeq() As Long
'%% I used PAT or JK's API Spy 5.1 "Generate Function to Find Window" feature
'%% Finds the AOL Connection Sequence window (After clicking sign on) based on siblings
'%% Works just like FindChat, FindIM, FindWelcomeWin, etc.
'
Dim aolframe As Long, aolmodal As Long
aolframe = FindWindow("aol frame25", vbNullString)
aolmodal = FindWindow("_aol_modal", vbNullString)
Dim Winkid1 As Long, Winkid2 As Long, Winkid3 As Long, FindOtherWin As Long
FindOtherWin = GetWindow(aolmodal, GW_HWNDFIRST)
Do While FindOtherWin <> 0
DoEvents
Winkid1 = FindWindowEx(FindOtherWin, 0&, "_aol_glyph", vbNullString)
Winkid2 = FindWindowEx(FindOtherWin, 0&, "_aol_static", vbNullString)
Winkid3 = FindWindowEx(FindOtherWin, 0&, "_aol_icon", vbNullString)
If (Winkid1 <> 0) And (Winkid2 <> 0) And (Winkid3 <> 0) Then
FindAOLConnectSeq = FindOtherWin
Exit Function
End If
FindOtherWin = GetWindow(FindOtherWin, GW_HWNDNEXT)
Loop
FindAOLConnectSeq = 0
' example on how to use:
'
' Dim TheWin As Long
' TheWin = FindAOLConnectSeq()
'
' If TheWin <> 0 Then
' What to do if window is there
' End If
End Function
Public Sub clickmsgbox(lngMsgBox As Long)
'%% This will click the first button on a message box
'%% Ex:
'%% Call ClickMsgBox(FindAOLMsgBox)
Dim lngButton As Long
'Find the button on the message box
lngButton = FindWindowEx(lngMsgBox, 0&, "button", vbNullString)
'Click that button (we have to click it differently than ClickIcon)
Call PostMessage(lngButton, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(lngButton, WM_KEYUP, VK_SPACE, 0&)
'
'%% As you can see, this can be used in Room Busters...
'%% For Example:
'
'%% Do: DoEvents
'%% Call GoToKeyWord("aol://2719:2-2-cerver3")
'%% Wait 0.2
'%% ClickMsgBox (FindAOLMsgBox)
'%% Wait 1
'%% Loop Until FindRoom <> 0&
End Sub
Public Sub Clearchat()
'author: latino
'date: 01.18.03
'purpose: to clear the chatroom
Dim room As Long, richcn As Long, clearnow As Long
room = FindRoom()
If room = 0 Then Exit Sub
richcn = FindWindowEx(room, 0&, "richcntlreadonly", vbNullString)
Call SendMessageByString(richcn, WM_SETTEXT, 0, clearnow)
End Sub
Public Function FindBuddyList() As Long
'%% I used PAT or JK's API Spy 5.1 "Generate Function to Find Window" feature
'%% Finds the Buddy List window based on its siblings
'%% Works just like FindChat, FindIM, FindWelcomeWin, etc.
'
Dim aolframe As Long, mdiclient As Long, aolchild As Long
aolframe = FindWindow("aol frame25", vbNullString)
mdiclient = FindWindowEx(aolframe, 0&, "mdiclient", vbNullString)
aolchild = FindWindowEx(mdiclient, 0&, "aol child", vbNullString)
aolchild = FindWindowEx(mdiclient, aolchild, "aol child", vbNullString)
Dim Winkid1 As Long, Winkid2 As Long, Winkid3 As Long, Winkid4 As Long, Winkid5 As Long, Winkid6 As Long, Winkid7 As Long, Winkid8 As Long, Winkid9 As Long, FindOtherWin As Long
FindOtherWin = GetWindow(aolchild, GW_HWNDFIRST)
Do While FindOtherWin <> 0
DoEvents
Winkid1 = FindWindowEx(FindOtherWin, 0&, "_aol_view", vbNullString)
Winkid2 = FindWindowEx(FindOtherWin, 0&, "_aol_icon", vbNullString)
Winkid3 = FindWindowEx(FindOtherWin, 0&, "_aol_static", vbNullString)
Winkid4 = FindWindowEx(FindOtherWin, 0&, "_aol_treectrl", vbNullString)
Winkid5 = FindWindowEx(FindOtherWin, 0&, "_aol_static", vbNullString)
Winkid6 = FindWindowEx(FindOtherWin, 0&, "_aol_icon", vbNullString)
Winkid7 = FindWindowEx(FindOtherWin, 0&, "_aol_static", vbNullString)
Winkid8 = FindWindowEx(FindOtherWin, 0&, "_aol_icon", vbNullString)
Winkid9 = FindWindowEx(FindOtherWin, 0&, "_aol_static", vbNullString)
If (Winkid1 <> 0) And (Winkid2 <> 0) And (Winkid3 <> 0) And (Winkid4 <> 0) And (Winkid5 <> 0) And (Winkid6 <> 0) And (Winkid7 <> 0) And (Winkid8 <> 0) And (Winkid9 <> 0) Then
FindBuddyList = FindOtherWin
Exit Function
End If
FindOtherWin = GetWindow(FindOtherWin, GW_HWNDNEXT)
Loop
FindBuddyList = 0
' example on how to use:
'
' Dim TheWin As Long
' TheWin = FindBuddyList()
'
' If TheWin <> 0 Then
' What to do if window is there
' End If
End Function
Public Function FindChannels() As Long
'%% I used PAT or JK's API Spy 5.1 "Generate Function to Find Window" feature
'%% Finds the Channels window based on its siblings
'%% Works just like FindChat, FindIM, FindWelcomeWin, etc.
'
Dim aolframe As Long, mdiclient As Long, aolchild As Long
aolframe = FindWindow("aol frame25", vbNullString)
mdiclient = FindWindowEx(aolframe, 0&, "mdiclient", vbNullString)
aolchild = FindWindowEx(mdiclient, 0&, "aol child", vbNullString)
aolchild = FindWindowEx(mdiclient, aolchild, "aol child", vbNullString)
aolchild = FindWindowEx(mdiclient, aolchild, "aol child", vbNullString)
aolchild = FindWindowEx(mdiclient, aolchild, "aol child", vbNullString)
Dim Winkid1 As Long, Winkid2 As Long, FindOtherWin As Long
FindOtherWin = GetWindow(aolchild, GW_HWNDFIRST)
Do While FindOtherWin <> 0
DoEvents
Winkid1 = FindWindowEx(FindOtherWin, 0&, "_aol_static", vbNullString)
Winkid2 = FindWindowEx(FindOtherWin, 0&, "_aol_icon", vbNullString)
If (Winkid1 <> 0) And (Winkid2 <> 0) Then
FindChannels = FindOtherWin
Exit Function
End If
FindOtherWin = GetWindow(FindOtherWin, GW_HWNDNEXT)
Loop
FindChannels = 0
' example on how to use:
'
' Dim TheWin As Long
' TheWin = FindChannels()
'
' If TheWin <> 0 Then
' What to do if window is there
' End If
End Function
Public Function FindMail() As Long
'%% I used PAT or JK's API Spy 5.1 "Generate Function to Find Window" feature
'%% Finds the Mail Reply/Fwd window (when you open an email from the inbox)
'%% Works just like FindChat, FindIM, FindWelcomeWin, etc.
'
Dim aolframe As Long, mdiclient As Long, aolchild As Long
aolframe = FindWindow("aol frame25", vbNullString)
mdiclient = FindWindowEx(aolframe, 0&, "mdiclient", vbNullString)
aolchild = FindWindowEx(mdiclient, 0&, "aol child", vbNullString)
Dim Winkid1 As Long, Winkid2 As Long, Winkid3 As Long, Winkid4 As Long, Winkid5 As Long, Winkid6 As Long, Winkid7 As Long, FindOtherWin As Long
FindOtherWin = GetWindow(aolchild, GW_HWNDFIRST)
Do While FindOtherWin <> 0
DoEvents
Winkid1 = FindWindowEx(FindOtherWin, 0&, "_aol_static", vbNullString)
Winkid2 = FindWindowEx(FindOtherWin, 0&, "atl:67018040", vbNullString)
Winkid3 = FindWindowEx(FindOtherWin, 0&, "_aol_view", vbNullString)
Winkid4 = FindWindowEx(FindOtherWin, 0&, "_aol_static", vbNullString)
Winkid5 = FindWindowEx(FindOtherWin, 0&, "_aol_icon", vbNullString)
Winkid6 = FindWindowEx(FindOtherWin, 0&, "_aol_static", vbNullString)
Winkid7 = FindWindowEx(FindOtherWin, 0&, "_aol_icon", vbNullString)
If (Winkid1 <> 0) And (Winkid2 <> 0) And (Winkid3 <> 0) And (Winkid4 <> 0) And (Winkid5 <> 0) And (Winkid6 <> 0) And (Winkid7 <> 0) Then
FindMail = FindOtherWin
Exit Function
End If
FindOtherWin = GetWindow(FindOtherWin, GW_HWNDNEXT)
Loop
FindMail = 0
' example on how to use:
'
' Dim TheWin As Long
' TheWin = FindMail()
'
' If TheWin <> 0 Then
' What to do if window is there
' End If
End Function
Public Function FindCompose() As Long
'%% I used PAT or JK's API Spy 5.1 "Generate Function to Find Window" feature
'%% Finds the Compose Mail window based on its siblings
'%% Works just like FindChat, FindIM, FindWelcomeWin, etc.
'
Dim aolframe As Long, mdiclient As Long, aolchild As Long
aolframe = FindWindow("aol frame25", vbNullString)
mdiclient = FindWindowEx(aolframe, 0&, "mdiclient", vbNullString)
aolchild = FindWindowEx(mdiclient, 0&, "aol child", vbNullString)
Dim Winkid1 As Long, Winkid2 As Long, Winkid3 As Long, Winkid4 As Long, Winkid5 As Long, Winkid6 As Long, Winkid7 As Long, Winkid8 As Long, Winkid9 As Long, FindOtherWin As Long
FindOtherWin = GetWindow(aolchild, GW_HWNDFIRST)
Do While FindOtherWin <> 0
DoEvents
Winkid1 = FindWindowEx(FindOtherWin, 0&, "_aol_icon", vbNullString)
Winkid2 = FindWindowEx(FindOtherWin, 0&, "_aol_static", vbNullString)
Winkid3 = FindWindowEx(FindOtherWin, 0&, "_aol_edit", vbNullString)
Winkid4 = FindWindowEx(FindOtherWin, 0&, "_aol_static", vbNullString)
Winkid5 = FindWindowEx(FindOtherWin, 0&, "_aol_icon", vbNullString)
Winkid6 = FindWindowEx(FindOtherWin, 0&, "_aol_edit", vbNullString)
Winkid7 = FindWindowEx(FindOtherWin, 0&, "_aol_static", vbNullString)
Winkid8 = FindWindowEx(FindOtherWin, 0&, "_aol_edit", vbNullString)
Winkid9 = FindWindowEx(FindOtherWin, 0&, "_aol_fontcombo", vbNullString)
If (Winkid1 <> 0) And (Winkid2 <> 0) And (Winkid3 <> 0) And (Winkid4 <> 0) And (Winkid5 <> 0) And (Winkid6 <> 0) And (Winkid7 <> 0) And (Winkid8 <> 0) And (Winkid9 <> 0) Then
FindCompose = FindOtherWin
Exit Function
End If
FindOtherWin = GetWindow(FindOtherWin, GW_HWNDNEXT)
Loop
FindCompose = 0
' example on how to use:
'
' Dim TheWin As Long
' TheWin = FindCompose()
'
' If TheWin <> 0 Then
' What to do if window is there
' End If
End Function
Public Function FindMailErrorWin() As Long
'%% I used PAT or JK's API Spy 5.1 "Generate Function to Find Window" feature
'%% Finds the Mail Error window (error sending e-mails to non-existant SNs)
'%% Works just like FindChat, FindIM, FindWelcomeWin, etc.
'
Dim aolframe As Long, mdiclient As Long, aolchild As Long
aolframe = FindWindow("aol frame25", vbNullString)
mdiclient = FindWindowEx(aolframe, 0&, "mdiclient", vbNullString)
aolchild = FindWindowEx(mdiclient, 0&, "aol child", vbNullString)
Dim Winkid1 As Long, Winkid2 As Long, Winkid3 As Long, FindOtherWin As Long
FindOtherWin = GetWindow(aolchild, GW_HWNDFIRST)
Do While FindOtherWin <> 0
DoEvents
Winkid1 = FindWindowEx(FindOtherWin, 0&, "_aol_button", vbNullString)
Winkid2 = FindWindowEx(FindOtherWin, 0&, "_aol_view", vbNullString)
Winkid3 = FindWindowEx(FindOtherWin, 0&, "_aol_icon", vbNullString)
If (Winkid1 <> 0) And (Winkid2 <> 0) And (Winkid3 <> 0) Then
FindMailErrorWin = FindOtherWin
Exit Function
End If
FindOtherWin = GetWindow(FindOtherWin, GW_HWNDNEXT)
Loop
FindMailErrorWin = 0
' example on how to use:
'
' Dim TheWin As Long
' TheWin = FindMailErrorWin()
'
' If TheWin <> 0 Then
' What to do if window is there
' End If
End Function
Public Function FindModalWin() As Long
'%% Finds Modal Windows, for example: About AOL, 'Message could not be sent', etc.
'%% Ex:
'%% Dim lngModalWin As Long
'%% lngModalWin = FindModalWin
Dim aolframe As Long
aolframe = FindWindow("aol frame25", vbNullString)
FindModalWin = FindWindow("_aol_modal", vbNullString)
End Function
Public Sub KillModals()
'%% Kills any Modal Windows found, loops
'%% Ex:
'%% Call KillModals()
'
Do: DoEvents
closewin (FindModalWin)
Loop Until FindModalWin = 0
End Sub
Public Sub KillModalsNicely()
'%% Kills any Modal Windows found nicely, loops
'%% by nicely, i mean click the first button
'%% Ex:
'%% Call KillModalsNicely()
'
Do: DoEvents
Call ClickIcon(FindWindowEx(FindModalWin, 0&, "_aol_icon", vbNullString))
Loop Until FindModalWin = 0
End Sub
Public Function ToolbarButton(ButtonIndex As Integer) As Long
'%% Now this is very versitile, but you have to know the index value
'%% for each button that you want to click. I ran through each one:
'%% 0 = Channels Button (no clue why AOL set it up this way)
'%% 1 = Mail Menu
'%% 2 = Read Mail
'%% 3 = Write Mail
'
'%% 4 = People Menu
'%% 5 = Send IM
'%% 6 = Chat Now
'
'%% 7 = Services Menu
'%% 8 = Shop
'%% 9 = Internet
'
'%% 10 = Settings
'%% 11 = AOL Help
'
'%% 12 = Favorites Menu
'%% 13 = My Favorites
'%% 14 = Radio
'%% 15 = Parental Controls
'%% 16 = Alerts & Reminders
'
'%% 17 = AOL Keyword
'%% 18 = Back
'%% 19 = Forward
'%% 20 = Stop
'%% 21 = Refresh
'%% 22 = AOL Toolbar TextBox
'%% 23 = Go Button
'%% 24 = Search Button
'%% 25 = AOL Keyword
'%% 26+ = Any number after 26 are custom icons that the user has made
'%% by clicking and dragging the 'heart icon' onto the toolbar
'%% You can tell if these exist by doing:
'%% If ToolbarButton(27) <> 0& Then
'%% 'it exists
'%% End If
'
'%% Ex:
'%% lngNewMailButton = ToolbarButton(2) '<-- Compose New Mail Button
'%% lngSendIMButton = ToolbarButton(4) '<-- Open Send IM Menu Button, etc.
Dim aolframe As Long, aoltoolbar As Long, AOLIcon As Long
Dim i As Integer
'Find the Toolbar
aolframe = FindWindow("aol frame25", vbNullString)
aoltoolbar = FindWindowEx(aolframe, 0&, "aol toolbar", vbNullString)
aoltoolbar = FindWindowEx(aoltoolbar, 0&, "_aol_toolbar", vbNullString)
'Find the Icon to click
If ButtonIndex = 0 Then 'no need to run through For/Next statement
AOLIcon = FindWindowEx(aoltoolbar, 0&, "_aol_icon", vbNullString)
Else
For i = 0 To ButtonIndex
AOLIcon = FindWindowEx(aoltoolbar, AOLIcon, "_aol_icon", vbNullString)
Next i
End If
ToolbarButton = AOLIcon
'Click it
'To click it, just put this in a sub:
'Call ClickIcon(ToolbarButton(4))
End Function
Public Sub BuddyChat(strwho As String, strMsg As String, strWhere As String)
'%% Sends a Buddy Chat Invite to strWho with message of strMessage to chat room strWhere
'%% Seperate multiple strWho's with commas, goes to private room strWhere
'%% Ex:
'%% Call BuddyInvSend("thisguy, andthatguy, plusthisguy, andhim", "Testing, "magik")
'
Dim lngBuddyChat As Long, lngWho As Long, lngMsg As Long, lngWhere As Long
Dim lngSend As Long
'open buddy chat invite window
Call GotoKeyWord("buddy chat")
Do: DoEvents
lngBuddyChat = FindBuddyChatInv
Loop Until lngBuddyChat <> 0&
'find textboxes
lngWho = FindWindowEx(lngBuddyChat, 0&, "_aol_edit", vbNullString)
lngMsg = FindWindowEx(lngBuddyChat, lngWho, "_aol_edit", vbNullString)
lngWhere = FindWindowEx(lngBuddyChat, lngMsg, "_aol_edit", vbNullString)
lngSend = FindWindowEx(lngBuddyChat, 0&, "_aol_icon", vbNullString)
'set info
Call SetText(lngWho, strwho)
Call SetText(lngMsg, strMsg)
Call SetText(lngWhere, strWhere)
'click send
Call ClickIcon(lngSend)
End Sub
Public Sub BuddyChatRespond(blnAccept As Boolean, Optional blnSendIM As Boolean = False, Optional strMsg As String)
'%% Allows you to accept/decline any Buddy Chat Requests
'%% The Optional blnSendIM allows you to respond to the sender with strMsg
'%% Ex:
'%% Call BuddyChatRespond(True, True, "okay, im coming")
'
Dim lngwin As Long, lngAccept As Long, strwho As String
'find the windows
lngwin = FindBuddyInvReq
lngAccept = FindWindowEx(lngwin, 0&, "_aol_icon", vbNullString)
strwho = BuddyChatSender
'click go if desired
If blnAccept = True Then
Call ClickIcon(lngAccept)
Else
Call closewin(lngwin)
End If
End Sub
Public Function BuddyChatWhereTo() As String
'%% Returns the private room that a Buddy Chat Invite Request is going to
'%% Ex:
'%% strRoom = BuddyChatWhereTo()
'
Dim lngBuddyChatReq As Long, lngText As Long
'find it
lngBuddyChatReq = FindBuddyInvReq
'get the textbox of the chat room
lngText = FindWindowEx(lngBuddyChatReq, 0&, "_aol_view", vbNullString)
'return the chat room name
BuddyChatWhereTo = GetText(lngText)
End Function
Public Function BuddyChatSender() As String
'%% Returns the sender of a Buddy Chat Invite Request
'%% Ex:
'%% strSender = BuddyChatSender()
'
Dim lngBuddyChatReq As Long
Dim strCap As String, intLoc As Integer
'find it
lngBuddyChatReq = FindBuddyInvReq
'get caption
strCap = GetText(lngBuddyChatReq)
'extract sn
intLoc = InStr(strCap, ":")
strCap = Mid(strCap, intLoc + 2)
'return the sn
BuddyChatSender = strCap
End Function
Public Sub ListDblClick(lngList As Long, intIndex As Integer)
'%% Double-Clicks (opens) list item lngIndex in lngList
'%% Ex:
'%% Call ListDblClick(AOLList, 4)
'
'Select it
Call SendMessageLong(lngList, LB_SETCURSEL, intIndex, 0&)
'Double-Click it
Call SendMessageLong(lngList, WM_LBUTTONDBLCLK, intIndex, 0&)
End Sub
Public Sub listselect(lngList As Long, intIndex As Integer)
'%% Just selects an item in a list (lngList)
'%% Ex:
'%% Call ListSelect(AOLList, 4)
'%% Selection API
Call SendMessageLong(lngList, LB_SETCURSEL, intIndex, 0&)
End Sub
Public Sub ListSelectByEnter(lngList As Long, intIndex As Integer)
'%% Does the same thing as the ListDblClick, but for some reason
'%% Reading mail using ListDblClick does not work, so what this does
'%% Is it selects the Item, then sends an enter to open it.
'%% Ex:
'%% Call ListSelectByEnter(MailList, 4)
'' Select it
Call SendMessageLong(lngList, LB_SETCURSEL, intIndex, 0&)
'Press Enter
Call SendMessageLong(lngList, WM_KEYDOWN, 13, 0&)
Call SendMessageLong(lngList, WM_KEYUP, 13, 0&)
End Sub
Public Sub ComboSelect(lngCombo As Long, intIndex As Integer)
'%% Just selects an item in a ComboBox (lngCombo)
'%% Ex:
'%% Call ComboSelect(AOLCombo, 4)
'%% Selection API
Call SendMessageLong(lngCombo, CB_SETCURSEL, intIndex, 0&)
End Sub
Public Function imgetsender(Optional lngIM As Long = -1) As String
'%% Returns the sender of the topmost IM
'%% Ex:
'%% strSender = IMGetSender()
'
Dim strCap As String, intLoc As Integer
'if lngIM is -1 then it was leftout and we can use the
'topmost IM as the IM to grab text from
If lngIM = -1 Then
'find the im
lngIM = FindIM
End If
'if nonexistant, exit
If lngIM = 0& Then Exit Function
'grab caption
strCap = GetText(lngIM)
'get location of ":" so we can find sn
intLoc = InStr(strCap, ":")
'find and return sn
imgetsender = Mid(strCap, intLoc + 2)
End Function
Public Function imgetlastmsg(Optional lngIM As Long = -1) As String
'%% Gets the last message from topmost IM
'%% Ex:
'%% strLastMsg = IMGetLastMsg()
'
Dim strMsgs As String, intLoc As Integer, strChar As String
'if lngIM is -1 then it was leftout and we can use the
'topmost IM as the IM to grab text from
If lngIM = -1 Then
'find the im
lngIM = FindIM
End If
'if nonexistant, exit
If lngIM = 0& Then Exit Function
'get text of IM with the IMGetText() function
strMsgs = imgettext(lngIM)
'find the first enter
intLoc = InStrRev(strMsgs, Chr(13))
strMsgs = Mid(strMsgs, intLoc + 1)
'find the ":"
intLoc = InStr(strMsgs, ":")
'find the first character of the actual message
Do: DoEvents
intLoc = intLoc + 1
strChar = Mid(strMsgs, intLoc, 1)
Loop Until strChar <> " "
'return last message
imgetlastmsg$ = Mid(strMsgs, intLoc)
End Function
Public Function imgetlastsn(Optional lngIM As Long = -1) As String
'%% Gets the last person to talk in an IM
'%% Ex:
'%% strLastSN = IMGetLastSN
'
'There are 2 ways of actually doing this, one way is to get the
'actual text of the IM and loop through to find the last message
'sent and grab the sender of that message (similar to IMGetLastMsg())
'... the second, and much easier way is by the caption, like so:
Dim strCap As String
'if lngIM is -1 then it was leftout and we can use the
'topmost IM as the IM to grab text from
If lngIM = -1 Then
'find the im
lngIM = FindIM
End If
'if nonexistant, exit
If lngIM = 0& Then Exit Function
'get caption of the IM
strCap = GetText(lngIM)
'Find out if the last msg was another user
If InStr(strCap, ">") Then
'The other user sent a message
imgetlastsn = imgetsender(lngIM)
Else
imgetlastsn = GetUser$
End If
End Function
Public Function imgettext(Optional lngIM As Long = -1) As String
'%% Returns the messages of topmost IM, or
'%% the IM you specifiy
'%% Ex:
'%% strMsgs = IMGetText()
'
Dim strMsgs As String
'if lngIM is -1 then it was leftout and we can use the
'topmost IM as the IM to grab text from
If lngIM = -1 Then
'find the im
lngIM = FindIM
End If
'if nonexistant, exit
If lngIM = 0& Then Exit Function
'grab strmsgs
imgettext = GetText(FindWindowEx(lngIM, 0&, "richcntlreadonly", vbNullString))
End Function
Public Sub IMRespond(strMsg As String, Optional lngIM As Long = -1)
'%% Responds to topmost IM if lngIM = -1
'%% Otherwise, get the IM handle that you would like to
'%% respond to by using FindIMBySender(), or another function
'%% and passing that through IMRespond()
'%% Ex:
'%% Call IMRespond("i'm using magik_aol8.bas!")
'
Dim RichCntl As Long, AOLIcon As Long, i As Integer
'if lngIM is -1 then it was leftout and we can use the
'topmost IM as the IM to grab text from
If lngIM = -1 Then
'find the im
lngIM = FindIM
End If
'if nonexistant, exit
If lngIM = 0& Then Exit Sub
'find the inputbox in the IM
RichCntl = FindWindowEx(lngIM, 0&, "richcntl", vbNullString)
'set the text
Call SetText(RichCntl, strMsg)
'find the send
AOLIcon = 0&
For i = 1 To 14 'send is the 14th AOL Icon
AOLIcon = FindWindowEx(lngIM, AOLIcon, "_aol_icon", vbNullString)
Next i
'click the send
ClickIcon (AOLIcon&)
End Sub
Public Function FindIMBySender(strSender As String) As Long
'%% Loops through all availiable IMs and returns
'%% The IM with the sender of strSender
'%% Ex:
'%% lngIM& = FindIMBySender("somedude")
'
Dim FindOtherWin As Long, lngIM As Long
Dim strCap As String, strIMSender As String
'Find first im
lngIM& = FindIM
If lngIM& = 0& Then Exit Function
strSender$ = LCase(Replace(strSender, " ", "")) 'lowercase, trim spaces
'Set FindOtherWin as first IM
FindOtherWin& = GetWindow(lngIM&, GW_HWNDFIRST)
Do While FindOtherWin& <> 0&
'get the sender
strIMSender$ = imgetsender(FindOtherWin) 'get SN of current im
strIMSender$ = LCase(Replace(strIMSender, " ", "")) 'lowercase, trim spaces
'compare screen names
If strIMSender$ = strSender$ Then
'we found it, return and eixt
FindIMBySender& = FindOtherWin&
Exit Function
End If
'didn't find it, get next IM window
FindOtherWin = GetWindow(FindOtherWin, GW_HWNDNEXT)
Loop
End Function
Public Sub CloseAllIMs()
'%% This is for example purposes, it shows you what you can do
'%% with various FindX functions. In this particular example,
'%% It loops through to find IM's (with FindIM) and closes them
'%% all until there are none.
'%% Ex:
'%% Call CloseAllIMs()
'
Do While FindIM <> 0&
closewin (FindIM)
Loop
'pretty easy ;)
'%% So obviously you can do the same with mails..
'%% Just replace FindIM with FindMail :P like so...
End Sub
Public Sub CloseAllMails()
'%% Here's another example to explain things, just like the
'%% CloseAllIMs() Function
'%% Ex:
'%% Call CloseAllMails()
'
Do While FindMail <> 0&
closewin (FindMail)
Loop
'%% So theres just another example of the versatility of FindX functions
End Sub
Public Sub MailSend(strTo As String, strsubject As String, strmessage As String, Optional strCC As String, Optional blnRequestReturnReceipt = False)
'%% Sends an Email with inputed parameters, strCC is optional
'%% Ex:
'%% Call SendMail("xvmagikvx@hotmail.com", "I'm Using Your magik_aol8.bas!", "I just wanted you to know :)")
'
Dim lngCompose As Long
'Keep opening Compose Mail till it comes up
Do
DoEvents
'Open the EMail
Call ClickIcon(ToolbarButton(2))
'Give it a few secs to show up
Wait 0.4
'Find Compose Window
lngCompose = FindCompose
Loop Until FindCompose <> 0&
'Enter info
Call SetText(MailToBox, strTo)
Call SetText(MailCCBox, strCC)
Call SetText(MailSubjectBox, strsubject)
Call SetText(MailMessageBox, strmessage)
'Check "Request Return Receipt from AOL Members" if desired
If blnRequestReturnReceipt = True Then Call Check(MailCheckBox, True)
'Send Mail
Call ClickIcon(MailSendButton)
'Close any "Mail Has Been Sent" modals
Wait 0.3
Call KillModalsNicely
End Sub
Public Function MailGetSender(lngIndexOfMail As Long, Optional strOldNewSentDel As String = "new") As String
'%% Some parts taken and modified from deeparctic's aol6 module
'%% Gets and returns lngIndexOfMail e-mail index Sender from the
'%% srOldNewSent mailbox
'%% Ex:
'%% Call MailOpen(strOldNewSentDel) 'you must open the list first
'%% strSender = MailGetSender(5, strOldNewSentDel) 'gets 4th email
On Error Resume Next
Dim lngmailbox As Long, lngControl As Long, lngPage As Long
Dim lngtree As Long, lngCount As Long, strMails As String
Dim lngtab As Long, lngTab2 As Long, lngLen As Long
'lowercase please and thank you :)
strOldNewSentDel = LCase(strOldNewSentDel)
'make sure mail is open, if not, open it
If (strOldNewSentDel = "del" And FindRecDelMail = 0&) Then
Call MailOpen(strOldNewSentDel)
ElseIf (FindMailBox = 0&) Then
Call MailOpen(strOldNewSentDel)
End If
lngmailbox = FindMailBox
'find the correct control to view
If strOldNewSentDel = "new" Then
lngControl = FindWindowEx(lngmailbox, 0, "_AOL_TabControl", vbNullString)
ElseIf strOldNewSentDel = "old" Then
lngControl = FindWindowEx(lngmailbox, 0, "_AOL_TabControl", vbNullString)
lngControl = FindWindowEx(lngmailbox, lngControl, "_AOL_TabControl", vbNullString)
ElseIf strOldNewSentDel = "sent" Then
lngControl = FindWindowEx(lngmailbox, 0, "_AOL_TabControl", vbNullString)
lngControl = FindWindowEx(lngmailbox, lngControl, "_AOL_TabControl", vbNullString)
lngControl = FindWindowEx(lngmailbox, lngControl, "_AOL_TabControl", vbNullString)
ElseIf strOldNewSentDel = "del" Then
lngtree = FindWindowEx(FindRecDelMail, 0, "_AOL_Tree", vbNullString)
End If
'find the corresponding tree (the tree we find here is the sender tree)
If strOldNewSentDel <> "del" Then
lngPage = FindWindowEx(lngControl, 0, "_AOL_TabPage", vbNullString)
lngtree = FindWindowEx(lngPage, 0, "_AOL_Tree", vbNullString)
End If
'get number of mails in list
lngCount = listcount(lngtree) 'ListCount(MailList(strOldNewSentDel))
'make sure there is nothing invalid
If lngCount = 0 Or lngIndexOfMail > lngCount - 1 Or lngIndexOfMail < 0 Then Exit Function
'get length of text
lngLen = SendMessage(lngtree, LB_GETTEXTLEN, lngIndexOfMail, 0)
lngLen = lngLen + 1
'get sender
strMails = String(lngLen, vbNullChar)
Call SendMessageByString(lngtree, LB_GETTEXT, lngIndexOfMail, strMails)
lngtab = InStr(strMails, Chr(9))
lngTab2 = InStr(lngtab + 1, strMails, Chr(9))
strMails = Mid(strMails, lngtab + 1, lngTab2 - lngtab - 1)
'finally, return sender as string
MailGetSender = strMails
End Function
Public Function MailGetSubject(lngIndexOfMail As Long, Optional strOldNewSentDel As String = "new") As String
'%% Some parts taken and modified from deeparctic's aol6 module
'%% Gets and returns lngIndexOfMail e-mail index Subject from the
'%% srOldNewSent mailbox
'%% Ex:
'%% Call MailOpen(strOldNewSentDel) 'you must open the list first
'%% strSubject = MailGetSender(5, strOldNewSentDel) 'gets 4th email
'
'On Error Resume Next
Dim lngmailbox As Long, lngControl As Long, lngPage As Long
Dim lngtree As Long, lngCount As Long, strMails As String
Dim lngtab As Long, lngTab2 As Long, lngLen As Long
'lowercase please and thank you :)
strOldNewSentDel = LCase(strOldNewSentDel)
'make sure mail is open, if not, open it
If (strOldNewSentDel = "del" And FindRecDelMail = 0&) Then
Call MailOpen(strOldNewSentDel)
ElseIf (FindMailBox = 0&) Then
Call MailOpen(strOldNewSentDel)
End If
lngmailbox = FindMailBox
'find the correct control to view
If strOldNewSentDel = "new" Then
lngControl = FindWindowEx(lngmailbox, 0, "_AOL_TabControl", vbNullString)
ElseIf strOldNewSentDel = "old" Then
lngControl = FindWindowEx(lngmailbox, 0, "_AOL_TabControl", vbNullString)
lngControl = FindWindowEx(lngmailbox, lngControl, "_AOL_TabControl", vbNullString)
ElseIf strOldNewSentDel = "sent" Then
lngControl = FindWindowEx(lngmailbox, 0, "_AOL_TabControl", vbNullString)
lngControl = FindWindowEx(lngmailbox, lngControl, "_AOL_TabControl", vbNullString)
lngControl = FindWindowEx(lngmailbox, lngControl, "_AOL_TabControl", vbNullString)
ElseIf strOldNewSentDel = "del" Then
lngtree = FindWindowEx(FindRecDelMail, 0, "_AOL_Tree", vbNullString)
End If
'find the corresponding tree (the tree we find here is the sender tree)
If strOldNewSentDel <> "del" Then
lngPage = FindWindowEx(lngControl, 0, "_AOL_TabPage", vbNullString)
lngtree = FindWindowEx(lngPage, 0, "_AOL_Tree", vbNullString)
End If
'get number of mails in list
lngCount = listcount(lngtree) 'ListCount(MailList(strOldNewSentDel))
'make sure there is nothing invalid
If lngCount = 0 Or lngIndexOfMail > lngCount - 1 Or lngIndexOfMail < 0 Then Exit Function
'get length of text
lngLen = SendMessage(lngtree, LB_GETTEXTLEN, lngIndexOfMail, 0)
lngLen = lngLen + 1
'get subject
strMails = String(lngLen, vbNullChar)
Call SendMessageByString(lngtree, LB_GETTEXT, lngIndexOfMail, strMails)
lngtab = InStr(strMails, Chr(9))
lngtab = InStr(lngtab + 1, strMails, Chr(9))
strMails = Right(strMails, Len(strMails) - lngtab)
'finally, return sender as string
MailGetSubject = strMails
End Function
Public Sub MailSortBy(intSortby As Integer, Optional strOldNewSentDel As String = "new")
'%% Uses AOL6's Sort By X feature to sort the mail in current window
'%% intSortBy definitions are as follows:
'%% intSortBy = 1 --> Sort By Type
'%% intSortBy = 2 --> Sort By Date
'%% intSortBy = 3 --> Sort By E-Mail Address
'%% intSortBy = 4 --> Sort By Subject
'%% Ex:
'%% Call MailSort(4, "new") '<-- Sorts New Mail by Subject
'%% Note: This is useful if you want an easier way to Sort the Mail
'%% that you add to a list via MailToListSubject() function, plus other reasons :)
'
'lowercase please and thank you :)
strOldNewSentDel = LCase(strOldNewSentDel)
'make sure mail is open, if not, open it
If (strOldNewSentDel = "del") Then
Exit Sub 'you can't sort recently deleted mail
ElseIf (FindMailBox = 0&) Then
Call MailOpen(strOldNewSentDel)
End If
Dim aoltabpage As Long, aoltabcontrol As Long, AOLIcon As Long, i As Integer
'find the tab control
aoltabcontrol = FindWindowEx(FindMailBox, 0&, "_aol_tabcontrol", vbNullString)
'determine what tab we are in
'New Mail Tab
If strOldNewSentDel = "new" Then
aoltabpage = FindWindowEx(aoltabcontrol, 0&, "_aol_tabpage", vbNullString)
'Old Mail Tab
ElseIf strOldNewSentDel = "old" Then
aoltabpage = FindWindowEx(aoltabcontrol, 0&, "_aol_tabpage", vbNullString)
aoltabpage = FindWindowEx(aoltabcontrol, aoltabpage, "_aol_tabpage", vbNullString)
'Sent Mail Tab
ElseIf strOldNewSentDel = "sent" Then
aoltabpage = FindWindowEx(aoltabcontrol, 0&, "_aol_tabpage", vbNullString)
aoltabpage = FindWindowEx(aoltabcontrol, aoltabpage, "_aol_tabpage", vbNullString)
aoltabpage = FindWindowEx(aoltabcontrol, aoltabpage, "_aol_tabpage", vbNullString)
'Other?
Else
Exit Sub 'don't think so! :P
End If
'Now that we found what tab page we are in, we must find the icon
'of the Sort By (X) that we want, this is simple since we required
'the parameter to be in a zero-based integer :)
AOLIcon = 0&
For i = 0 To intSortby
AOLIcon = FindWindowEx(aoltabpage, AOLIcon, "_aol_icon", vbNullString)
Next i
'Now click it! :)
Call ClickIcon(AOLIcon)
End Sub
Public Sub MailToListSender(lstList As ListBox, Optional strOldNewSentDel As String = "new")
'%% Uses MailGetSender to compile a list of Mails by Sender
'%% Ex:
'%% Call MailToListSender(List1, "old")
'
Dim i As Long, lngList As Long
'lowercase please and thank you :)
strOldNewSentDel = LCase(strOldNewSentDel)
'open the mail
Call MailOpen(strOldNewSentDel)
'get list
lngList = MailList(strOldNewSentDel)
'loop through each mail, grab the sender, add to list
For i = 0 To listcount(lngList) - 1
lstList.AddItem MailGetSender(i, strOldNewSentDel)
Next i
End Sub
Public Sub MailToListSubject(lstList As ListBox, Optional strOldNewSentDel As String = "new")
'%% Uses MailGetSubject to compile a list of Mails by Subject
'%% Ex:
'%% Call MailToListSubject(List1, "old")
'
Dim i As Long, lngList As Long
'lowercase please and thank you :)
strOldNewSentDel = LCase(strOldNewSentDel)
'open the mail
Call MailOpen(strOldNewSentDel)
'get list
lngList = MailList(strOldNewSentDel)
'loop through each mail, grab the subject, add to list
For i = 0 To listcount(lngList) - 1
lstList.AddItem MailGetSubject(i, strOldNewSentDel)
Next i
End Sub
Public Sub MailOpen(Optional strOldNewSentDel As String = "new")
'%% Just opens the corresponding mailbox
'%% determined by strOldNewSentDel
'%% strOldNewSentDel = "old" 'old mail
'%% strOldNewSentDel = "new" 'new mail
'%% strOldNewSentDel = "sent" 'sent mail
'%% strOldNewSentDel = "del" 'recently deleted mail
'%% Ex:
'%% Call MailOpen("sent")
'
'make sure we've got lowercase
strOldNewSentDel = LCase(strOldNewSentDel)
'nice and neat select case statement
Select Case strOldNewSentDel
Case "old"
'Old Mailbox
Call RunSubMenuToolBar(0, 0, 1)
Case "new"
'New Mailbox
Call ClickIcon(ToolbarButton(1))
Case "sent"
'Sent Mailbox
Call RunSubMenuToolBar(0, 0, 2)
Case "del"
'Recently Deleted Mailbox
Call RunMenuToolBar(0, 5)
'wait for win
Do: DoEvents
Loop Until FindRecDelMail <> 0&
'wait for list
Call waitforlisttoload(MailList(strOldNewSentDel))
Exit Sub 'dont need to wait again
End Select
'wait for win
Do: DoEvents
Loop Until FindMailBox <> 0&
'wait for list
Call waitforlisttoload(MailList(strOldNewSentDel))
End Sub
Public Sub MailRead(intIndexOfMail As Integer, Optional strOldNewSentDel As String = "new", Optional blnCloseInbox As Boolean = False)
'%% Just opens the Mail Index of lngIndexOfMail
'%% strOldNewSentDel = "old" 'old mail
'%% strOldNewSentDel = "new" 'new mail
'%% strOldNewSentDel = "sent" 'sent mail
'%% strOldNewSentDel = "del" 'recently deleted mail
'%% Ex:
'%% Call MailRead(0) '<-- Reads first mail
'
On Local Error Resume Next 'incase we get an invalid index
'Open the mailbox
Call MailOpen(strOldNewSentDel)
'select mail
Call ListSelectByEnter(MailList(strOldNewSentDel), intIndexOfMail)
'close if desired
If blnCloseInbox = True And strOldNewSentDel = "del" Then
Call closewin(FindRecDelMail)
Exit Sub
ElseIf blnCloseInbox = True Then
Call closewin(FindMailBox)
Exit Sub
End If
End Sub
Public Sub MailReply(intIndexOfMail As Integer, strmessage As String, blnReplyAll As Boolean, Optional strOldNewSentDel As String = "new", Optional strsubject As String, Optional strCC As String, Optional blnRequestReturnReceipt As Boolean = False)
'%% Opens an email in the Inbox with index of lngIndexOfMail and Replies
'%% with strMessage to the sender and any additional desired strCC's
'%% blnRequestReturnReceipt is also optional
'%% blnReplyAll determines if you are just Replying or Replying To All
'%% Ex:
'%% Call MailReply(5, False, "Okay, I got your message!", "somedude@isp.net")
'
'Open mailbox if not open
Dim lngmailbox As Long
lngmailbox = FindMailBox
If lngmailbox = 0& Then
Call MailOpen(strOldNewSentDel)
End If
'Open desired mail, do not close
Call MailRead(intIndexOfMail, strOldNewSentDel, False)
'Let Window Load
Do: DoEvents
Loop Until FindMail <> 0&
'Click reply/reply to all
If blnReplyAll = False Then
Call ClickIcon(MailReplyButton) 'Just Regular Reply
Else
Call ClickIcon(MailReplyAllButton) 'Reply To All
End If
'Let Send Window Load
Do: DoEvents
Loop Until FindCompose <> 0&
'Input Data
Call SetText(MailCCBox, strCC)
If strsubject <> "" Then
Call SetText(MailSubjectBox, strsubject) 'Subject
'%% You might want to do this for the subject to remove the "Re: "
'%% Dim strCurSubject As String
'%% strCurSubject = GetText(MailSubjectBox)
'%% strCurSubject = Replace(strCurSubject, "Re: ", "")
'%% Call SetText(MailSubjectBox, strCurSubject)
End If
Call SetText(MailMessageBox, strmessage) 'Message
'Check Request Return Receipt if Desired
If blnRequestReturnReceipt = True Then Call Check(MailCheckBox, True)
'Send it
Call ClickIcon(MailSendButton)
'close confirm
Wait 0.5
Call KillModals
'if you want you can uncomment this to close the mail
'CloseWin (FindMail)
'CloseWin (FindMailBox)
'CloseWin (FindRecDelMail)
End Sub
Public Sub MailForward(intIndexOfMail As Integer, strTo As String, Optional strOldNewSentDel As String = "new", Optional strmessage As String = "", Optional strsubject As String = "", Optional strCC As String, Optional blnRequestReturnReceipt As Boolean = False)
'%% Opens an email in the Inbox with index of lngIndexOfMail and Forwards
'%% with strMessage to strTo and any additional desired strCC's (optional)
'%% blnRequestReturnReceipt is also optional
'%% Ex:
'%% Call MailForward(5, "somedude@isp.net", "heres the mail")
'
'Open mailbox if not open
Dim lngmailbox As Long
lngmailbox = FindMailBox
If lngmailbox = 0& Then
Call MailOpen(strOldNewSentDel)
End If
'Open desired mail, do not close
Call MailRead(intIndexOfMail, strOldNewSentDel, False)
'Wait till mail loads
Do: DoEvents
Loop Until FindMail <> 0&
'Click Forward
ClickIcon (MailForwardButton)
'Wait till Forward Mail window Loads
Do: DoEvents
Loop Until FindCompose <> 0&
'Input Data
Call SetText(MailToBox, strTo)
Call SetText(MailCCBox, strCC)
If strsubject <> "" Then
Call SetText(MailSubjectBox, strsubject) 'Subject
'%% You might want to do this for the subject to remove the "Re: "
'%% Dim strCurSubject As String
'%% strCurSubject = GetText(MailSubjectBox)
'%% strCurSubject = Replace(strCurSubject, "Fwd: ", "")
'%% Call SetText(MailSubjectBox, strCurSubject)
End If
Call SetText(MailMessageBox, strmessage) 'Message
'Check Request Return Receipt if Desired
If blnRequestReturnReceipt = True Then Call Check(MailCheckBox, True)
'Send it
Call ClickIcon(MailSendButton)
'Close any modals
Wait 0.5
Call KillModals
'if you want you can uncomment this to close the mail
'CloseWin (FindMail)
'CloseWin (FindMailBox)
'CloseWin (FindRecDelMail)
End Sub
Public Sub MailKeepAsNew(intIndexOfMail As Integer, Optional strOldNewSentDel As String = "new")
'%% Sets intIndexOfMail as New
'%% strOldNewSentDel is optional and defaulted to "new" if not set...
'%% strOldNewSentDel = "old" --> Old Mail List Handle
'%% strOldNewSentDel = "new" --> New Mail List Handle
'%% strOldNewSentDel = "sent" --> Sent Mail List Handle
'
On Error Resume Next 'incase we get an invalid index
'lowercase
strOldNewSentDel = LCase(strOldNewSentDel)
'if not open, open it
If FindMailBox = 0& And FindRecDelMail = 0& Then
Call MailOpen(strOldNewSentDel)
End If
'select the item
Call listselect(MailList(strOldNewSentDel), intIndexOfMail)
Dim aolchild As Long, AOLIcon As Long
'click keep as new
If strOldNewSentDel = "del" Then
'find keep as new button in Recently Deleted Mail box
aolchild = FindRecDelMail
AOLIcon = FindWindowEx(aolchild, 0&, "_aol_icon", vbNullString)
AOLIcon = FindWindowEx(aolchild, AOLIcon, "_aol_icon", vbNullString)
ElseIf strOldNewSentDel = "sent" Then
'there is no keep as new in 'sent', so exit
Exit Sub
Else
'find it in New/Old MailBox
aolchild = FindMailBox
AOLIcon = FindWindowEx(aolchild, 0&, "_aol_icon", vbNullString)
AOLIcon = FindWindowEx(aolchild, AOLIcon, "_aol_icon", vbNullString)
AOLIcon = FindWindowEx(aolchild, AOLIcon, "_aol_icon", vbNullString)
End If
'click the keep as new button
Call ClickIcon(AOLIcon)
End Sub
Public Sub MailDelete(intIndexOfMail As Integer, Optional strOldNewSentDel As String = "new")
'%% Deletes mail intIndexOfMail
'%% strOldNewSentDel is optional and defaulted to "new" if not set...
'%% strOldNewSentDel = "old" --> Old Mail List Handle
'%% strOldNewSentDel = "new" --> New Mail List Handle
'%% strOldNewSentDel = "sent" --> Sent Mail List Handle
'
On Error Resume Next 'incase we get an invalid index
Dim aolchild As Long, AOLIcon As Long, i As Integer
'openmailbox
Call MailOpen(strOldNewSentDel)
'select the item
Call listselect(MailList(strOldNewSentDel), intIndexOfMail)
'click delete
If strOldNewSentDel = "del" Then
'find it in Recently Deleted Mail box
aolchild = FindRecDelMail
'aolicon = FindWindowEx(aolchild, 0&, "_aol_icon", vbNullString)
'aolicon = FindWindowEx(aolchild, aolicon, "_aol_icon", vbNullString)
'aolicon = FindWindowEx(aolchild, aolicon, "_aol_icon", vbNullString)
AOLIcon = 0&
For i = 1 To 3 '11
AOLIcon = FindWindowEx(aolchild, AOLIcon, "_aol_icon", vbNullString)
Next i
ClickIcon (AOLIcon)
Else
'find and click delete button
aolchild = FindMailBox
AOLIcon = 0&
For i = 1 To 11
AOLIcon = FindWindowEx(aolchild, AOLIcon, "_aol_icon", vbNullString)
Next i
ClickIcon (AOLIcon)
'we can just hit delete in here
'Call PostMessage(MailList(strOldNewSentDel), WM_KEYDOWN, vbKeyDelete, 0&)
'Call PostMessage(MailList(strOldNewSentDel), WM_KEYUP, vbKeyDelete, 0&)
End If
End Sub
Public Function MailList(Optional strOldNewSentDel As String = "new") As Long
'%% Returns handle of the List specified in the Mail Box Window
'%% strOldNewSentDel is optional and defaulted to "new" if not set...
'%% strOldNewSentDel = "old" --> Old Mail List Handle
'%% strOldNewSentDel = "new" --> New Mail List Handle
'%% strOldNewSentDel = "sent" --> Sent Mail List Handle
'%% strOldNewSentDel = "del" --> Recently Deleted Mail List Handle
'%% Ex:
'%% lngList = MailList()
strOldNewSentDel = LCase(strOldNewSentDel)
'
Dim aoltabcontrol As Long, aoltabpage As Long, aoltree As Long
Dim aolframe As Long, mdiclient As Long, aolchild As Long
aoltabcontrol = FindWindowEx(FindMailBox, 0&, "_aol_tabcontrol", vbNullString)
'New Mail List
If strOldNewSentDel = "new" Then
aoltabpage = FindWindowEx(aoltabcontrol, 0&, "_aol_tabpage", vbNullString)
'Old Mail List
ElseIf strOldNewSentDel = "old" Then
aoltabpage = FindWindowEx(aoltabcontrol, 0&, "_aol_tabpage", vbNullString)
aoltabpage = FindWindowEx(aoltabcontrol, aoltabpage, "_aol_tabpage", vbNullString)
'Sent Mail List
ElseIf strOldNewSentDel = "sent" Then
aoltabpage = FindWindowEx(aoltabcontrol, 0&, "_aol_tabpage", vbNullString)
aoltabpage = FindWindowEx(aoltabcontrol, aoltabpage, "_aol_tabpage", vbNullString)
aoltabpage = FindWindowEx(aoltabcontrol, aoltabpage, "_aol_tabpage", vbNullString)
'Recently Deleted Mail List
ElseIf strOldNewSentDel = "del" Then
MailList = FindWindowEx(FindRecDelMail, 0, "_AOL_Tree", vbNullString)
Exit Function
End If
MailList = FindWindowEx(aoltabpage, 0&, "_aol_tree", vbNullString)
End Function
Public Function MailCount(Optional strOldNewSentDel As String = "new") As Long
'%% Returns the number of Mails in Inbox
'%% Note: You must have the mailbox open already
'%% Ex:
'%% intNumMails = MailCount()
'
Dim lngmailbox As Long
'open it
If (strOldNewSentDel = "del" And FindRecDelMail = 0&) Or (FindMailBox = 0&) Then
Call MailOpen(strOldNewSentDel)
End If
'make sure its lcase
strOldNewSentDel = LCase(strOldNewSentDel)
'Wait for Mail to Load
waitforlisttoload (MailList(strOldNewSentDel))
'Count and Return Items via API Calls
MailCount = listcount(MailList(strOldNewSentDel))
End Function
Public Function MailToBox() As Long
'%% Finds and returns the To Box in an open Email Message Window
'%% Ex:
'%% Call SetText(MailToBox, "somedude@isp.net")
'
Dim lngCompose As Long, lngToBox As Long
'Find open mail window
lngCompose = FindCompose
'Find and Return it in one line :)
MailToBox = FindWindowEx(lngCompose, 0&, "_aol_edit", vbNullString)
End Function
Public Function MailCCBox() As Long
'%% Finds and returns the To Box in an open Email Message Window
'%% Ex:
'%% Call SetText(MailCCBox, "somedude@isp.net")
'
Dim lngCompose As Long, lngCCBox As Long
'Find open mail window
lngCompose = FindCompose
'Find the To Box
lngCCBox = FindWindowEx(lngCompose, 0&, "_aol_edit", vbNullString)
lngCCBox = FindWindowEx(lngCompose, lngCCBox, "_aol_edit", vbNullString)
'Return it
MailCCBox = lngCCBox
End Function
Public Function MailSubjectBox() As Long
'%% Finds and returns the To Box in an open Email Message Window
'%% Ex:
'%% Call SetText(MailSubjectBox, "My Subject!")
'
Dim lngCompose As Long, lngSubjectBox As Long
'Find open mail window
lngCompose = FindCompose
'Find the To Box
lngSubjectBox = FindWindowEx(lngCompose, 0&, "_aol_edit", vbNullString)
lngSubjectBox = FindWindowEx(lngCompose, lngSubjectBox, "_aol_edit", vbNullString)
lngSubjectBox = FindWindowEx(lngCompose, lngSubjectBox, "_aol_edit", vbNullString)
'Return it
MailSubjectBox = lngSubjectBox
End Function
Public Function MailMessageBox() As Long
'%% Finds and returns the Message Box (or Body) in an open Email Message Window
'%% Ex:
'%% Call SetText(MailMessageBox, "I'm using magik_aol8.bas!")
'
Dim lngCompose As Long, lngMessageBox As Long
'Find open mail window
lngCompose = FindCompose
'Find and Return it in one line :)
MailMessageBox = FindWindowEx(lngCompose, 0&, "richcntl", vbNullString)
End Function
Public Function MailCheckBox() As Long
'%% Finds and returns the CheckBox in an open Email Message Window
'%% Ex:
'%% Call SetText(MailCheckBox, "I'm using magik_aol8.bas!")
'
Dim lngCompose As Long, lngCheckBox As Long
'Find open mail window
lngCompose = FindCompose
'Find and Return it in one line :)
MailCheckBox = FindWindowEx(lngCompose, 0&, "_aol_checkbox", vbNullString)
End Function
Public Function MailReplyButton() As Long
'%% Finds and Returns the Reply button in an open Email Message Window
'%% Ex:
'%% Call ClickIcon(MailReplyButton)
Dim i As Integer, lngmailwin As Long, lngReplyButton As Long
'Find the Mail
lngmailwin = FindMail
'Find the Reply Button
For i = 1 To 7 'the Reply button is the 7th Icon
lngReplyButton = FindWindowEx(lngmailwin, lngReplyButton, "_aol_icon", vbNullString)
Next i
'Return it
MailReplyButton = lngReplyButton
End Function
Public Function MailForwardButton() As Long
'%% Finds and Returns the Forward button in an open Email Message Window
'%% Ex:
'%% Call ClickIcon(MailForwardButton)
Dim i As Integer, lngmailwin As Long, lngForwardButton As Long
'Find the Mail
lngmailwin = FindMail
'Find the Forward Button
For i = 1 To 8 'the Forward button is the 8th Icon
lngForwardButton = FindWindowEx(lngmailwin, lngForwardButton, "_aol_icon", vbNullString)
Next i
'Return it
MailForwardButton = lngForwardButton
End Function
Public Function MailReplyAllButton() As Long
'%% Finds and Returns the ReplyAll button in an open Email Message Window
'%% Ex:
'%% Call ClickIcon(MailReplyAllButton)
Dim i As Integer, lngmailwin As Long, lngReplyAllButton As Long
'Find the Mail
lngmailwin = FindMail
'Find the ReplyAll Button
For i = 1 To 9 'the ReplyAll button is the 8th Icon
lngReplyAllButton = FindWindowEx(lngmailwin, lngReplyAllButton, "_aol_icon", vbNullString)
Next i
'Return it
MailReplyAllButton = lngReplyAllButton
End Function
Public Function MailSendButton() As Long
'%% Finds and Returns the Send button in a blank Compose Email Window
'%% Ex:
'%% Call ClickIcon(MailSendButton)
Dim i As Integer, lngCompose As Long, lngSendButton As Long
'Find the Mail
lngCompose = FindCompose
'Keep searching buttons till we find "Send Now" button
lngSendButton = FindWindowEx(lngCompose, 0&, "_aol_icon", vbNullString)
Do While GetText(lngSendButton) <> "Send Now"
DoEvents
lngSendButton = FindWindowEx(lngCompose, lngSendButton, "_aol_icon", vbNullString)
Loop
'Return it
MailSendButton = lngSendButton
End Function
Public Function IsOnline(strSN As String) As Boolean
'%% Checks to see if strSN is online or not, returns true/false
'%% Ex:
'%% blnOnline = IsOnline(GetUser$)
'
Dim AOLIcon As Long, lngSendIM As Long, lngMsgBox As Long, i As Integer
Dim strStatus As String, lngstatic As Long, lngok As Long
Call GotoKeyWord("aol://9293:" & strSN)
Do: DoEvents
lngSendIM = FindSendIM
Loop Until lngSendIM <> 0&
'Find Availiable Button
AOLIcon = 0&
For i = 1 To 12 'the availiable icon is the 12th icon
AOLIcon = FindWindowEx(lngSendIM, AOLIcon, "_aol_icon", vbNullString)
Next i
'click availiable button
Call ClickIcon(AOLIcon&)
'wait for messagebox
Do: DoEvents
lngMsgBox = findaolmsgbox
Loop Until lngMsgBox <> 0&
'grab the text to determine if user is online or no
lngstatic = FindWindowEx(lngMsgBox, 0&, "static", vbNullString)
lngstatic = FindWindowEx(lngMsgBox, lngstatic, "static", vbNullString)
strStatus = GetText(lngstatic)
'now we can close the msgbox
lngok = FindWindowEx(lngMsgBox, 0&, "button", vbNullString)
Call PostMessage(lngok, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(lngok, WM_KEYUP, VK_SPACE, 0&)
'close the imsend window
Call closewin(lngSendIM)
'return whether or not the user is availiable or not
If InStr(strStatus, " able ") Then
IsOnline = True
Else
IsOnline = False
End If
End Function
Public Sub Check(lngCheckBox As Long, blnDesiredValue As Boolean)
'%% I modified PAT or JK's API Spy 5.1 procedure in order to allow
'%% for optional true/false values.
'%% Sets lngCheckBox to the desired 'blnDesiredValue'
Dim CheckValue As Boolean
Do: DoEvents
CheckValue = CheckBoxGetValue(lngCheckBox)
DoEvents
If CheckValue = blnDesiredValue Then Exit Sub
Call PostMessage(lngCheckBox, WM_LBUTTONDOWN, 0&, 0&)
Call PostMessage(lngCheckBox, WM_LBUTTONUP, 0&, 0&)
DoEvents
Loop Until CheckValue = blnDesiredValue
End Sub
Public Function CheckBoxGetValue(checkboX As Long) As Boolean
'%% From PAT or JK's API Spy 5.1
'%% Gets the CheckBox Value (True/False) of specified checkbox via API
Dim CheckValue As Long
CheckValue& = SendMessageLong(checkboX&, BM_GETCHECK, 0&, 0&)
If CheckValue& = 0& Then
CheckBoxGetValue = False
ElseIf CheckValue& <> 0& Then
CheckBoxGetValue = True
End If
End Function
Public Sub SignOff()
'%% Signs off by using RunMenu() function
'%% Just put, Call SignOff
Call RunMenu("aol frame25", "Sign &Off", "Sign &Off")
End Sub
Public Sub SignOn(strscreenname As String, Optional strpassword As String)
'%% Signs on with specified SN index (index on combo box) and PW
'%% Password is optional only b/c sometimes passwords are stored
'%% Ex:
'%% Call SignOn("mysn", "mypassword")
'
Dim lngConnect As Long, lngCombo As Long, lngPass As Long
Dim intcount As Integer, i As Integer, strSN As String
'Find the connect window
lngConnect = FindAOLConnectWin
If lngConnect = 0& Then Exit Sub
'trim (lcase and remove spaces)
strscreenname = LCase(Replace(strscreenname, " ", ""))
'Find the ComboBox to select the desired SN
lngCombo = FindWindowEx(lngConnect, 0&, "_aol_combobox", vbNullString)
'Get number of items in combobox
intcount = CInt(ComboCount(lngCombo))
'Loop through each item and find the desired SN
For i = 0 To intcount
Call ComboSelect(lngCombo, i)
strSN = GetText(lngCombo) 'get
strSN = LCase(Replace(strSN, " ", "")) 'trim
If strSN = strscreenname Then 'compare
Exit For 'we found it
End If
Next i
'click combobox to allow aol to refresh window
Call SendMessageLong(lngCombo, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessageLong(lngCombo, WM_LBUTTONUP, 0&, 0&)
'hit space
Call SendMessageLong(lngCombo, WM_CHAR, vbKeySpace, 0&)
'set the password if not stored
lngPass = FindWindowEx(lngConnect, 0&, "_aol_edit", vbNullString)
If lngPass <> 0& Then
Call SetText(lngPass, strpassword)
End If
'hit enter to sign on
Call SendMessageLong(lngCombo, WM_CHAR, 13, 0&)
End Sub
Public Sub SignOnAsGuest(strscreenname As String, strpassword As String)
'%% Signs on as guest and enters strScreenName and strPassword when prompted
'%% Ex:
'%% Call SignOnAsGuest("mySN", "myPW")
'
Dim lngGuest As Long, lngSN As Long, lngPW As Long
'We can use the SignOn() function
Call SignOn("guest")
'Now wait for the Guest ScreenName/Password Prompt
Do: DoEvents
lngGuest = FindAOLGuestPrompt
Loop Until lngGuest <> 0&
'Find textboxes
lngSN = FindWindowEx(lngGuest, 0&, "_aol_edit", vbNullString)
lngPW = FindWindowEx(lngGuest, lngSN, "_aol_edit", vbNullString)
'Enter info
Call SetText(lngSN, strscreenname)
Call SetText(lngPW, strpassword)
'Hit enter to sign on
Call SendMessageLong(lngPW, WM_CHAR, 13, 0&)
End Sub
Public Sub ChangePassword(strOldPW As String, strNewPW As String)
'%% Changes your password... err duh! :)
'%% Ex:
'%% Call ChangePassword("oldpw", "newonepw")
'
Dim aolmodal As Long, AOLIcon As Long
Dim lngOld As Long, lngNew1 As Long, lngNew2 As Long
'goto change pw keyword
Call GotoKeyWord("change password")
'click the 'change password'
Do: DoEvents
aolmodal = FindWindow("_aol_modal", vbNullString)
AOLIcon = FindWindowEx(aolmodal, 0&, "_aol_icon", vbNullString)
Loop Until aolmodal <> 0& And AOLIcon <> 0&
Call ClickIcon(AOLIcon)
'find the change pw window stuff
Do: DoEvents
aolmodal = FindWindow("_aol_modal", "Change Your Password")
lngOld = FindWindowEx(aolmodal, 0&, "_aol_edit", vbNullString)
lngNew1 = FindWindowEx(aolmodal, lngOld, "_aol_edit", vbNullString)
lngNew2 = FindWindowEx(aolmodal, lngNew1, "_aol_edit", vbNullString)
AOLIcon = FindWindowEx(aolmodal, 0&, "_aol_icon", vbNullString)
Loop Until aolmodal <> 0& And lngOld <> 0& And lngNew1 <> 0& And lngNew2 <> 0& And AOLIcon <> 0&
'enter info
Call SetText(lngOld, strOldPW)
Call SetText(lngNew1, strNewPW)
Call SetText(lngNew2, strNewPW)
'click the change password button
Call ClickIcon(AOLIcon)
'click ok on the msgbox that will popup
Dim Button As Long
Do: DoEvents
Button = findaolmsgbox
Loop Until Button <> 0&
Button = FindWindowEx(Button, 0&, "button", vbNullString)
Call PostMessage(Button, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(Button, WM_KEYUP, VK_SPACE, 0&)
'close the change password win
Do: DoEvents
aolmodal = FindWindow("_aol_modal", vbNullString)
AOLIcon = FindWindowEx(aolmodal, 0&, "_aol_icon", vbNullString)
AOLIcon = FindWindowEx(aolmodal, AOLIcon, "_aol_icon", vbNullString)
Loop Until aolmodal <> 0& And AOLIcon <> 0&
'click to close
Call ClickIcon(AOLIcon)
End Sub
Public Sub SwitchSN(strSN As String, Optional strPW As String = "")
'%% Switches from currently signed on SN to strSN with optional strPW
'%% Ex:
'%% Call SwitchScreenNames(1) '<-- Switches to second screen name in list
'
Dim lngSNList As Long, lngCount As Long, intstart As Integer, intEnd As Integer
Dim cProcess As Long, itmHold As Long, ScreenName As String
Dim psnHold As Long, rBytes As Long, index As Long
Dim sThread As Long, mThread As Long
' '
'lowercase and no spaces for simplicity
strSN = LCase(Replace(strSN, " ", ""))
'Go to SwitchSN Menu
Call RunMenu("aol frame25", "Sign &Off", "&Switch Screen Name")
'Call RunMenuByString("&Switch Screen Names")
'wait till switch sn window loads
Do: DoEvents
Loop Until FindSwitchSN <> 0&
'Find the SN List
lngSNList = FindWindowEx(FindSwitchSN, 0&, "_aol_listbox", vbNullString)
'wait till listloads
Call waitforlisttoload(lngSNList)
'get number of sns
lngCount = listcount(lngSNList)
'loop through each until we find the one we want
'this works just like AddAOL8ListToList() function
'so i took out all the comments to save space if you
'wanna see how it works, then just go to that function
'On Error Resume Next
sThread& = GetWindowThreadProcessId(lngSNList, cProcess&)
mThread& = OpenProcess(PROCESS_READ Or RIGHTS_REQUIRED, False, cProcess&)
If mThread& Then
For index& = 0 To listcount(lngSNList) - 1
ScreenName$ = String$(4, vbNullChar)
itmHold& = SendMessage(lngSNList, LB_GETITEMDATA, ByVal CLng(index&), ByVal 0&)
itmHold& = itmHold& + 28
Call ReadProcessMemory(mThread&, itmHold&, ScreenName$, 4, rBytes)
Call CopyMemory(psnHold&, ByVal ScreenName$, 4)
psnHold& = psnHold& + 6
ScreenName$ = String$(16, vbNullChar)
Call ReadProcessMemory(mThread&, psnHold&, ScreenName$, Len(ScreenName$), rBytes&)
'Format SN so its useable
ScreenName = Replace(ScreenName, " ", "")
intEnd = InStrRev(ScreenName$, "E-")
If intEnd <> 0 Then
ScreenName$ = LCase(Mid(ScreenName, 2, (intEnd - 3)))
Else
ScreenName = LCase(Mid(ScreenName, 2))
End If
'See if its the SN we want
If ScreenName$ <> GetUser$ And ScreenName$ <> "" Then
If strSN = Replace(ScreenName, " ", "") Then
'we found it
Exit For
End If
End If
Next index&
End If
'now just select it
Call ListDblClick(lngSNList, CInt(index))
'wait for gay prompts
'First Prompt is just telling you how long you spent online
'whoopdi-do, just close it, bah!
Do: DoEvents
Loop Until FindModalWin <> 0&
'click ok on that modal
Call ClickIcon(FindWindowEx(FindModalWin, 0&, "_aol_icon", vbNullString))
'Next prompt could be 1 of 2 things.. password or just signed on (pw = stored)
'so loop until we find one of the two
Do: DoEvents
Loop Until FindModalWin <> 0& Or FindWelcomeWin <> 0&
Dim lngmodal As Long
lngmodal = FindModalWin
'If its the modal, enter the password and proceed
If lngmodal <> 0& Then
'one-liners.. its late and im getting lazy, and this module is
'almost done, so leave me alone! :P
Call SetText((FindWindowEx(lngmodal, 0&, "_aol_edit", vbNullString)), strPW)
ClickIcon (FindWindowEx(lngmodal, 0&, "_aol_icon", vbNullString))
End If
End Sub
Public Function ValidSN(strscreenname As String) As Boolean
'%% Checks to see if strScreenName exists
'%% Ex:
'%% Call ValidateSN("TheScreenName")
'
Dim strError As String, lngCompose As Long
'Send the Mail
'Keep opening Compose Mail till it comes up
Do
DoEvents
'Open the EMail
Call ClickIcon(ToolbarButton(2))
'Give it a few secs to show up
Wait 0.4
'Find Compose Window
lngCompose = FindCompose
Loop Until FindCompose <> 0&
'Enter info
Call SetText(MailToBox, "*magik*, " & strscreenname)
Call SetText(MailSubjectBox, "magik_aol8.bas")
Call SetText(MailMessageBox, "http://magikweb.cjb.net")
'Send Mail
Call ClickIcon(MailSendButton)
'Wait for error message
Do: DoEvents
Loop Until FindMailErrorWin <> 0&
'get the error message text
strError = GetText(FindWindowEx(FindMailErrorWin, 0&, "_aol_view", vbNullString))
'if the screename is present then it cant be valid
If InStr(strError$, strscreenname$) Then
ValidSN = False
Else
ValidSN = True
End If
'Close Stuff
closewin (FindMailErrorWin)
'we must use postmessage b/c we are going to get a confirmation box
Call PostMessage(FindCompose&, WM_CLOSE, 0&, 0&)
'clicks no on the save mail confirm window
Dim ConfirmWin As Long, NoButton As Long
'find No button
Do
DoEvents
ConfirmWin& = FindWindow("#32770", "America Online")
NoButton& = FindWindowEx(ConfirmWin&, 0&, "Button", "&No")
Loop Until ConfirmWin <> 0& And NoButton <> 0&
'click No button
Call SendMessage(NoButton, WM_KEYDOWN, VK_SPACE, 0&)
Call SendMessage(NoButton, WM_KEYUP, VK_SPACE, 0&)
End Function
Public Sub HideWin(hwnd As Long)
'%% Hides a window, duh
Call ShowWindow(hwnd, SW_HIDE)
End Sub
Public Sub ShowWin(hwnd As Long)
'%% Shows a window, duh
Call ShowWindow(hwnd, SW_SHOW)
End Sub
Public Sub closewin(hwnd As Long)
'%% Closes a window, duh
Call SendMessageLong(hwnd, WM_CLOSE, 0&, 0&)
End Sub
Public Sub MinimizeWin(hwnd As Long)
'%% Minimizes a window, duh
Call ShowWindow(hwnd, SW_MINIMIZE)
End Sub
Public Sub MaximizeWin(hwnd As Long)
'%% Maximize a window, duh
Call ShowWindow(hwnd, SW_MAXIMIZE)
End Sub
Public Sub RunMenu(Main_Prog As String, Top_Position As String, Menu_String As String)
'%% From SIRVB6.bas
'%% Runs the Menu_String (a sub-menu from Top_Position) inside the program, Main_Prog
'%% Ex:
'%% Call RunMenu("aol frame25", "&Help", "&About America Online")
On Error GoTo stp
Dim Top_Position_Num As Long, Buffer As String, Look_For_Menu_String As Long
Dim Trim_Buffer As String, Sub_Menu_Handle As Long, BY_POSITION As Long, Get_ID As Long
Dim Click_Menu_Item As Long, Menu_Parent As Long, aol As Long, Menu_Handle As Long, Parent As Long
'First Find the Top_Position Menu inside the Program using
'The 'GetMenu' and 'GetMenuString' API Calls
Top_Position_Num = -1
Parent& = FindWindow(Main_Prog, vbNullString)
Menu_Handle = GetMenu(Parent&)
Do
DoEvents
Top_Position_Num = Top_Position_Num + 1
Buffer$ = String$(255, 0)
Look_For_Menu_String& = GetMenuString(Menu_Handle, Top_Position_Num, Buffer$, Len(Top_Position) + 1, WM_USER)
Trim_Buffer = FixAPIString(Buffer$)
If Trim_Buffer = Top_Position Then Exit Do
If GetMenuItemID(Menu_Handle, Top_Position_Num) = 0 Then Exit Do
Loop
'Now Find the Menu that we are looking for under the Top_Position
'That we just found using the 'GetSubMenu' API String
Sub_Menu_Handle = GetSubMenu(Menu_Handle, Top_Position_Num)
BY_POSITION = -1
Do
DoEvents
BY_POSITION = BY_POSITION + 1
Buffer$ = String(255, 0)
Look_For_Menu_String& = GetMenuString(Sub_Menu_Handle, BY_POSITION, Buffer$, Len(Menu_String) + 1, WM_USER)
Trim_Buffer = FixAPIString(Buffer$)
If Trim_Buffer = Menu_String Then Exit Do
If GetMenuItemID(Menu_Handle, BY_POSITION) = 0 Then Exit Do
Loop
DoEvents
Get_ID& = GetMenuItemID(Sub_Menu_Handle, BY_POSITION)
Click_Menu_Item = SendMessageByNum(Parent&, WM_COMMAND, Get_ID&, 0&)
stp:
End Sub
Public Function FixAPIString(strToFix As String) As String
'%% Removes Null Characters (chr(0)) from entered strToFix String
'%% Ex:
'%% Call FixAPIString(APIText$)
'
'Uses VB6's built in Replace function, pretty easy :)
FixAPIString = Replace(strToFix, Chr(0), "")
End Function
Public Sub RunMenuByString(SearchString As String)
'%% From DoS32.bas, this searches through all the menu's for the entered
'%% string (SearchString) and then selects it if found.
'%% Ex:
'%% Call RunMenuByString("&Sign Off")
'%% Note:
'%% Make sure you include '&' right before the letter that is underlined
'%% Otherwise it will not find it. If it doesn't find it with the '&' then
'&& take it out because AOL8 might not have it in place.
Dim aol As Long, aMenu As Long, mcount As Long
Dim LookFor As Long, sMenu As Long, sCount As Long
Dim LookSub As Long, sID As Long, sString As String
aol& = FindWindow("AOL Frame25", vbNullString)
aMenu& = GetMenu(aol&)
mcount& = GetMenuItemCount(aMenu&)
For LookFor& = 0& To mcount& - 1
sMenu& = GetSubMenu(aMenu&, LookFor&)
sCount& = GetMenuItemCount(sMenu&)
For LookSub& = 0 To sCount& - 1
sID& = GetMenuItemID(sMenu&, LookSub&)
sString$ = String$(100, " ")
Call GetMenuString(sMenu&, sID&, sString$, 100&, 1&)
If InStr(LCase(sString$), LCase(SearchString$)) Then
Call SendMessageLong(aol&, WM_COMMAND, sID&, 0&)
Exit Sub
End If
Next LookSub&
Next LookFor&
End Sub
Public Sub RunMenuToolBar(intToolBar As Integer, intMenuIndex As Integer)
'%% Idea of this function came from deeparctic's module, however
'%% I created this versitile sub to allow to select menu
'%% items from AOL's ToolBar Menu's not the Mail Menu's
'%% Ex: (For Running: Mail > Recently Deleted Mail)
'%% Call RunToolBarMenu(0, 5)
'%% Menu Definitions:
'%% 0 = Mail
'%% 1 = People
'%% 2 = Services
'%% 3 = Settings
'%% 4 = Favorites
'%% Note: intMenuIndex is zero based
'%% Note: intToolBar is zero based
'
Dim lngmenu As Long, lngWindowVis As Long, intcount As Integer
Dim lngicon As Long, lngMenuCount As Long
'We want to use our ToolbarButton() function, so add
'the corresponding values
If intToolBar = 1 Then
intToolBar = 3
ElseIf intToolBar = 2 Then
intToolBar = 6
ElseIf intToolBar = 3 Then
intToolBar = 9
ElseIf intToolBar = 4 Then
intToolBar = 11
End If
'Find the icon
lngicon = ToolbarButton(intToolBar)
'Click it using PostMessage
Call PostMessage(lngicon, WM_LBUTTONDOWN, 0, 0)
Call PostMessage(lngicon, WM_LBUTTONUP, 0, 0)
'Make sure it has loaded
Do
lngmenu = FindWindow("#32768", vbNullString)
lngWindowVis = IsWindowVisible(lngmenu)
Loop Until lngWindowVis = 1
'loop through to find menu item that the user wants
For lngMenuCount = 0 To intMenuIndex
Call PostMessage(lngmenu, WM_KEYDOWN, VK_DOWN, 0)
Call PostMessage(lngmenu, WM_KEYUP, VK_DOWN, 0)
Next lngMenuCount
'hit enter to select
Call PostMessage(lngmenu, WM_KEYDOWN, VK_RETURN, 0)
Call PostMessage(lngmenu, WM_KEYDOWN, VK_RETURN, 0)
End Sub
Public Sub RunSubMenuToolBar(intToolBar As Integer, intMainMenuIndex As Integer, intSubMenuIndex As Integer)
'%% This is off of my previous function RunMenuToolBar, it allows
'%% you to run a submenu from the graphical AOL Menu Toolbar
'%% I created this versitile sub to allow to select menu
'%% items from AOL's ToolBar Menu's not the Mail Menu's
'%% Ex: (Running Mail > Old Mail)
'%% Call RunToolBarMenu(0, 0, 1)
'%% Menu Definitions:
'%% 0 = Mail
'%% 1 = People
'%% 2 = Services
'%% 3 = Settings
'%% 4 = Favorites
'%% Note: intMenuIndex is zero based
'%% Note: intSubMenuIndex is zero based
'%% Note: intToolBar is zero based
'
Dim lngmenu As Long, lngWindowVis As Long, intcount As Integer
Dim lngicon As Long, lngMenuCount As Long
'We want to use our ToolbarButton() function, so add
'the corresponding values
If intToolBar = 1 Then
intToolBar = 3
ElseIf intToolBar = 2 Then
intToolBar = 6
ElseIf intToolBar = 3 Then
intToolBar = 9
ElseIf intToolBar = 4 Then
intToolBar = 11
End If
'Find the icon
lngicon = ToolbarButton(intToolBar)
'Click it using PostMessage
Call PostMessage(lngicon, WM_LBUTTONDOWN, 0, 0)
Call PostMessage(lngicon, WM_LBUTTONUP, 0, 0)
'Make sure it has loaded
Do
lngmenu = FindWindow("#32768", vbNullString)
lngWindowVis = IsWindowVisible(lngmenu)
Loop Until lngWindowVis = 1
'loop through to find *main* menu item requested
For lngMenuCount = 0 To intMainMenuIndex
Call PostMessage(lngmenu, WM_KEYDOWN, VK_DOWN, 0) 'DownKey Down
Call PostMessage(lngmenu, WM_KEYUP, VK_DOWN, 0) 'DownKey Up
Next lngMenuCount
'Hit enter at that menu item to open the sub menu item
Call PostMessage(lngmenu, WM_KEYDOWN, VK_RETURN, 0)
Call PostMessage(lngmenu, WM_KEYUP, VK_RETURN, 0)
'*sub* menu
intSubMenuIndex = intSubMenuIndex - 1 'subtract 1 b/c enter key selects first
If intSubMenuIndex >= 0 Then
'loop again to find the *sub* menu item requested
For lngMenuCount = 0 To intSubMenuIndex 'subtract 1 b/c enter key selects first
Call PostMessage(lngmenu, WM_KEYDOWN, VK_DOWN, 0) 'DownKey Down
Call PostMessage(lngmenu, WM_KEYUP, VK_DOWN, 0) 'DownKey Up
Next lngMenuCount
End If
'hit enter to select
Call PostMessage(lngmenu, WM_KEYDOWN, VK_RETURN, 0)
Call PostMessage(lngmenu, WM_KEYUP, VK_RETURN, 0)
End Sub
Public Function IsAOL8() As Boolean
'%% Runs the 'About AOL' Menu item to see if the current running
'%% AOL Version is AOL8 or not
'%% Ex:
'%% If IsAOL8 = False Then Call MsgBox("This progg is only for AOL8")
'%%
Dim aolframe As Long, aolmodal As Long, AOLStatic As Long
'Do/Loop to keep runing the About AOL Menu until we find it
Do
DoEvents
'Run the About AOL Menu Item
Call RunMenu("aol frame25", "&Help", "&About America Online")
'Find the 'aolstatic', this is where the AOL version can be found
aolframe = FindWindow("aol frame25", vbNullString)
aolmodal = FindWindow("_aol_modal", vbNullString)
AOLStatic = FindWindowEx(aolmodal, 0&, "_aol_static", vbNullString)
'give the program a chance to operate by post-poning processing
Call Wait(1)
Loop Until AOLStatic <> 0&
Dim strAOLVer As String
'get the text
strAOLVer = GetText(AOLStatic)
'now close about box
Dim AOLIcon As Long
AOLIcon = FindWindowEx(aolmodal, 0&, "_aol_icon", vbNullString)
ClickIcon (AOLIcon)
'if we find 'America Online 8.0' in it, then its aol8
If InStr(strAOLVer, "America Online 8.0") Then
IsAOL8 = True
Else 'if not, then its not aol8, return false
IsAOL8 = False
End If
End Function
Public Sub ClickIcon(Icon As Long)
'%% Clicks an AOL8 Icon using Left-Button Down (WM_LBUTTONDOWN)
'%% Followd by a KeyUp of a SpaceBar, this is necessary b/c AOL8's
'%% Icons are weird :), usually we can just use WM_LBUTTONUP
Call SendMessageLong(Icon, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessageLong(Icon, WM_KEYUP, VK_SPACE, 0&)
End Sub
Public Sub Wait(secLong As Double)
'%% This is on a lot of BAS files, figured I'd include my own version here :)
'%% Some popular names are Delay(), Pause(), Hold(), etc. you can rename
'%% Post-Pones Program Processing for 'secLong' Seconds Long :)
'%% Ex:
'%% Call Wait(2)
Dim CurTime As Long
'record the current time to refer back to
CurTime = Timer
'do nothing (DoEvents:Loop) until the time desired has passed
Do
DoEvents
Loop Until (Timer - CurTime >= secLong)
End Sub
Public Function GetText(hwnd As Long)
'%% Modeled PAT or JK's API Spy 5.1
'%% Retreives the text from a hWnd (Window Caption, TextBox, etc)
'%% Ex:
'%% Caption$ = GetText(FindWelcomeWin)
Dim TheText As String, tl As Long
tl = SendMessageLong(hwnd, WM_GETTEXTLENGTH, 0&, 0&)
TheText = String(tl + 1, " ")
Call SendMessageByString(hwnd, WM_GETTEXT, tl + 1, TheText)
GetText = Left(TheText, tl)
End Function
Public Sub waitforlisttoload(ListBox As Long)
'%% Modified from PAT or JK's API Spy 5.1
'%% Gets Number of Items in list 3 times with wait inbetween
'%% So as to give the list a chance to load. If all values
'%% Return same number of items in list, then the list has loaded.
'%% Ex:
'%% Call WaitForListToLoad(MailList)
Dim FirstCount As Long, SecondCount As Long, ThirdCount As Long
Do: DoEvents
FirstCount& = listcount(ListBox)
Wait 0.4
SecondCount& = listcount(ListBox)
Wait 0.4
ThirdCount& = listcount(ListBox)
Loop Until FirstCount& = ThirdCount&
End Sub
Public Sub OutsideURL(TheForm As Form, strWhereToGo As String)
'%% Uses default web browser to go to strWhereToGo
'%% Compatible with Win9x, ME, NT, 2000, XP
'%% Ex:
'%% Call OutsideURL(Me, "http://magikbweb.cjb.net") '<-- Goes to http address
'%% Call OutsideURL(Me, "mailto:xvmagikvx@hotmail.com") '<--Uses default mail client to send mail
On Error Resume Next
Call ShellExecute(TheForm.hwnd, "Open", strWhereToGo, "", App.Path, 1)
End Sub
Public Function listcount(ListBox As Long) As Long
'%% From PAT or JK's API Spy 5.1
'%% Counts and Returns number of Items in List via API Calls
listcount& = SendMessageLong(ListBox&, LB_GETCOUNT, 0&, 0&)
End Function
Public Function ComboCount(ComboBox As Long) As Long
'%% From PAT or JK's API Spy 5.1
'%% Counts and Returns number of Items in ComboBox via API Calls
ComboCount& = SendMessageLong(ComboBox&, CB_GETCOUNT, 0&, 0&)
End Function
Public Sub FormOnTop(TheForm As Form)
'%% From various modules. Sets form to always be 'on top' of every app
Call SetWindowPos(TheForm.hwnd, HWND_TOPMOST, 0&, 0&, 0&, 0&, FLAGS)
End Sub
Public Sub FormNotOnTop(TheForm As Form)
'%% From various modules. Stops form from being 'on top' of every app
Call SetWindowPos(TheForm.hwnd, HWND_NOTOPMOST, 0&, 0&, 0&, 0&, FLAGS)
End Sub
Public Sub WriteToINI(Section As String, Key As String, KeyValue As String, Directory As String)
'%% Allows you to write .INI files, from dos32.bas
'%% Nothing really to do with AOL, but it's very useful :)
'%% Ex:
'%% Call WriteToINI("MainOpts", "AutoStart", "True", "C:\myini.dat") 'or myini.ini :)
'
Call WritePrivateProfileString(Section$, UCase$(Key$), KeyValue$, Directory$)
End Sub
Public Function GetFromINI(Section As String, Key As String, Directory As String) As String
'%% Allows you to read from a previously written .INI (or other ext.) file, form dos32.bas
'%% Nothing really to do wiht AOL, but it's very useful :))
'%% Ex:
'%% chkBox1.Value = GetFromINI("MainOpts", "AutoStart", "C:\myini.dat") 'or myini.ini :)
'
Dim strBuffer As String
strBuffer = String(750, Chr(0))
Key$ = LCase$(Key$)
GetFromINI$ = Left(strBuffer, GetPrivateProfileString(Section$, ByVal Key$, "", strBuffer, Len(strBuffer), Directory$))
End Function
Public Sub SaveListBox(Directory As String, TheList As ListBox)
'%% From dos32.bas, thought it might be useful :)
Dim SaveList As Long
On Error Resume Next
Open Directory$ For Output As #1
For SaveList& = 0 To TheList.listcount - 1
Print #1, TheList.List(SaveList&)
Next SaveList&
Close #1
End Sub
Public Sub LoadListBox(Directory As String, TheList As ListBox)
'%% From dos32.bas, thought it might be useful :)
Dim MyString As String
On Error Resume Next
Open Directory$ For Input As #1
While Not EOF(1)
Input #1, MyString$
DoEvents
TheList.AddItem MyString$
Wend
Close #1
End Sub
Sub SaveText(txtSave As TextBox, Path As String)
'%% From dos32.bas, thought it might be useful :)
Dim TextString As String
On Error Resume Next
TextString$ = txtSave.Text
Open Path$ For Output As #1
Print #1, TextString$
Close #1
End Sub
Sub LoadText(txtLoad As TextBox, Path As String)
'%% From dos32.bas, thought it might be useful :)
Dim TextString As String
On Error Resume Next
Open Path$ For Input As #1
TextString$ = Input(LOF(1), #1)
Close #1
txtLoad.Text = TextString$
End Sub
Public Sub SaveComboBox(ByVal Directory As String, Combo As ComboBox)
'%% From dos32.bas, thought it might be useful :)
Dim SaveCombo As Long
On Error Resume Next
Open Directory$ For Output As #1
For SaveCombo& = 0 To Combo.listcount - 1
Print #1, Combo.List(SaveCombo&)
Next SaveCombo&
Close #1
End Sub
Public Sub LoadComboBox(ByVal Directory As String, Combo As ComboBox)
'%% From dos32.bas, thought it might be useful :)
Dim MyString As String
On Error Resume Next
Open Directory$ For Input As #1
While Not EOF(1)
Input #1, MyString$
DoEvents
Combo.AddItem MyString$
Wend
Close #1
End Sub
Function RandomNumber1(finished)
Randomize
RandomNumber1 = Int((Val(finished) * Rnd))
End Function
Public Sub FormExitRight(TheForm As Form)
Do
DoEvents
TheForm.Left = Trim(Str(Int(TheForm.Left) + 300))
Loop Until TheForm.Left > Screen.Width
End Sub
Public Sub FormExitLeft(TheForm As Form)
Do
DoEvents
TheForm.Left = Trim(Str(Int(TheForm.Left) - 300))
Loop Until TheForm.Left < -TheForm.Width
End Sub
Sub KillRoom()
Call SendMessage(FindRoom, 0, 0, WM_CLOSE)
End Sub
Public Sub closeroom()
Dim aolframe As Long
Dim mdiclient As Long
Dim aolchild As Long
aolframe = FindWindow("aol frame25", vbNullString)
mdiclient = FindWindowEx(aolframe, 0&, "mdiclient", vbNullString)
aolchild = FindWindowEx(mdiclient, 0&, "aol child", vbNullString)
Call SendMessageLong(aolchild, WM_CLOSE, 0&, 0&)
If aolchild = 0 Then
MsgBox "Error: Cannot find window"
Exit Sub
End If
End Sub
Public Sub clickyes()
Dim aolframe As Long
Dim aolmodal As Long
Dim AOLIcon As Long
aolframe = FindWindow("aol frame25", vbNullString)
aolmodal = FindWindow("_aol_modal", vbNullString)
AOLIcon = FindWindowEx(aolmodal, 0&, "_aol_icon", vbNullString)
Call SendMessageLong(AOLIcon, WM_KEYDOWN, VK_SPACE, 0&)
Call SendMessageLong(AOLIcon, WM_KEYUP, VK_SPACE, 0&)
If AOLIcon = 0 Then
Exit Sub
End If
End Sub
Public Function FileExists(sFileName As String) As Boolean
If Len(sFileName$) = 0 Then
FileExists = False
Exit Function
End If
If Len(Dir$(sFileName$)) Then
FileExists = True
Else
FileExists = False
End If
End Function
Function TrimSpaces(Text As String) As String
Dim TheChar, TrimSpace
Dim TheChars
If InStr(Text, " ") = 0 Then
TrimSpaces = Text
Exit Function
End If
For TrimSpace = 1 To Len(Text)
TheChar = Mid(Text, TrimSpace, 1)
TheChars = TheChars & TheChar
If TheChar = " " Then
TheChars = Mid(TheChars, 1, Len(TheChars) - 1)
End If
Next TrimSpace
TrimSpaces = TheChars
End Function
Public Sub Chat_Addroom3chr(TheList As ListBox, AddUser As Boolean)
'This adds the room with 3chrs only on aol 7 8 to a listbox
'You are optional
On Error Resume Next
Dim cProcess As Long, itmHold As Long, ScreenName As String
Dim psnHold As Long, rBytes As Long, index As Long, room As Long
Dim rList As Long, sThread As Long, mThread As Long, itmNum As Long
room& = FindRoom&
If room& = 0& Then Exit Sub
itmNum& = 28
Top:
rList& = FindWindowEx(FindRoom&, 0&, "_AOL_Listbox", vbNullString)
sThread& = GetWindowThreadProcessId(rList, cProcess&)
mThread& = OpenProcess(PROCESS_READ Or RIGHTS_REQUIRED, False, cProcess&)
If mThread& Then
For index& = 0 To SendMessage(rList, LB_GETCOUNT, 0, 0) - 1
ScreenName$ = String$(4, vbNullChar)
itmHold& = SendMessage(rList, LB_GETITEMDATA, ByVal CLng(index&), ByVal 0&)
itmHold& = itmHold& + itmNum&
Call ReadProcessMemory(mThread&, itmHold&, ScreenName$, 4, rBytes)
Call CopyMemory(psnHold&, ByVal ScreenName$, 4)
psnHold& = psnHold& + 6
ScreenName$ = String$(16, vbNullChar)
Call ReadProcessMemory(mThread&, psnHold&, ScreenName$, Len(ScreenName$), rBytes&)
ScreenName$ = Left$(ScreenName$, InStr(ScreenName$, vbNullChar) - 1)
If ScreenName$ <> GetUser Or AddUser = True Then
If Len(ScreenName$) = 3 Then
TheList.AddItem ScreenName$
End If
End If
Next index&
Call CloseHandle(mThread)
End If
End Sub
@tizmagik
Copy link
Author

For context, this Tweet made me think of what my first open source project was. This is it -- magik_aol8.bas haha.

I just randomly stumbled on this, can't believe it was still available online somewhere. I've copied and pasted it here for posterity 😆 This code was the "engine" behind MaGiK Chromophobia AutoFader.

Dude, @patorjk your "PAT or JK's API Spy" was huge inspiration for me back in the day 😄. Cheers!

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment