home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / aimrog1a / rogersai.bas
Encoding:
BASIC Source File  |  1999-10-26  |  9.7 KB  |  284 lines
  1. Attribute VB_Name = "RogersAIM3"
  2. 'Rogers AIM Bas 3.0
  3. 'For AIM 3.0
  4. 'By Rogers
  5. 'Thanks to:
  6. 'Pat or JK his spy provided easy coding when I was
  7. 'too lazy for all that typing ;)
  8. 'oirogers5@aol.com
  9. 'http://rogers.ownz.com
  10. 'http://oirogers5.cjb.net
  11. 'assorted subs taken from my module
  12. 'chrome32.bas
  13. Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
  14. Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
  15. Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
  16. 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
  17. Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
  18. Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
  19. Declare Function GetClassName& Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long)
  20. 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
  21. 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
  22. Public Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long)
  23. Declare Function mciSendString Lib "MMSystem" Alias "mcisendstring" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal wReturnLength As Integer, ByVal hCallback As Integer) As Long
  24. Const SND_SYNC = &H0
  25.     Public Const SND_ASYNC = &H1
  26.     Public Const SND_NODEFAULT = &H2
  27.     Public Const SND_MEMORY = &H4
  28.     Public Const SND_LOOP = &H8
  29.     Public Const SND_NOSTOP = &H10
  30. Public Const WM_CLOSE = &H10
  31. Public Const WM_SETTEXT = &HC
  32. Public Const WM_LBUTTONUP = &H202
  33. Public Const WM_LBUTTONDOWN = &H201
  34. Public Const SW_HIDE = 0
  35. Public Const SW_SHOW = 5
  36. Public Const SW_RESTORE = 9
  37. Public Const SW_MAXIMIZE = 3
  38. Public Const SW_MINIMIZE = 6
  39. Public Const GW_HWNDNEXT = 2
  40. Public Function GetSNfromIM()
  41. IM = FindWindow("AIM_IMessage", vbNullString)
  42. IMcap = GetCaption(IM)
  43. q = InStr(IMcap, "-")
  44. q = q - 1
  45. b = Left(IMcap, q)
  46. GetSNfromIM = b
  47.  
  48. End Function
  49. Public Function UserSN()
  50. Dim blist As Long
  51. Dim cap As String
  52. blist = FindWindow("_Oscar_BuddyListWin", vbNullString)
  53. cap = GetCaption(blist)
  54. MsgBox cap
  55. pos = InStr(cap, "'")
  56. MsgBox pos
  57.  
  58. SN = Left(cap, pos - 1)
  59. UserSN = SN
  60.  
  61.  
  62. End Function
  63. Public Sub SetText(Window As Long, Text As String)
  64.     Call SendMessageByString(Window&, WM_SETTEXT, 0&, Text$)
  65. End Sub
  66. Public Sub SendChat(what)
  67. aimchatwnd& = FindWindow("aim_chatwnd", vbNullString)
  68. wndateclass& = FindWindowEx(aimchatwnd&, 0&, "wndate32class", vbNullString)
  69. ateclass& = FindWindowEx(wndateclass&, 0&, "ate32class", vbNullString)
  70. wndateclass& = FindWindowEx(aimchatwnd&, wndateclass&, "wndate32class", vbNullString)
  71. Call SetText(wndateclass, what)
  72. Call SendMessageLong(wndateclass, WM_CHAR, ENTER_KEY, 0&)
  73.  
  74. End Sub
  75. Sub KillAd()
  76.  
  77. blist = FindWindow("_Oscar_BuddyListWin", vbNullString)
  78. ad = FindChildByClass(blist, "Ate32Class")
  79. Call ShowWindow(Hide2%, SW_HIDE)
  80. End Sub
  81. Sub ChatInvite(Who, message, roomname)
  82. oscarbuddylistwin& = FindWindow("_oscar_buddylistwin", vbNullString)
  83. oscartabgroup& = FindWindowEx(oscarbuddylistwin&, 0&, "_oscar_tabgroup", vbNullString)
  84. oscariconbtn& = FindWindowEx(oscartabgroup&, 0&, "_oscar_iconbtn", vbNullString)
  85. oscariconbtn& = FindWindowEx(oscartabgroup&, oscariconbtn&, "_oscar_iconbtn", vbNullString)
  86. Call ClickIcon(oscariconbtn)
  87. Do
  88. inv = FindWindow("aim_chatinvitesendwnd", vbNullString)
  89. Loop Until inv <> 0
  90. edit& = FindWindowEx(inv, 0&, "edit", vbNullString)
  91. Call SetText(edit, Who)
  92. edit& = FindWindowEx(inv, edit&, "edit", vbNullString)
  93. Call SetText(edit, message)
  94. edit& = FindWindowEx(inv, edit&, "edit", vbNullString)
  95. Call SetText(edit, roomname)
  96. aimchatinvitesendwnd& = FindWindow("aim_chatinvitesendwnd", vbNullString)
  97. oscarstatic& = FindWindowEx(aimchatinvitesendwnd&, 0&, "_oscar_static", vbNullString)
  98. oscarstatic& = FindWindowEx(aimchatinvitesendwnd&, oscarstatic&, "_oscar_static", vbNullString)
  99. Call ClickIcon(oscarstatic)
  100.  
  101. End Sub
  102. Sub UnKillAd()
  103.  
  104. blist = FindWindow("_Oscar_BuddyListWin", vbNullString)
  105. ad = FindChildByClass(blist, "Ate32Class")
  106. Call ShowWindow(Hide2%, SW_SHOW)
  107. End Sub
  108.  
  109. Public Function IMText()
  110. one = FindWindow("AIM_IMessage", vbNullString)
  111. two = FindChildByClass(one, "Ate32Class")
  112. IMText = GetText(two)
  113. End Function
  114. Public Sub SendIM(Who, what)
  115. oscarbuddylistwin& = FindWindow("_oscar_buddylistwin", vbNullString)
  116. oscartabgroup& = FindWindowEx(oscarbuddylistwin&, 0&, "_oscar_tabgroup", vbNullString)
  117. oscariconbtn& = FindWindowEx(oscartabgroup&, 0&, "_oscar_iconbtn", vbNullString)
  118. oscariconbtn& = FindWindowEx(oscartabgroup&, oscariconbtn&, "_oscar_iconbtn", vbNullString)
  119. Call ClickIcon(oscariconbtn)
  120. Do
  121. DoEvents
  122. Loop Until FindIM <> 0
  123. aimimessage& = FindWindow("aim_imessage", vbNullString)
  124. wndateclass& = FindWindowEx(aimimessage&, 0&, "wndate32class", vbNullString)
  125. ateclass& = FindWindowEx(wndateclass&, 0&, "ate32class", vbNullString)
  126. wndateclass& = FindWindowEx(aimimessage&, wndateclass&, "wndate32class", vbNullString)
  127. Call SetText(wndateclass, what)
  128. aimimessage& = FindWindow("aim_imessage", vbNullString)
  129. oscarpersistantcombo& = FindWindowEx(aimimessage&, 0&, "_oscar_persistantcombo", vbNullString)
  130. edit& = FindWindowEx(oscarpersistantcombo&, 0&, "edit", vbNullString)
  131. Call SetText(edit, what)
  132. aimimessage& = FindWindow("aim_imessage", vbNullString)
  133. oscariconbtn& = FindWindowEx(aimimessage&, 0&, "_oscar_iconbtn", vbNullString)
  134. Call ClickIcon(oscariconbtn)
  135.  
  136. End Sub
  137. Public Function FindIM() As Long
  138. IM = FindWindow("AIM_IMessage", vbNullString)
  139. FindIM = IM
  140.  
  141. End Function
  142. Public Sub StopIt()
  143. Do
  144. DoEvents
  145. Loop
  146.  
  147. End Sub
  148. Public Function GetCaption(WindowHandle As Long) As String
  149.     'From Dos
  150.     Dim buffer As String, TextLength As Long
  151.     TextLength& = GetWindowTextLength(WindowHandle&)
  152.     buffer$ = String(TextLength&, 0&)
  153.     Call GetWindowText(WindowHandle&, buffer$, TextLength& + 1)
  154.     GetCaption$ = buffer$
  155. End Function
  156. Sub ClickIcon(icon)
  157.  
  158. Call SendMessage(icon, WM_LBUTTONDOWN, 0, 0&)
  159. Call SendMessage(icon, WM_LBUTTONUP, 0, 0&)
  160. End Sub
  161. Function CountLines(Text As TextBox)
  162.     Dim a
  163.     a = SendMessage2(Text.hwnd, EM_GETLINECOUNT, 0, 0)
  164.     CountLines = a
  165. End Function
  166. Function GetLine(Text1 As TextBox, Lineh As Integer)
  167. Dim q As String
  168.  
  169. Dim m_sLineString As String * 1056
  170. m_sLineString = Space$(1056)
  171. q = SendMessage2(Text1.hwnd, EM_GETLINE, Lineh, ByVal m_sLineString)
  172. GetLine = q
  173.  
  174. End Function
  175. Public Sub Loadlistbox(thelist As ListBox, Directory As String)
  176.  
  177.  
  178.     Dim MyString As String
  179.     On Error Resume Next
  180.     Open Directory$ For Input As #1
  181.     While Not EOF(1)
  182.         Input #1, MyString$
  183.         DoEvents
  184.             thelist.AddItem MyString$
  185.         Wend
  186.  
  187.  
  188.         Close #1
  189.     End Sub
  190. Public Sub SaveListBox(thelist As ListBox, Directory As String)
  191.  
  192.  
  193.     Dim SaveList As Long
  194.     On Error Resume Next
  195.     Open Directory$ For Output As #1
  196.     For SaveList& = 0 To thelist.ListCount - 1
  197.         Print #1, thelist.List(SaveList&)
  198.     Next SaveList&
  199.  
  200.  
  201.     Close #1
  202. End Sub
  203. Public Sub LoadComboBox(thelist As ComboBox, Directory As String)
  204.  
  205.  
  206.     Dim MyString As String
  207.     On Error Resume Next
  208.     Open Directory$ For Input As #1
  209.     While Not EOF(1)
  210.         Input #1, MyString$
  211.         DoEvents
  212.             thelist.AddItem MyString$
  213.         Wend
  214.  
  215.  
  216.         Close #1
  217.     End Sub
  218. Public Sub SaveComboBox(thelist As ComboBox, Directory As String)
  219.  
  220.  
  221.     Dim SaveList As Long
  222.     On Error Resume Next
  223.     Open Directory$ For Output As #1
  224.     For SaveList& = 0 To thelist.ListCount - 1
  225.         Print #1, thelist.List(SaveList&)
  226.     Next SaveList&
  227.  
  228.  
  229.     Close #1
  230. End Sub
  231. Sub PrintIt(Text As TextBox)
  232.  
  233.  
  234.     Printer.Print "" + Text.Text + Str(Printer.Page)
  235.     Printer.NewPage
  236.     Printer.Print "" + Text.Text + Str(Printer.Page)
  237.     Printer.EndDoc
  238. End Sub
  239.  
  240.  
  241.  
  242. Public Function SaveIt(Data, File)
  243.     Open File For Output As #1
  244.     Write #1, Data
  245.     Close #1
  246.  
  247. End Function
  248. Public Function LoadIt(File, Data)
  249.  
  250.     Dim a As String
  251.     Open File For Input As 1
  252.     a = Input(LOF(1), 1)
  253.     Close 1
  254.     Data = a
  255.  
  256. End Function
  257. Sub WAVPlay(File)
  258.  
  259.     Dim SoundName As String
  260.     SoundName$ = File
  261.     wFlags% = SND_ASYNC Or SND_NODEFAULT
  262.     X = sndPlaySound(SoundName$, wFlags%)
  263. End Sub
  264. Public Sub WriteToINI(Section As String, Key As String, KeyValue As String, Directory As String)
  265.     Call WritePrivateProfileString(Section$, UCase$(Key$), KeyValue$, Directory$)
  266. End Sub
  267. Public Function GetFromINI(Section As String, Key As String, Directory As String) As String
  268.    Dim strBuffer As String
  269.    strBuffer = String(750, Chr(0))
  270.    Key$ = LCase$(Key$)
  271.    GetFromINI$ = Left(strBuffer, GetPrivateProfileString(Section$, ByVal Key$, "", strBuffer, Len(strBuffer), Directory$))
  272. End Function
  273. Public Sub ChatLink(site, word)
  274. ChatLink = "<A HREF= " + Chr(34) + site + Chr(34) + ">" + word = "</A>"
  275. End Sub
  276. Sub RespondIM(what)
  277. aimimessage& = FindWindow("aim_imessage", vbNullString)
  278. wndateclass& = FindWindowEx(aimimessage&, 0&, "wndate32class", vbNullString)
  279. ateclass& = FindWindowEx(wndateclass&, 0&, "ate32class", vbNullString)
  280. wndateclass& = FindWindowEx(aimimessage&, wndateclass&, "wndate32class", vbNullString)
  281. Call SetText(wndateclass, what)
  282. Call SendMessageLong(wndateclass, WM_CHAR, ENTER_KEY, 0&)
  283. End Sub
  284.