xpwindaube
|
dans un module:
Option Explicit
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function showwindow Lib "user32" Alias "ShowWindow" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
'api
Public Declare Function SendMEssageByString& Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String)
Private Declare Function FindWindowEx& Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String)
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
Private Declare Function SendMessageString& Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String)
Private Declare Function SendmessageLong& Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long)
'constante
Public Const VK_RETURN = &HD
Public Const WM_GETTEXT = &HD
Public Const WM_GETTEXTLENGTH = &HE
Public Const WM_CHAR = &H102
Public Const WM_SETTEXT = &HC
Public Function chatsend(Text As String)
On Error Resume Next
Dim room As Long, waol As Long, mdi As Long, child As Long, rich As Long
Dim list As Long, echange As Long, aolicon As Long
waol& = FindWindowEx(0&, 0&, "AOL Frame25", vbNullString) 'on cherche waol
mdi& = FindWindowEx(waol&, 0&, "MDIClient", vbNullString) 'on cherche la 2 eme parti de waol
child& = FindWindowEx(mdi&, 0&, "AOL Child", vbNullString) '1 ere fenetre
rich& = FindWindowEx(child&, 0&, "RICHCNTL", vbNullString) 'ou on ecrit
list& = FindWindowEx(child&, 0&, "_AOL_Listbox", vbNullString) 'la liste des pseudo
echange& = FindWindowEx(child&, 0&, "RICHCNTLREADONLY", vbNullString) 'ou tout le monde parle
aolicon& = FindWindowEx(child&, 0&, "_AOL_Icon", vbNullString) 'comme son nom l'indique
If rich& <> 0& And list& <> 0& And echange& <> 0& And aolicon& <> 0& Then 'tout est la ?
room& = child& 'si oui
If room& = 0& Then Exit Function 'on a pas trouvé
rich& = FindWindowEx(room&, 0&, "RICHCNTL", vbNullString) 'ou on ecrit
Call SendmessageLong&(rich&, WM_CHAR, VK_RETURN, 0&)
Call SendMessageString&(rich&, WM_SETTEXT, 0&, (Text$)) 'on met le texte
Call SendmessageLong&(rich&, WM_CHAR, VK_RETURN, 0&) 'on appuie sur entrée
End If
End Function
Function PrendreTexte(Fenetre As Long) As String
Dim Buff As String, TXTLen As Long
TXTLen = SendMessage(Fenetre, WM_GETTEXTLENGTH, 0&, 0&)
Buff = String(TXTLen, 0)
Call SendMEssageByString(Fenetre, WM_GETTEXT, TXTLen + 1, Buff)
PrendreTexte = Buff
End Function
Function Recup(tex As TextBox)
Dim AOL As Long, Salon As Long, rich As Long, vire As String '
Dim Check As String, Textz As String, Enleveinput As String ' Variables
If Trouver_Salon <> 0 Then ' Si on est sur un salon
Salon = Trouver_Salon ' On place le handle du salon dans la variable SALON
rich = FindWindowEx(Salon, 0, "RICHCNTL", vbNullString) ' On cherche l'objet RICHCNTL ( l'espace de frappe du salon )
tex.Text = PrendreTexte(rich) ' On place le texte de l'espace de frappe dans la box choisie
' Verification AOL fr/us : sur aol US il y a "Chat Input" qui se recupere avant le texte
Check$ = tex.Text ' On place le texte recupéré dans la Variable Check
If InStr(LCase(Check), LCase("Chat Input")) Then ' Si le texte "Chat Input" se trouve dans le texte
Enleveinput$ = Left(Check, 10) '
vire = Replace(Check, Enleveinput, vire) ' On l'enleve
tex.Text = vire ' On replace le texte dans la Box
Else ' Si le texte ne contient pas "Chat Input" , on a rien a changer
Exit Function ' On sort
End If
End If
End Function
Function Trouver_Salon()
Dim AOL As Long, mdi As Long, child ' On declare les Variables
Dim AOLBoX As Long, RichView As Long, Edit As Long '
Dim Icone As Long, Statik As Long '
AOL = Trouver_AOL ' On cherche AOL
mdi = FindWindowEx(AOL, 0, "MDIClient", vbNullString) ' On cherche le fond d'AOL ( la ou sont placées toutes les fenêtres )
child = FindWindowEx(mdi, 0, "AOL Child", vbNullString) ' On trouve une fenêtre
' On va verifier si cette fenêtre contient les objets d'un salon AOL
AOLBoX = FindWindowEx(child, 0, "_AOL_ListBox", vbNullString) ' Une ListBox (liste des pseudos)
RichView = FindWindowEx(child, 0, "RICHCNTLREADONLY", vbNullString) ' Une RichBox (La ou tout le monde ecrit)
Edit = FindWindowEx(child, 0, "RICHCNTL", vbNullString) ' Une zone de frappe (La ou vous taper votre texte)
Icone = FindWindowEx(child, 0, "_AOL_Icon", vbNullString) ' Un Bouton , même si toutes les fenêtres en contiennent un...
Statik = FindWindowEx(child, 0, "_AOL_Static", vbNullString) ' Un Static (idem)
If AOLBoX <> 0 And RichView <> 0 And Edit <> 0 And Icone <> 0 And Statik <> 0 Then ' Si tous les objets recherchés sont presents dans cette fenêtre
Trouver_Salon = child ' On a trouver le salon...
Exit Function ' On sort
Else ' Sinon
Do ' On commence une boucle
' On recommence a chercher les objets dans une autre fenêtre
child = FindWindowEx(mdi, 0, "AOL Child", vbNullString)
AOLBoX = FindWindowEx(child, 0, "_AOL_ListBox", vbNullString)
RichView = FindWindowEx(child, 0, "RICHCNTLREADONLY", vbNullString)
Edit = FindWindowEx(child, 0, "RICHCNTL", vbNullString)
Icone = FindWindowEx(child, 0, "_AOL_Icon", vbNullString)
Statik = FindWindowEx(child, 0, "_AOL_Static", vbNullString)
If AOLBoX <> 0 And RichView <> 0 And Edit <> 0 And Icone <> 0 And Statik <> 0 Then ' Si elle contient tous les objets
Trouver_Salon = child ' On a trouver
Exit Function ' On sort
End If
Loop Until child <> 0 ' On tourne la boucle
End If
Trouver_Salon = child
End Function
' Trouver la fenêtre d'aol
Function Trouver_AOL()
Trouver_AOL = FindWindow("aol frame25", vbNullString)
End Function
_dans une form:
Option Explicit
Private Sub Timer1_Timer()
If VK_RETURN Then ' si une touche est pressé alor on regarde le texte
Call Recup(Text2)
'hide
If LCase(Text2.Text) Like "'hide" Then
chatsend ""
chatsend "le programme est mtn caché pour le montrer tapez 'show"
Form1.Hide
Else
End If
'show
If LCase(Text2.Text) Like "'show" Then
chatsend ""
chatsend "le programme est mtn montrer"
Form1.Show
End If
End If
End Sub
Le timer doit etre réglé a 5 d'intervale.
bon ba bonne chance :)
Bonne prog' a tous ! ;-)
|