home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / avwyyt1a / master32.bas < prev    next >
Encoding:
BASIC Source File  |  1997-02-19  |  40.3 KB  |  1,424 lines
  1. Attribute VB_Name = "Master32"
  2. Declare Function IsWindowEnabled Lib "user32" (ByVal hwnd As Long) As Long
  3. Private Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, ByVal lpBuffer As String, ByVal nSize As Long, ByRef lpNumberOfBytesWritten As Long) As Long
  4. Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
  5. Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
  6. Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
  7. Private Declare Sub RtlMoveMemory Lib "kernel32" (ByRef dest As Any, ByRef Source As Any, ByVal nBytes As Long)
  8. Declare Function RedrawWindow Lib "user32" (ByVal hwnd As Long, lprcUpdate As RECT, ByVal hrgnUpdate As Long, ByVal fuRedraw As Long) As Long
  9. 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
  10. Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
  11. 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
  12. Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
  13. Declare Function dwGetStringFromLPSTR Lib "dwspy32.dll" (ByVal lpcopy As Long) As String
  14. Declare Sub dwCopyDataBynum Lib "dwspy32.dll" Alias "dwCopyData" (ByVal Source&, ByVal dest&, ByVal nCount&)
  15. Declare Function dwGetAddressForObject& Lib "dwspy32.dll" (object As Any)
  16. Declare Sub dwCopyDataByString Lib "dwspy32.dll" Alias "dwCopyData" (ByVal Source As String, ByVal dest As Long, ByVal nCount&)
  17. Declare Function dwXCopyDataBynumFrom& Lib "dwspy32.dll" Alias "dwXCopyDataFrom" (ByVal mybuf As Long, ByVal foreignbuf As Long, ByVal size As Integer, ByVal foreignPID As Long)
  18. Declare Function dwGetWndInstance& Lib "dwspy32.dll" (ByVal hwnd&)
  19. Declare Function RegisterWindowMessage& Lib "user32" Alias "RegisterWindowMessageA" (ByVal lpString As String)
  20. Declare Function GetWindowLong& Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long)
  21. Declare Function EnumWindows& Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long)
  22. Declare Function SendMessageByNum& Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long)
  23. Declare Function GetClassName& Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long)
  24. Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
  25. Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
  26. Declare Function ShellAbout Lib "shell32.dll" Alias "ShellAboutA" (ByVal hwnd As Long, ByVal szApp As String, ByVal szOtherStuff As String, ByVal hIcon As Long) As Long
  27. Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
  28. Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
  29. 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
  30. Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Long) As Long
  31. Declare Function CreatePopupMenu Lib "user32" () As Long
  32. Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
  33. Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
  34. Declare Function GetMenuItemID Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
  35. Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
  36. Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
  37. Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
  38. Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
  39. Declare Function GetTopWindow Lib "user32" (ByVal hwnd As Long) As Long
  40. 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
  41. Declare Function SetFocusAPI Lib "user32" Alias "SetFocus" (ByVal hwnd As Long) As Long
  42. 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
  43. Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
  44. Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
  45. Declare Function InsertMenu Lib "user32" Alias "InsertMenuA" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As String) As Long
  46. Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As String) As Long
  47. Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
  48. Declare Function DeleteMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
  49. Declare Function DestroyMenu Lib "user32" (ByVal hMenu%) As Integer
  50.  
  51. Public Const WM_CHAR = &H102
  52. Public Const WM_SETTEXT = &HC
  53. Public Const WM_USER = &H400
  54. Public Const WM_KEYDOWN = &H100
  55. Public Const WM_KEYUP = &H101
  56. Public Const WM_LBUTTONDOWN = &H201
  57. Public Const WM_LBUTTONUP = &H202
  58. Public Const WM_CLOSE = &H10
  59. Public Const WM_COMMAND = &H111
  60. Public Const WM_CLEAR = &H303
  61. Public Const WM_DESTROY = &H2
  62. Public Const WM_GETTEXT = &HD
  63. Public Const WM_GETTEXTLENGTH = &HE
  64. Public Const WM_LBUTTONDBLCLK = &H203
  65. Public Const BM_GETCHECK = &HF0
  66. Public Const BM_GETSTATE = &HF2
  67. Public Const BM_SETCHECK = &HF1
  68. Public Const BM_SETSTATE = &HF3
  69.  
  70. Public Const LB_GETITEMDATA = &H199
  71. Public Const LB_GETCOUNT = &H18B
  72. Public Const LB_ADDSTRING = &H180
  73. Public Const LB_DELETESTRING = &H182
  74. Public Const LB_FINDSTRING = &H18F
  75. Public Const LB_FINDSTRINGEXACT = &H1A2
  76. Public Const LB_GETCURSEL = &H188
  77. Public Const LB_GETTEXT = &H189
  78. Public Const LB_GETTEXTLEN = &H18A
  79. Public Const LB_SELECTSTRING = &H18C
  80. Public Const LB_SETCOUNT = &H1A7
  81. Public Const LB_SETCURSEL = &H186
  82. Public Const LB_SETSEL = &H185
  83. Public Const LB_INSERTSTRING = &H181
  84.  
  85. Public Const VK_HOME = &H24
  86. Public Const VK_RIGHT = &H27
  87. Public Const VK_CONTROL = &H11
  88. Public Const VK_DELETE = &H2E
  89. Public Const VK_DOWN = &H28
  90. Public Const VK_LEFT = &H25
  91. Public Const VK_RETURN = &HD
  92. Public Const VK_SPACE = &H20
  93. Public Const VK_TAB = &H9
  94.  
  95. Public Const HWND_TOP = 0
  96. Public Const HWND_TOPMOST = -1
  97. Public Const HWND_NOTOPMOST = -2
  98. Public Const SWP_NOMOVE = &H2
  99. Public Const SWP_NOSIZE = &H1
  100. Public Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE
  101.  
  102. Public Const GW_CHILD = 5
  103. Public Const GW_HWNDFIRST = 0
  104. Public Const GW_HWNDLAST = 1
  105. Public Const GW_HWNDNEXT = 2
  106. Public Const GW_HWNDPREV = 3
  107. Public Const GW_MAX = 5
  108. Public Const GW_OWNER = 4
  109. Public Const SW_MAXIMIZE = 3
  110. Public Const SW_MINIMIZE = 6
  111. Public Const SW_HIDE = 0
  112. Public Const SW_RESTORE = 9
  113. Public Const SW_SHOW = 5
  114. Public Const SW_SHOWDEFAULT = 10
  115. Public Const SW_SHOWMAXIMIZED = 3
  116. Public Const SW_SHOWMINIMIZED = 2
  117. Public Const SW_SHOWMINNOACTIVE = 7
  118. Public Const SW_SHOWNOACTIVATE = 4
  119. Public Const SW_SHOWNORMAL = 1
  120.  
  121. Public Const MF_APPEND = &H100&
  122. Public Const MF_DELETE = &H200&
  123. Public Const MF_CHANGE = &H80&
  124. Public Const MF_ENABLED = &H0&
  125. Public Const MF_DISABLED = &H2&
  126. Public Const MF_REMOVE = &H1000&
  127. Public Const MF_POPUP = &H10&
  128. Public Const MF_STRING = &H0&
  129. Public Const MF_UNCHECKED = &H0&
  130. Public Const MF_CHECKED = &H8&
  131. Public Const MF_GRAYED = &H1&
  132. Public Const MF_BYPOSITION = &H400&
  133. Public Const MF_BYCOMMAND = &H0&
  134.  
  135. Public Const GWW_HINSTANCE = (-6)
  136. Public Const GWW_ID = (-12)
  137. Public Const GWL_STYLE = (-16)
  138.  
  139. Public Const PROCESS_VM_READ = &H10
  140. Public Const STANDARD_RIGHTS_REQUIRED = &HF0000
  141.  
  142. Type RECT
  143.    Left As Long
  144.    Top As Long
  145.    Right As Long
  146.    Bottom As Long
  147. End Type
  148.  
  149. Type POINTAPI
  150.    X As Long
  151.    Y As Long
  152. End Type
  153.  
  154. Public Function AOLGetList(index As Long, buffer As String)
  155. On Error Resume Next
  156.  
  157. Dim AOLProcess As Long
  158. Dim ListItemHold As Long
  159. Dim Person As String
  160. Dim ListPersonHold As Long
  161. Dim ReadBytes As Long
  162.     
  163.  
  164. room = AOLFindRoom()
  165. aolhandle = FindChildByClass(room, "_AOL_Listbox")
  166.  
  167. AOLThread = GetWindowThreadProcessId(aolhandle, AOLProcess)
  168. AOLProcessThread = OpenProcess(PROCESS_VM_READ Or STANDARD_RIGHTS_REQUIRED, False, AOLProcess)
  169.  
  170. If AOLProcessThread Then
  171. Person$ = String$(4, vbNullChar)
  172. ListItemHold = SendMessage(aolhandle, LB_GETITEMDATA, ByVal CLng(index), ByVal 0&)
  173. ListItemHold = ListItemHold + 24
  174. Call ReadProcessMemory(AOLProcessThread, ListItemHold, Person$, 4, ReadBytes)
  175.                         
  176. Call RtlMoveMemory(ListPersonHold, ByVal Person$, 4)
  177. ListPersonHold = ListPersonHold + 6
  178.  
  179. Person$ = String$(16, vbNullChar)
  180. Call ReadProcessMemory(AOLProcessThread, ListPersonHold, Person$, Len(Person$), ReadBytes)
  181.  
  182. Person$ = Left$(Person$, InStr(Person$, vbNullChar) - 1)
  183. Call CloseHandle(AOLProcessThread)
  184. End If
  185.  
  186. buffer$ = Person$
  187. End Function
  188.  
  189.  
  190.  
  191.  
  192.  
  193. Function AddListToString(thelist As ListBox)
  194. For DoList = 0 To thelist.ListCount - 1
  195. AddListToString = AddListToString & thelist.List(DoList) & ", "
  196. Next DoList
  197. AddListToString = Mid(AddListToString, 1, Len(AddListToString) - 2)
  198. End Function
  199.  
  200.  
  201. Sub AddStringToList(theitems, thelist As ListBox)
  202. If Not Mid(theitems, Len(theitems), 1) = "," Then
  203. theitems = theitems & ","
  204. End If
  205.  
  206. For DoList = 1 To Len(theitems)
  207. thechars$ = thechars$ & Mid(theitems, DoList, 1)
  208.  
  209. If Mid(theitems, DoList, 1) = "," Then
  210. thelist.AddItem Mid(thechars$, 1, Len(thechars$) - 1)
  211. thechars$ = ""
  212. If Mid(theitems, DoList + 1, 1) = " " Then
  213. DoList = DoList + 1
  214. End If
  215. End If
  216. Next DoList
  217.  
  218. End Sub
  219.  
  220.  
  221. Function AOLClickList(hwnd)
  222. clicklist% = SendMessageByNum(hwnd, &H203, 0, 0&)
  223. End Function
  224.  
  225.  
  226. Function AOLCountMail()
  227. themail% = FindChildByClass(AOLMDI(), "AOL Child")
  228. thetree% = FindChildByClass(themail%, "_AOL_Tree")
  229. AOLCountMail = SendMessage(thetree%, LB_GETCOUNT, 0, 0)
  230. End Function
  231.  
  232. Sub AOLOpenChat()
  233. If AOLFindRoom() Then Exit Sub
  234. AOLKeyword ("pc")
  235. Do: DoEvents
  236. Loop Until AOLFindRoom()
  237.  
  238. End Sub
  239.  
  240.  
  241. Sub AOLOpenMail(which)
  242. If which = 1 Then
  243. Call AOLRunMenuByString("Read &New Mail")
  244. End If
  245.  
  246. If which = 2 Then
  247. Call AOLRunMenuByString("Check Mail You've &Read")
  248. End If
  249.  
  250. If Not which = 1 Or Not which = 2 Then
  251. Call AOLRunMenuByString("Check Mail You've &Sent")
  252. End If
  253.  
  254. End Sub
  255.  
  256.  
  257. Sub AOLRespondIM(message)
  258. IM% = FindChildByTitle(AOLMDI(), ">Instant Message From:")
  259. If IM% Then GoTo Z
  260. IM% = FindChildByTitle(AOLMDI(), "  Instant Message From:")
  261. If IM% Then GoTo Z
  262. Exit Sub
  263. Z:
  264. e = FindChildByClass(IM%, "RICHCNTL")
  265.  
  266. e = GetWindow(e, 2)
  267. e = GetWindow(e, 2)
  268. e = GetWindow(e, 2)
  269. e = GetWindow(e, 2)
  270. e = GetWindow(e, 2)
  271. e = GetWindow(e, 2)
  272. e = GetWindow(e, 2)
  273. e = GetWindow(e, 2)
  274. e = GetWindow(e, 2)
  275. e2 = GetWindow(e, 2) 'Send Text
  276. e = GetWindow(e2, 2) 'Send Button
  277. Call AOLSetText(e2, message)
  278. AOLIcon (e)
  279. End Sub
  280.  
  281. Sub AOLRunMenuByString(stringer As String)
  282. Call RunMenuByString(AOLWindow(), stringer)
  283. End Sub
  284.  
  285.  
  286. Sub AOLWaitMail()
  287. mailwin% = GetTopWindow(AOLMDI())
  288. aoltree% = FindChildByClass(mailwin%, "_AOL_Tree")
  289.  
  290. Do: DoEvents
  291. firstcount = SendMessage(aoltree%, LB_GETCOUNT, 0, 0)
  292. Pause (3)
  293. secondcount = SendMessage(aoltree%, LB_GETCOUNT, 0, 0)
  294. If firstcount = secondcount Then Exit Do
  295. Loop
  296.  
  297.  
  298. End Sub
  299.  
  300.  
  301. Function EncryptType(text, types)
  302. 'to encrypt, example:
  303. 'encrypted$ = EncryptType("messagetoencrypt", 0)
  304. 'to decrypt, example:
  305. 'decrypted$ = EncryptType("decryptedmessage", 1)
  306. '* First Paramete is the Message
  307. '* Second Parameter is 0 for encrypt
  308. '  or 1 for decrypt
  309.  
  310. For God = 1 To Len(text)
  311. If types = 0 Then
  312. Current$ = Asc(Mid(text, God, 1)) - 1
  313. Else
  314. Current$ = Asc(Mid(text, God, 1)) + 1
  315. End If
  316. Process$ = Process$ & Chr(Current$)
  317. Next God
  318.  
  319. EncryptType = Process$
  320. End Function
  321.  
  322. Function FindChildByTitle(parentw, childhand)
  323. firs% = GetWindow(parentw, 5)
  324. If UCase(GetCaption(firs%)) Like UCase(childhand) Then GoTo bone
  325. firs% = GetWindow(parentw, GW_CHILD)
  326.  
  327. While firs%
  328. firss% = GetWindow(parentw, 5)
  329. If UCase(GetCaption(firss%)) Like UCase(childhand) & "*" Then GoTo bone
  330. firs% = GetWindow(firs%, 2)
  331. If UCase(GetCaption(firs%)) Like UCase(childhand) & "*" Then GoTo bone
  332. Wend
  333. FindChildByTitle = 0
  334.  
  335. bone:
  336. room% = firs%
  337. FindChildByTitle = room%
  338. End Function
  339.  
  340. Function FindChildByClass(parentw, childhand)
  341. firs% = GetWindow(parentw, 5)
  342. If UCase(Mid(GetClass(firs%), 1, Len(childhand))) Like UCase(childhand) Then GoTo bone
  343. firs% = GetWindow(parentw, GW_CHILD)
  344. If UCase(Mid(GetClass(firs%), 1, Len(childhand))) Like UCase(childhand) Then GoTo bone
  345.  
  346. While firs%
  347. firss% = GetWindow(parentw, 5)
  348. If UCase(Mid(GetClass(firss%), 1, Len(childhand))) Like UCase(childhand) Then GoTo bone
  349. firs% = GetWindow(firs%, 2)
  350. If UCase(Mid(GetClass(firs%), 1, Len(childhand))) Like UCase(childhand) Then GoTo bone
  351. Wend
  352. FindChildByClass = 0
  353.  
  354. bone:
  355. room% = firs%
  356. FindChildByClass = room%
  357.  
  358. End Function
  359.  
  360.  
  361.  
  362.  
  363. Function DescrambleText(thetext)
  364. 'sees if there's a space in the text to be scrambled,
  365. 'if found space, continues, if not, adds it
  366. findlastspace = Mid(thetext, Len(thetext), 1)
  367.  
  368. If Not findlastspace = " " Then
  369. thetext = thetext & " "
  370. Else
  371. thetext = thetext
  372. End If
  373.  
  374. 'Descrambles the text
  375. For scrambling = 1 To Len(thetext)
  376. thechar$ = Mid(thetext, scrambling, 1)
  377. Char$ = Char$ & thechar$
  378.  
  379. If thechar$ = " " Then
  380. 'takes out " " space from the text left of the space
  381. chars$ = Mid(Char$, 1, Len(Char$) - 1)
  382. 'gets first character
  383. firstchar$ = Mid(chars$, 1, 1)
  384. 'gets last character (if not, makes first character only)
  385. On Error GoTo city
  386. lastchar$ = Mid(chars$, 2, 1)
  387. 'finds what is inbetween the last and first character
  388. midchar$ = Mid(chars$, 3, Len(chars$) - 2)
  389. 'reverses the text found in between the last and first
  390. 'character
  391. For SpeedBack = Len(midchar$) To 1 Step -1
  392. backchar$ = backchar$ & Mid$(midchar$, SpeedBack, 1)
  393. Next SpeedBack
  394. GoTo sniffed
  395.  
  396. 'adds the scrambled text to the full scrambled element
  397. city:
  398. scrambled$ = scrambled$ & firstchar$ & " "
  399. GoTo sniff
  400.  
  401. sniffed:
  402. scrambled$ = scrambled$ & lastchar$ & backchar$ & firstchar$ & " "
  403.  
  404. 'clears character and reversed buffers
  405. sniff:
  406. Char$ = ""
  407. backchar$ = ""
  408. End If
  409.  
  410. Next scrambling
  411. 'Makes function return value the scrambled text
  412. DescrambleText = scrambled$
  413.  
  414. End Function
  415.  
  416.  
  417.  
  418. Function GetLineCount(text)
  419.  
  420. theview$ = text
  421.  
  422.  
  423. For FindChar = 1 To Len(theview$)
  424. thechar$ = Mid(theview$, FindChar, 1)
  425.  
  426. If thechar$ = Chr(13) Then
  427. numline = numline + 1
  428. End If
  429.  
  430. Next FindChar
  431.  
  432. If Mid(text, Len(text), 1) = Chr(13) Then
  433. GetLineCount = numline
  434. Else
  435. GetLineCount = numline + 1
  436. End If
  437. End Function
  438.  
  439. Function IntegerToString(tochange As Integer) As String
  440. IntegerToString = Str$(tochange)
  441. End Function
  442.  
  443. Function LineFromText(text, theline)
  444. theview$ = text
  445.  
  446.  
  447. For FindChar = 1 To Len(theview$)
  448. thechar$ = Mid(theview$, FindChar, 1)
  449. thechars$ = thechars$ & thechar$
  450.  
  451. If thechar$ = Chr(13) Then
  452. c = c + 1
  453. thechatext$ = Mid(thechars$, 1, Len(thechars$) - 1)
  454. If theline = c Then GoTo ex
  455. thechars$ = ""
  456. End If
  457.  
  458. Next FindChar
  459. Exit Function
  460. ex:
  461. thechatext$ = ReplaceText(thechatext$, Chr(13), "")
  462. thechatext$ = ReplaceText(thechatext$, Chr(10), "")
  463. LineFromText = thechatext$
  464.  
  465.  
  466. End Function
  467.  
  468. Function NumericNumber(thenumber)
  469. NumericNumber = Val(thenumber)
  470. 'turns the "number" so vb recognizes it for
  471. 'addition, subtraction, ect.
  472.  
  473. End Function
  474.  
  475. Sub ParentChange(Parent%, location%)
  476. doparent% = SetParent(Parent%, location%)
  477. End Sub
  478.  
  479.  
  480. Function RandomNumber(finished)
  481. Randomize
  482. RandomNumber = Int((Val(finished) * Rnd) + 1)
  483. End Function
  484.  
  485. Function ReverseText(text)
  486. For Words = Len(text) To 1 Step -1
  487. ReverseText = ReverseText & Mid(text, Words, 1)
  488. Next Words
  489.  
  490.  
  491. End Function
  492.  
  493. Sub RunMenuByString(Application, StringSearch)
  494. ToSearch% = GetMenu(Application)
  495. MenuCount% = GetMenuItemCount(ToSearch%)
  496.  
  497. For FindString = 0 To MenuCount% - 1
  498. ToSearchSub% = GetSubMenu(ToSearch%, FindString)
  499. MenuItemCount% = GetMenuItemCount(ToSearchSub%)
  500.  
  501. For GetString = 0 To MenuItemCount% - 1
  502. SubCount% = GetMenuItemID(ToSearchSub%, GetString)
  503. MenuString$ = String$(100, " ")
  504. GetStringMenu% = GetMenuString(ToSearchSub%, SubCount%, MenuString$, 100, 1)
  505.  
  506. If InStr(UCase(MenuString$), UCase(StringSearch)) Then
  507. MenuItem% = SubCount%
  508. GoTo MatchString
  509. End If
  510.  
  511. Next GetString
  512.  
  513. Next FindString
  514. MatchString:
  515. RunTheMenu% = SendMessage(Application, WM_COMMAND, MenuItem%, 0)
  516. End Sub
  517.  
  518. Sub AOLRunTool(tool)
  519. toolbar% = FindChildByClass(AOLWindow(), "AOL Toolbar")
  520. iconz% = FindChildByClass(toolbar%, "_AOL_Icon")
  521. For X = 1 To tool - 1
  522. iconz% = GetWindow(iconz%, 2)
  523. Next X
  524. isen% = IsWindowEnabled(iconz%)
  525. If isen% = 0 Then Exit Sub
  526. AOLIcon (iconz%)
  527. End Sub
  528.  
  529. Function ScrambleGame(thestring As String)
  530. Dim bytestring As String
  531.  
  532. thestringcount = Len(thestring$)
  533. If Not Mid(thestring$, thestringcount, 1) = " " Then thestring$ = thestring$ & " "
  534. For Stringe = 1 To Len(thestring$)
  535. characters$ = Mid(thestring$, Stringe, 1)
  536. thestrings$ = thestrings$ & characters$
  537.  
  538. If characters$ = " " Then
  539. smoked:
  540. DoEvents
  541. For Ensemble = 1 To Len(thestrings$) - 1
  542. Randomize
  543. randomstring = Int((Len(thestrings$) * Rnd) + 1)
  544. If randomstring = Len(thestrings$) Then GoTo already
  545. If bytesread Like "*" & randomstring & "*" Then GoTo already
  546. stringrandom$ = Mid(thestrings$, randomstring, 1)
  547. stringfound$ = stringfound$ & stringrandom$
  548. bytesread = bytesread & randomstring
  549. GoTo really
  550. already:
  551. Ensemble = Ensemble - 1
  552. really:
  553. Next Ensemble
  554. If stringfound$ = thestrings$ Then stringfound$ = "": GoTo smoked
  555. thestrings2$ = thestrings2$ & stringfound$ & " "
  556. stringfound$ = ""
  557. thestrings$ = ""
  558. bytesread = ""
  559. strngfound$ = ""
  560. End If
  561.  
  562. Next Stringe
  563. ScrambleGame = Mid(thestrings2$, 1, Len(thestring$) - 1)
  564. End Function
  565.  
  566. Function ScrambleText(thetext)
  567. 'sees if there's a space in the text to be scrambled,
  568. 'if found space, continues, if not, adds it
  569. findlastspace = Mid(thetext, Len(thetext), 1)
  570.  
  571. If Not findlastspace = " " Then
  572. thetext = thetext & " "
  573. Else
  574. thetext = thetext
  575. End If
  576.  
  577. 'Scrambles the text
  578. For scrambling = 1 To Len(thetext)
  579. thechar$ = Mid(thetext, scrambling, 1)
  580. Char$ = Char$ & thechar$
  581.  
  582. If thechar$ = " " Then
  583. 'takes out " " space from the text left of the space
  584. chars$ = Mid(Char$, 1, Len(Char$) - 1)
  585. 'gets first character
  586. firstchar$ = Mid(chars$, 1, 1)
  587. 'gets last character (if not, makes first character only)
  588. On Error GoTo cityz
  589. lastchar$ = Mid(chars$, Len(chars$), 1)
  590.  
  591. 'finds what is inbetween the last and first character
  592. midchar$ = Mid(chars$, 2, Len(chars$) - 2)
  593. 'reverses the text found in between the last and first
  594. 'character
  595. For SpeedBack = Len(midchar$) To 1 Step -1
  596. backchar$ = backchar$ & Mid$(midchar$, SpeedBack, 1)
  597. Next SpeedBack
  598. GoTo sniffe
  599.  
  600. 'adds the scrambled text to the full scrambled element
  601. cityz:
  602. scrambled$ = scrambled$ & firstchar$ & " "
  603. GoTo sniffs
  604.  
  605. sniffe:
  606. scrambled$ = scrambled$ & lastchar$ & firstchar$ & backchar$ & " "
  607.  
  608. 'clears character and reversed buffers
  609. sniffs:
  610. Char$ = ""
  611. backchar$ = ""
  612. End If
  613.  
  614. Next scrambling
  615. 'Makes function return value the scrambled text
  616. ScrambleText = scrambled$
  617.  
  618. Exit Function
  619. End Function
  620.  
  621.  
  622. Function ReplaceText(text, charfind, charchange)
  623. If InStr(text, charfind) = 0 Then
  624. ReplaceText = text
  625. Exit Function
  626. End If
  627.  
  628. For Replace = 1 To Len(text)
  629. thechar$ = Mid(text, Replace, 1)
  630. thechars$ = thechars$ & thechar$
  631.  
  632. If thechar$ = charfind Then
  633. thechars$ = Mid(thechars$, 1, Len(thechars$) - 1) + charchange
  634. End If
  635. Next Replace
  636.  
  637. ReplaceText = thechars$
  638.  
  639. End Function
  640.  
  641.  
  642. Sub SetBackPre()
  643. Call RunMenuByString(AOLWindow(), "Preferences")
  644.  
  645. Do: DoEvents
  646. prefer% = FindChildByTitle(AOLMDI(), "Preferences")
  647. maillab% = FindChildByTitle(prefer%, "Mail")
  648. mailbut% = GetWindow(maillab%, GW_HWNDNEXT)
  649. If maillab% <> 0 And mailbut% <> 0 Then Exit Do
  650. Loop
  651.  
  652. Pause (0.2)
  653. AOLIcon (mailbut%)
  654.  
  655. Do: DoEvents
  656. aolmod% = FindWindow("_AOL_Modal", "Mail Preferences")
  657. aolcloses% = FindChildByTitle(aolmod%, "Close mail after it has been sent")
  658. aolconfirm% = FindChildByTitle(aolmod%, "Confirm mail after it has been sent")
  659. aolOK% = FindChildByTitle(aolmod%, "OK")
  660. If aolOK% <> 0 And aolcloses% <> 0 And aolconfirm% <> 0 Then Exit Do
  661. Loop
  662. sendcon% = SendMessage(aolcloses%, BM_SETCHECK, 0, 0)
  663. sendcon% = SendMessage(aolconfirm%, BM_SETCHECK, 1, 0)
  664.  
  665. AOLButton (aolOK%)
  666. Do: DoEvents
  667. aolmod% = FindWindow("_AOL_Modal", "Mail Preferences")
  668. Loop Until aolmod% = 0
  669.  
  670. closepre% = SendMessage(prefer%, WM_CLOSE, 0, 0)
  671.  
  672. End Sub
  673.  
  674. Function StayOnline()
  675. hwndz% = FindWindow("_AOL_Palette", "America Online")
  676. childhwnd% = FindChildByTitle(hwndz%, "OK")
  677. AOLButton (childhwnd%)
  678. End Function
  679.  
  680. Function StringToInteger(tochange As String) As Integer
  681. StringToInteger = tochange
  682. End Function
  683. Function TrimCharacter(thetext, chars)
  684. TrimCharacter = ReplaceText(thetext, chars, "")
  685.  
  686. End Function
  687.  
  688. Function TrimReturns(thetext)
  689. takechr13 = ReplaceText(thetext, Chr$(13), "")
  690. takechr10 = ReplaceText(takechr13, Chr$(10), "")
  691. TrimReturns = takechr10
  692. End Function
  693.  
  694. Function TrimSpaces(text)
  695. If InStr(text, " ") = 0 Then
  696. TrimSpaces = text
  697. Exit Function
  698. End If
  699.  
  700. For TrimSpace = 1 To Len(text)
  701. thechar$ = Mid(text, TrimSpace, 1)
  702. thechars$ = thechars$ & thechar$
  703.  
  704. If thechar$ = " " Then
  705. thechars$ = Mid(thechars$, 1, Len(thechars$) - 1)
  706. End If
  707. Next TrimSpace
  708.  
  709. TrimSpaces = thechars$
  710. End Function
  711.  
  712.  
  713. Function AOLMDI()
  714. aol% = FindWindow("AOL Frame25", vbNullString)
  715. AOLMDI = FindChildByClass(aol%, "MDIClient")
  716. End Function
  717.  
  718.  
  719. Function UntilWindowClass(parentw, childhand)
  720. GoBack:
  721. DoEvents
  722. firs% = GetWindow(parentw, 5)
  723. If UCase(Mid(GetClass(firs%), 1, Len(childhand))) Like UCase(childhand) Then GoTo bone
  724. firs% = GetWindow(parentw, GW_CHILD)
  725. If UCase(Mid(GetClass(firs%), 1, Len(childhand))) Like UCase(childhand) Then GoTo bone
  726.  
  727. While firs%
  728. firss% = GetWindow(parentw, 5)
  729. If UCase(Mid(GetClass(firss%), 1, Len(childhand))) Like UCase(childhand) Then GoTo bone
  730. firs% = GetWindow(firs%, 2)
  731. If UCase(Mid(GetClass(firs%), 1, Len(childhand))) Like UCase(childhand) Then GoTo bone
  732. Wend
  733. GoTo GoBack
  734. FindClassLike = 0
  735.  
  736. bone:
  737. room% = firs%
  738. UntilWindowClass = room%
  739. End Function
  740.  
  741. Function FindFwdWin(dosloop)
  742. 'FindFwdWin = GetParent(FindChildByTitle(FindChildByClass(AOLMDI(), "AOL Child"), "Forward"))
  743. 'Exit Function
  744. firs% = GetWindow(FindChildByClass(AOLWindow(), "MDIClient"), 5)
  745. forw% = FindChildByTitle(firs%, "Forward")
  746. If forw% <> 0 Then GoTo bone
  747. firs% = GetWindow(FindChildByClass(AOLWindow(), "MDIClient"), GW_CHILD)
  748.  
  749. Do: DoEvents
  750. firss% = GetWindow(FindChildByClass(AOLWindow(), "MDIClient"), 5)
  751. forw% = FindChildByTitle(firss%, "Forward")
  752. If forw% <> 0 Then GoTo begis
  753. firs% = GetWindow(firs%, 2)
  754. forw% = FindChildByTitle(firs%, "Forward")
  755. If forw% <> 0 Then GoTo bone
  756. If dosloop = 1 Then Exit Do
  757. Loop
  758. Exit Function
  759. bone:
  760. FindFwdWin = firs%
  761.  
  762. Exit Function
  763. begis:
  764. FindFwdWin = firss%
  765. End Function
  766.  
  767.  
  768. Function FindSendWin(dosloop)
  769. firs% = GetWindow(FindChildByClass(AOLWindow(), "MDIClient"), 5)
  770. forw% = FindChildByTitle(firs%, "Send Now")
  771. If forw% <> 0 Then GoTo bone
  772. firs% = GetWindow(FindChildByClass(AOLWindow(), "MDIClient"), GW_CHILD)
  773.  
  774. Do: DoEvents
  775. firss% = GetWindow(FindChildByClass(AOLWindow(), "MDIClient"), 5)
  776. forw% = FindChildByTitle(firss%, "Send Now")
  777. If forw% <> 0 Then GoTo begis
  778. firs% = GetWindow(firs%, 2)
  779. forw% = FindChildByTitle(firs%, "Send Now")
  780. If forw% <> 0 Then GoTo bone
  781. If dosloop = 1 Then Exit Do
  782. Loop
  783. Exit Function
  784. bone:
  785. FindSendWin = firs%
  786.  
  787. Exit Function
  788. begis:
  789. FindSendWin = firss%
  790. End Function
  791.  
  792. Function UntilWindowTitle(parentw, childhand)
  793. GoBac:
  794. DoEvents
  795. firs% = GetWindow(parentw, 5)
  796. If UCase(GetCaption(firs%)) Like UCase(childhand) Then GoTo bone
  797. firs% = GetWindow(parentw, GW_CHILD)
  798.  
  799. While firs%
  800. firss% = GetWindow(parentw, 5)
  801. If UCase(GetCaption(firss%)) Like UCase(childhand) Then GoTo bone
  802. firs% = GetWindow(firs%, 2)
  803. If UCase(GetCaption(firs%)) Like UCase(childhand) Then GoTo bone
  804. Wend
  805. GoTo GoBac
  806. FindWindowLike = 0
  807.  
  808. bone:
  809. room% = firs%
  810. UntilWindowTitle = room%
  811.  
  812. End Function
  813.  
  814.  
  815. Function KTEncrypt(ByVal password, ByVal strng, force%)
  816. 'Example:
  817. 'temp = KTEncrypt ("Paszwerd", text1.text, 0)
  818. 'text1.text = temp
  819.  
  820.  
  821.   'Set error capture routine
  822.   On Local Error GoTo ErrorHandler
  823.  
  824.   
  825.   'Is there Password??
  826.   If Len(password) = 0 Then Error 31100
  827.   
  828.   'Is password too long
  829.   If Len(password) > 255 Then Error 31100
  830.  
  831.   'Is there a strng$ to work with?
  832.   If Len(strng) = 0 Then Error 31100
  833.  
  834.   
  835.   'Check if file is encrypted and not forcing
  836.   If force% = 0 Then
  837.     
  838.     'Check for encryption ID tag
  839.     chk$ = Left$(strng, 4) + Right$(strng, 4)
  840.     
  841.     If chk$ = Chr$(1) + "KT" + Chr$(1) + Chr$(1) + "KT" + Chr$(1) Then
  842.       
  843.       'Remove ID tag
  844.       strng = Mid$(strng, 5, Len(strng) - 8)
  845.       
  846.       'String was encrypted so filter out CHR$(1) flags
  847.       look = 1
  848.       Do
  849.         look = InStr(look, strng, Chr$(1))
  850.         If look = 0 Then
  851.           Exit Do
  852.         Else
  853.           Addin$ = Chr$(Asc(Mid$(strng, look + 1)) - 1)
  854.           strng = Left$(strng, look - 1) + Addin$ + Mid$(strng, look + 2)
  855.         End If
  856.         look = look + 1
  857.       Loop
  858.       
  859.       'Since it is encrypted we want to decrypt it
  860.       EncryptFlag% = False
  861.     
  862.     Else
  863.       'Tag not found so flag to encrypt string
  864.       EncryptFlag% = True
  865.     End If
  866.   Else
  867.     'force% flag set, ecrypt string regardless of tag
  868.     EncryptFlag% = True
  869.   End If
  870.     
  871.  
  872.  
  873.   'Set up variables
  874.   PassUp = 1
  875.   PassMax = Len(password)
  876.   
  877.   
  878.   'Tack on leading characters to prevent repetative recognition
  879.   password = Chr$(Asc(Left$(password, 1)) Xor PassMax) + password
  880.   password = Chr$(Asc(Mid$(password, 1, 1)) Xor Asc(Mid$(password, 2, 1))) + password
  881.   password = password + Chr$(Asc(Right$(password, 1)) Xor PassMax)
  882.   password = password + Chr$(Asc(Right$(password, 2)) Xor Asc(Right$(password, 1)))
  883.   
  884.   
  885.   'If Encrypting add password check tag now so it is encrypted with string
  886.   If EncryptFlag% = True Then
  887.     strng = Left$(password, 3) + Format$(Asc(Right$(password, 1)), "000") + Format$(Len(password), "000") + strng
  888.   End If
  889.   
  890.   'Loop until scanned though the whole string
  891.   For Looper = 1 To Len(strng)
  892. DoEvents
  893.     'Alter character code
  894.     tochange = Asc(Mid$(strng, Looper, 1)) Xor Asc(Mid$(password, PassUp, 1))
  895.  
  896.     'Insert altered character code
  897.     Mid$(strng, Looper, 1) = Chr$(tochange)
  898.     
  899.     'Scroll through password string one character at a time
  900.     PassUp = PassUp + 1
  901.     If PassUp > PassMax + 4 Then PassUp = 1
  902.       
  903.   Next Looper
  904.  
  905.   'If encrypting we need to filter out all bad character codes (0, 10, 13, 26)
  906.   If EncryptFlag% = True Then
  907.     'First get rid of all CHR$(1) since that is what we use for our flag
  908.     look = 1
  909.     Do
  910.       look = InStr(look, strng, Chr$(1))
  911.       If look > 0 Then
  912.         strng = Left$(strng, look - 1) + Chr$(1) + Chr$(2) + Mid$(strng, look + 1)
  913.         look = look + 1
  914.       End If
  915.     Loop While look > 0
  916.  
  917.     'Check for CHR$(0)
  918.     Do
  919.       look = InStr(strng, Chr$(0))
  920.       If look > 0 Then strng = Left$(strng, look - 1) + Chr$(1) + Chr$(1) + Mid$(strng, look + 1)
  921.     Loop While look > 0
  922.  
  923.     'Check for CHR$(10)
  924.     Do
  925.       look = InStr(strng, Chr$(10))
  926.       If look > 0 Then strng = Left$(strng, look - 1) + Chr$(1) + Chr$(11) + Mid$(strng, look + 1)
  927.     Loop While look > 0
  928.  
  929.     'Check for CHR$(13)
  930.     Do
  931.       look = InStr(strng, Chr$(13))
  932.       If look > 0 Then strng = Left$(strng, look - 1) + Chr$(1) + Chr$(14) + Mid$(strng, look + 1)
  933.     Loop While look > 0
  934.  
  935.     'Check for CHR$(26)
  936.     Do
  937.       look = InStr(strng, Chr$(26))
  938.       If look > 0 Then strng = Left$(strng, look - 1) + Chr$(1) + Chr$(27) + Mid$(strng, look + 1)
  939.     Loop While look > 0
  940.  
  941.     'Tack on encryted tag
  942.     strng = Chr$(1) + "KT" + Chr$(1) + strng + Chr$(1) + "KT" + Chr$(1)
  943.  
  944.   Else
  945.     
  946.     'We decrypted so ensure password used was the correct one
  947.     If Left$(strng, 9) <> Left$(password, 3) + Format$(Asc(Right$(password, 1)), "000") + Format$(Len(password), "000") Then
  948.       'Password bad cause error
  949.       Error 31100
  950.     Else
  951.       'Password good, remove password check tag
  952.       strng = Mid$(strng, 10)
  953.     End If
  954.  
  955.   End If
  956.  
  957.  
  958.   'Set function equal to modified string
  959.   KTEncrypt = strng
  960.   
  961.  
  962.   'Were out of here
  963.   Exit Function
  964.  
  965.  
  966. ErrorHandler:
  967.   
  968.   'We had an error!  Were out of here
  969.   Exit Function
  970.  
  971. End Function
  972.  
  973. Public Sub CenterForm(frmForm As Form)
  974.    With frmForm
  975.       .Left = (Screen.Width - .Width) / 2
  976.       .Top = (Screen.Height - .Height) / 2
  977.    End With
  978. End Sub
  979.  
  980.  
  981.  
  982. Public Function GetChildCount(ByVal hwnd As Long) As Long
  983. Dim hChild As Long
  984.  
  985. Dim i As Integer
  986.    
  987. If hwnd = 0 Then
  988. GoTo Return_False
  989. End If
  990.  
  991. hChild = GetWindow(hwnd, GW_CHILD)
  992.    
  993.  
  994. While hChild
  995. hChild = GetWindow(hChild, GW_HWNDNEXT)
  996. i = i + 1
  997. Wend
  998.  
  999. GetChildCount = i
  1000.    
  1001. Exit Function
  1002. Return_False:
  1003. GetChildCount = 0
  1004. Exit Function
  1005. End Function
  1006.  
  1007. Public Sub AOLButton(but%)
  1008. clickicon% = SendMessage(but%, WM_KEYDOWN, VK_SPACE, 0)
  1009. clickicon% = SendMessage(but%, WM_KEYUP, VK_SPACE, 0)
  1010. End Sub
  1011.  
  1012. Function AOLGetUser()
  1013. On Error Resume Next
  1014. aol% = FindWindow("AOL Frame25", "America  Online")
  1015. mdi% = FindChildByClass(aol%, "MDIClient")
  1016. Welcome% = FindChildByTitle(mdi%, "Welcome, ")
  1017. WelcomeLength% = GetWindowTextLength(Welcome%)
  1018. WelcomeTitle$ = String$(200, 0)
  1019. a% = GetWindowText(Welcome%, WelcomeTitle$, (WelcomeLength% + 1))
  1020. User = Mid$(WelcomeTitle$, 10, (InStr(WelcomeTitle$, "!") - 10))
  1021. AOLGetUser = User
  1022. End Function
  1023.  
  1024. Sub AOLIMOff()
  1025. Call AOLInstantMessage("$IM_OFF", "Turn off!")
  1026.  
  1027. End Sub
  1028.  
  1029. Sub AOLIMsOn()
  1030. Call AOLInstantMessage("$IM_ON", "Turn on!")
  1031.  
  1032. End Sub
  1033.  
  1034.  
  1035. Sub AOLChatSend(Txt)
  1036. room% = AOLFindRoom()
  1037. Call AOLSetText(FindChildByClass(room%, "_AOL_Edit"), Txt)
  1038. DoEvents
  1039. Call SendCharNum(FindChildByClass(room%, "_AOL_Edit"), 13)
  1040. End Sub
  1041.  
  1042.  
  1043. Sub AOLClose(winew)
  1044. closes = SendMessage(winew, WM_CLOSE, 0, 0)
  1045. End Sub
  1046.  
  1047. Sub AOLCursor()
  1048. Call RunMenuByString(AOLWindow(), "&About America Online")
  1049. Do: DoEvents
  1050. Loop Until FindWindow("_AOL_Modal", vbNullString)
  1051. SendMessage FindWindow("_AOL_Modal", vbNullString), WM_CLOSE, 0, 0
  1052. End Sub
  1053.  
  1054. Function AOLFindRoom()
  1055. aol% = FindWindow("AOL Frame25", vbNullString)
  1056. mdi% = FindChildByClass(aol%, "MDIClient")
  1057. firs% = GetWindow(mdi%, 5)
  1058. listers% = FindChildByClass(firs%, "_AOL_Edit")
  1059. listere% = FindChildByClass(firs%, "_AOL_View")
  1060. listerb% = FindChildByClass(firs%, "_AOL_Listbox")
  1061. If listers% And listere% And listerb% Then GoTo bone
  1062.  
  1063. firs% = GetWindow(mdi%, GW_CHILD)
  1064. While firs%
  1065. firs% = GetWindow(firs%, 2)
  1066. listers% = FindChildByClass(firs%, "_AOL_Edit")
  1067. listere% = FindChildByClass(firs%, "_AOL_View")
  1068. listerb% = FindChildByClass(firs%, "_AOL_Listbox")
  1069. If listers% And listere% And listerb% Then GoTo bone
  1070. aol% = FindWindow("AOL Frame25", vbNullString)
  1071. mdi% = FindChildByClass(aol%, "MDIClient")
  1072. firs% = GetWindow(mdi%, 5)
  1073. listers% = FindChildByClass(firs%, "_AOL_Edit")
  1074. listere% = FindChildByClass(firs%, "_AOL_View")
  1075. listerb% = FindChildByClass(firs%, "_AOL_Listbox")
  1076. If listers% And listere% And listerb% Then GoTo bone
  1077. Wend
  1078.  
  1079. bone:
  1080. room% = firs%
  1081. AOLFindRoom = room%
  1082. End Function
  1083.  
  1084.  
  1085. Function AOLGetChat()
  1086. childs% = AOLFindRoom()
  1087. child = FindChildByClass(childs%, "_AOL_View")
  1088.  
  1089.  
  1090. GetTrim = SendMessageByNum(child, 14, 0&, 0&)
  1091. TrimSpace$ = Space$(GetTrim)
  1092. GetString = SendMessageByString(child, 13, GetTrim + 1, TrimSpace$)
  1093.  
  1094. theview$ = TrimSpace$
  1095. AOLGetChat = theview$
  1096. End Function
  1097.  
  1098. Function AOLGetText(child)
  1099. GetTrim = SendMessageByNum(child, 14, 0&, 0&)
  1100. TrimSpace$ = Space$(GetTrim)
  1101. GetString = SendMessageByString(child, 13, GetTrim + 1, TrimSpace$)
  1102.  
  1103. AOLGetText = TrimSpace$
  1104. End Function
  1105.  
  1106. Sub AOLIcon(icon%)
  1107. Click% = SendMessage(icon%, WM_LBUTTONDOWN, 0, 0&)
  1108. Click% = SendMessage(icon%, WM_LBUTTONUP, 0, 0&)
  1109. End Sub
  1110.  
  1111. Sub AOLInstantMessage(Person, message)
  1112. Call RunMenuByString(AOLWindow(), "Send an Instant Message")
  1113.  
  1114. Do: DoEvents
  1115. aol% = FindWindow("AOL Frame25", vbNullString)
  1116. mdi% = FindChildByClass(aol%, "MDIClient")
  1117. IM% = FindChildByTitle(mdi%, "Send Instant Message")
  1118. aoledit% = FindChildByClass(IM%, "_AOL_Edit")
  1119. aolrich% = FindChildByClass(IM%, "RICHCNTL")
  1120. imsend% = FindChildByClass(IM%, "_AOL_Icon")
  1121. If aoledit% <> 0 And aolrich% <> 0 And imsend% <> 0 Then Exit Do
  1122. Loop
  1123.  
  1124. Call AOLSetText(aoledit%, Person)
  1125. Call AOLSetText(aolrich%, message)
  1126. imsend% = FindChildByClass(IM%, "_AOL_Icon")
  1127.  
  1128. For sends = 1 To 9
  1129. imsend% = GetWindow(imsend%, 2)
  1130. Next sends
  1131.  
  1132. AOLIcon (imsend%)
  1133.  
  1134. Do: DoEvents
  1135. aol% = FindWindow("AOL Frame25", vbNullString)
  1136. mdi% = FindChildByClass(aol%, "MDIClient")
  1137. IM% = FindChildByTitle(mdi%, "Send Instant Message")
  1138. aolcl% = FindWindow("#32770", "America Online")
  1139. If aolcl% <> 0 Then closer = SendMessage(aolcl%, WM_CLOSE, 0, 0): closer2 = SendMessage(IM%, WM_CLOSE, 0, 0): Exit Do
  1140. If IM% = 0 Then Exit Do
  1141. Loop
  1142. End Sub
  1143.  
  1144. Function AOLIsOnline()
  1145. aol% = FindWindow("AOL Frame25", vbNullString)
  1146. mdi% = FindChildByClass(aol%, "MDIClient")
  1147. Welcome% = FindChildByTitle(mdi%, "Welcome, ")
  1148. If Welcome% = 0 Then
  1149. MsgBox "Please sign on before using this feature.", 64, "Online"
  1150. AOLIsOnline = 0
  1151. Exit Function
  1152. End If
  1153. AOLIsOnline = 1
  1154. End Function
  1155.  
  1156. Sub AOLKeyword(text)
  1157. Call RunMenuByString(AOLWindow(), "Keyword...")
  1158.  
  1159. Do: DoEvents
  1160. aol% = FindWindow("AOL Frame25", vbNullString)
  1161. mdi% = FindChildByClass(aol%, "MDIClient")
  1162. keyw% = FindChildByTitle(mdi%, "Keyword")
  1163. kedit% = FindChildByClass(keyw%, "_AOL_Edit")
  1164. If kedit% Then Exit Do
  1165. Loop
  1166.  
  1167. editsend% = SendMessageByString(kedit%, WM_SETTEXT, 0, text)
  1168. pausing = DoEvents()
  1169. Sending% = SendMessage(kedit%, 258, 13, 0)
  1170. pausing = DoEvents()
  1171. End Sub
  1172.  
  1173. Function AOLLastChatLine()
  1174. getpar% = AOLFindRoom()
  1175. child = FindChildByClass(getpar%, "_AOL_View")
  1176. GetTrim = SendMessageByNum(child, 14, 0&, 0&)
  1177. TrimSpace$ = Space$(GetTrim)
  1178. GetString = SendMessageByString(child, 13, GetTrim + 1, TrimSpace$)
  1179.  
  1180. theview$ = TrimSpace$
  1181.  
  1182.  
  1183. For FindChar = 1 To Len(theview$)
  1184. thechar$ = Mid(theview$, FindChar, 1)
  1185. thechars$ = thechars$ & thechar$
  1186.  
  1187. If thechar$ = Chr(13) Then
  1188. thechatext$ = Mid(thechars$, 1, Len(thechars$) - 1)
  1189. thechars$ = ""
  1190. End If
  1191.  
  1192. Next FindChar
  1193.  
  1194. lastlen = Val(FindChar) - Len(thechars$)
  1195. lastline = Mid(theview$, lastlen + 1, Len(thechars$) - 1)
  1196. AOLLastChatLine = lastline
  1197. End Function
  1198.  
  1199. Sub AOLMail(Person, subject, message)
  1200. Call RunMenuByString(AOLWindow(), "Compose Mail")
  1201.  
  1202. Do: DoEvents
  1203. aol% = FindWindow("AOL Frame25", vbNullString)
  1204. mdi% = FindChildByClass(aol%, "MDIClient")
  1205. mailwin% = FindChildByTitle(mdi%, "Compose Mail")
  1206. icone% = FindChildByClass(mailwin%, "_AOL_Icon")
  1207. peepz% = FindChildByClass(mailwin%, "_AOL_Edit")
  1208. subjt% = FindChildByTitle(mailwin%, "Subject:")
  1209. subjec% = GetWindow(subjt%, 2)
  1210. mess% = FindChildByClass(mailwin%, "RICHCNTL")
  1211. If icone% <> 0 And peepz% <> 0 And subjec% <> 0 And mess% <> 0 Then Exit Do
  1212. Loop
  1213.  
  1214. a = SendMessageByString(peepz%, WM_SETTEXT, 0, Person)
  1215. a = SendMessageByString(subjec%, WM_SETTEXT, 0, subject)
  1216. a = SendMessageByString(mess%, WM_SETTEXT, 0, message)
  1217.  
  1218. AOLIcon (icone%)
  1219.  
  1220. Do: DoEvents
  1221. aol% = FindWindow("AOL Frame25", vbNullString)
  1222. mdi% = FindChildByClass(aol%, "MDIClient")
  1223. mailwin% = FindChildByTitle(mdi%, "Compose Mail")
  1224. erro% = FindChildByTitle(mdi%, "Error")
  1225. aolw% = FindWindow("_AOL_Modal", vbNullString)
  1226. If mailwin% = 0 Then Exit Do
  1227. If aolw% <> 0 Then
  1228. 'a = SendMessage(aolw%, WM_CLOSE, 0, 0)
  1229. AOLButton (FindChildByTitle(aolw%, "OK"))
  1230. a = SendMessage(mailwin%, WM_CLOSE, 0, 0)
  1231. Exit Sub
  1232. End If
  1233. If erro% <> 0 Then
  1234. a = SendMessage(erro%, WM_CLOSE, 0, 0)
  1235. a = SendMessage(mailwin%, WM_CLOSE, 0, 0)
  1236. Exit Do
  1237. End If
  1238. Loop
  1239. End Sub
  1240.  
  1241. Sub AOLMainMenu()
  1242. Call RunMenu(2, 3)
  1243. End Sub
  1244.  
  1245. Function AOLRoomCount()
  1246. thechild% = AOLFindRoom()
  1247. lister% = FindChildByClass(thechild%, "_AOL_Listbox")
  1248.  
  1249. getcount = SendMessage(lister%, LB_GETCOUNT, 0, 0)
  1250. AOLRoomCount = getcount
  1251. End Function
  1252.  
  1253. Sub AOLSetText(win, Txt)
  1254. thetext% = SendMessageByString(win, WM_SETTEXT, 0, Txt)
  1255. End Sub
  1256.  
  1257. Sub AOLSignOff()
  1258. aol% = FindWindow("AOL Frame25", vbNullString)
  1259. If aol% = 0 Then MsgBox "AOL client error: Please open Windows America Online before continuing.", 64, "Error: Windows America Online": Exit Sub
  1260. Call RunMenu(2, 0)
  1261.  
  1262. Exit Sub
  1263. 'ignore since of new aol....
  1264. Do: DoEvents
  1265. aol% = FindWindow("AOL Frame25", vbNullString)
  1266. pfc% = FindChildByTitle(aol%, "Sign Off?")
  1267. If pfc% <> 0 Then
  1268. icon1% = FindChildByClass(pfc%, "_AOL_Icon")
  1269. icon1% = GetWindow(icon1%, 2)
  1270. icon1% = GetWindow(icon1%, 2)
  1271. icon1% = GetWindow(icon1%, 2)
  1272. icon1% = GetWindow(icon1%, 2)
  1273. icon1% = GetWindow(icon1%, 2)
  1274. clickicon% = SendMessage(icon1%, WM_LBUTTONDOWN, 0, 0&)
  1275. clickicon% = SendMessage(icon1%, WM_LBUTTONUP, 0, 0&)
  1276. Exit Do
  1277. End If
  1278. Loop
  1279.  
  1280. End Sub
  1281.  
  1282. Function AOLVersion()
  1283. aol% = FindWindow("AOL Frame25", vbNullString)
  1284. hMenu% = GetMenu(aol%)
  1285.  
  1286. submenu% = GetSubMenu(hMenu%, 0)
  1287. subitem% = GetMenuItemID(submenu%, 8)
  1288. MenuString$ = String$(100, " ")
  1289.  
  1290. FindString% = GetMenuString(submenu%, subitem%, MenuString$, 100, 1)
  1291.  
  1292. If UCase(MenuString$) Like UCase("P&ersonal Filing Cabinet") & "*" Then
  1293. AOLVersion = 3
  1294. Else
  1295. AOLVersion = 2.5
  1296. End If
  1297. End Function
  1298.  
  1299. Function AOLWindow()
  1300. aol% = FindWindow("AOL Frame25", vbNullString)
  1301. AOLWindow = aol%
  1302. End Function
  1303.  
  1304.  
  1305.  
  1306. Function GetCaption(hwnd)
  1307. hwndLength% = GetWindowTextLength(hwnd)
  1308. hwndTitle$ = String$(hwndLength%, 0)
  1309. a% = GetWindowText(hwnd, hwndTitle$, (hwndLength% + 1))
  1310.  
  1311. GetCaption = hwndTitle$
  1312. End Function
  1313.  
  1314. Function GetClass(child)
  1315. buffer$ = String$(250, 0)
  1316. getclas% = GetClassName(child, buffer$, 250)
  1317.  
  1318. GetClass = buffer$
  1319. End Function
  1320.  
  1321. Function GetWindowDir()
  1322. buffer$ = String$(255, 0)
  1323. X = GetWindowsDirectory(buffer$, 255)
  1324. If Right$(buffer$, 1) <> "\" Then buffer$ = buffer$ + "\"
  1325. GetWindowDir = buffer$
  1326. End Function
  1327. Sub NotOnTop(the As Form)
  1328. SetWinOnTop = SetWindowPos(the.hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, FLAGS)
  1329. End Sub
  1330.  
  1331. Sub Pause(interval)
  1332. Current = Timer
  1333. Do While Timer - Current < Val(interval)
  1334. DoEvents
  1335. Loop
  1336. End Sub
  1337.  
  1338. Sub SendCharNum(win, chars)
  1339. e = SendMessageByNum(win, WM_CHAR, chars, 0)
  1340.  
  1341. End Sub
  1342.  
  1343. Function SetChildFocus(child)
  1344. setchild% = SetFocusAPI(child)
  1345. End Function
  1346.  
  1347. Sub SetPreference()
  1348. Call RunMenuByString(AOLWindow(), "Preferences")
  1349.  
  1350. Do: DoEvents
  1351. prefer% = FindChildByTitle(AOLMDI(), "Preferences")
  1352. maillab% = FindChildByTitle(prefer%, "Mail")
  1353. mailbut% = GetWindow(maillab%, GW_HWNDNEXT)
  1354. If maillab% <> 0 And mailbut% <> 0 Then Exit Do
  1355. Loop
  1356.  
  1357. Pause (0.2)
  1358. AOLIcon (mailbut%)
  1359.  
  1360. Do: DoEvents
  1361. aolmod% = FindWindow("_AOL_Modal", "Mail Preferences")
  1362. aolcloses% = FindChildByTitle(aolmod%, "Close mail after it has been sent")
  1363. aolconfirm% = FindChildByTitle(aolmod%, "Confirm mail after it has been sent")
  1364. aolOK% = FindChildByTitle(aolmod%, "OK")
  1365. If aolOK% <> 0 And aolcloses% <> 0 And aolconfirm% <> 0 Then Exit Do
  1366. Loop
  1367. sendcon% = SendMessage(aolcloses%, BM_SETCHECK, 1, 0)
  1368. sendcon% = SendMessage(aolconfirm%, BM_SETCHECK, 0, 0)
  1369.  
  1370. AOLButton (aolOK%)
  1371. Do: DoEvents
  1372. aolmod% = FindWindow("_AOL_Modal", "Mail Preferences")
  1373. Loop Until aolmod% = 0
  1374.  
  1375. closepre% = SendMessage(prefer%, WM_CLOSE, 0, 0)
  1376.  
  1377. End Sub
  1378.  
  1379. Sub StayOnTop(the As Form)
  1380. SetWinOnTop = SetWindowPos(the.hwnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS)
  1381. End Sub
  1382.  
  1383. Sub RunMenu(menu1 As Integer, menu2 As Integer)
  1384. Dim AOLWorks As Long
  1385. Static Working As Integer
  1386.  
  1387. AOLMenus% = GetMenu(FindWindow("AOL Frame25", vbNullString))
  1388. AOLSubMenu% = GetSubMenu(AOLMenus%, menu1)
  1389. AOLItemID = GetMenuItemID(AOLSubMenu%, menu2)
  1390. AOLWorks = CLng(0) * &H10000 Or Working
  1391. ClickAOLMenu = SendMessageByNum(FindWindow("AOL Frame25", vbNullString), 273, AOLItemID, 0&)
  1392.  
  1393. End Sub
  1394.  
  1395.  
  1396. Sub WaitWindow()
  1397. aol% = FindWindow("AOL Frame25", vbNullString)
  1398. mdi% = FindChildByClass(aol%, "MDIClient")
  1399. topmdi% = GetWindow(mdi%, 5)
  1400.  
  1401. Do: DoEvents
  1402. aol% = FindWindow("AOL Frame25", vbNullString)
  1403. mdi% = FindChildByClass(aol%, "MDIClient")
  1404. topmdi2% = GetWindow(mdi%, 5)
  1405. If Not topmdi2% = topmdi% Then Exit Do
  1406. Loop
  1407.  
  1408. End Sub
  1409.  
  1410.  
  1411. Function FreeProcess()
  1412. Do: DoEvents
  1413. Process = Process + 1
  1414. If Process = 50 Then Exit Do
  1415. Loop
  1416. 'frees process of freezes in your program
  1417. 'and other stuff that makes your program
  1418. 'slow down.  Works great.
  1419.  
  1420. End Function
  1421.  
  1422.  
  1423.  
  1424.