Sujet Précédent Sujet Suivant

Agir depuis VB sur une fenêtre Internet ouverte mais aléatoire

Résolu
daisyrondelle Messages postés 7 Date d'inscription jeudi 16 octobre 2003 Statut Membre Dernière intervention 15 mars 2008 - 26 déc. 2004 à 19:39
daisyrondelle Messages postés 7 Date d'inscription jeudi 16 octobre 2003 Statut Membre Dernière intervention 15 mars 2008 - 31 déc. 2004 à 08:32
DaisyRondelle
Bonjour.
Voici mon pb simple à expliquer et compliqué à résoudres.
Je voudrai faire un petit prog dont la fonction est d'éxécuter des sendkeys de texte (type adresse mail ou adresse tout court) sur une zone de saisie (pointée par la souris) sur une page internet dont le nom (le site) n'est pas fixe et inconnu par le prog VB.
Les sendkeys à envoyer sur la zone de saisie de la page internet sont référencés par un numéro. Par exemple:
Si je tape le chiffre 1 vb doit envoyer mon nom.
Avec 2 il envoie mon adresse mail
Avec 3 il envoie mon code postal etc...
Est-ce que quelqu'un à une idée pour arriver à gérer cela qui est un peu compliqué pour moi... petit programmeur débutant.
Merci d'avance.

3 réponses

Réponse 1 / 3
cs_DARKSIDIOUS Messages postés 15814 Date d'inscription jeudi 8 août 2002 Statut Membre Dernière intervention 4 mars 2013 130
26 déc. 2004 à 20:07
Si tu dois poser le curseur de la souris sur la zone de texte devant afficher les informations à envoyer par SendKey, tu peux toujours t'inspirer des sources de KeyLogger déjà présente sur ce site pour intercepter les appuis des touches du clavier, et donner le focus à la feuille en dessous de la souris avant d'envoyer les touches par SendKey ou la fonction de l'API Windows keybd_event
_______________________________________

DarK Sidious

[Responsable API/VB du site www.ProgOtoP.com]
Téléchargez ProgOtoP API Viewer
3
Réponse 2 / 3
cs_CanisLupus Messages postés 3757 Date d'inscription mardi 23 septembre 2003 Statut Membre Dernière intervention 13 mars 2006 21
26 déc. 2004 à 20:03
Salut, pour certaines choses, j'utilise ça :

Dim r As Long
Dim i As Long

r = Shell("C:\Program Files\Internet Explorer\iexplore.exe TapageWeb", vbMaximizedFocus)

For i = 1 To 300000: DoEvents: Next 'le temps qu'elle se charge

SendKeys "TonNom", True
SendKeys "{TAB}", True
SendKeys "TonEmail", True
SendKeys "{TAB}", True
SendKeys "TonCodePostal", True
'......
SendKeys "{ENTER}", True

Mais, tout est conditionné par le focus donné par la page d'accueil.

Cordialement, CanisLupus
0
Réponse 3 / 3
daisyrondelle Messages postés 7 Date d'inscription jeudi 16 octobre 2003 Statut Membre Dernière intervention 15 mars 2008
31 déc. 2004 à 08:32
DaisyRondelle
Les 'solutions' proposées à ma question ne convenaient pas. J'ai quand même fini par en réaliser une qui a le mérite de fonctionner.
La voici, ci-dessous, aussi commentée que possible.....

Rappel de la fonction:
____________________
Saisie automatique sur une fenêtre Internet d'informations demandées telles que Adresse mail, N° carte bleue, password, adresse et ville nom de login etc....

Processus d'utilisation:
____________________________
Une fois le projet compilé, mettez son raccourci dans la barre de lancement rapide afin de l'avoir à portée de main dans tous les cas.
Lancez internet sur le site qui vous convient et qui risque de vous demander des infos (nom, carte bleue, adresse etc)
Lancez AppInternet.Exe par clic sur barre de lancement rapide.
Sa fenêtre est tjrs affichée en premier plan. Déplacez la si elle vous gène pour voir Internet.
Cliquez sur le nom de la fénêtre Internet ouverte (en haut de la fenêtre)
Ce nom va apparaître dans la zone 'Appli trouvée' de la form.
Cliquez sur le bouton 'confirmer' si c'est bien sur cette fenêtre Internet que vous voulez travailler. Sinon ouvrez une autre fenêtre internet, cliquez sur 'recommencer' puis sur 'confirmer'.....
Maintenant, sur la fenêtre Internet positionnez le curseur de la souris sur la première zone à saisir et mémorisez son titre (adresse mail, nom de ogin, password, etc).
Revenez sur la fenêtre appinternet et cliquez sur le label correspondant. Ce que vous avez enregistré dans le sendkey correspondant à ce label est saisi dans la zone correspondante de Internet et le curseur passe sur le champ suivant (s'il y en a un). Continuez jusqu'à la fin de vos envois.
A la fin revenez sur la fenêtre de AppInternet et appuyez une ou 2 seconde sur la touche 'Echap' ou cliquez sur 'Fin ou Echap'

Commencer par créer un projet VBP:AppInternet.vbp

'__________________________
Créez la form suivante avec tous ces composants
Caractérisrique de la form: AppInternetFrm.frm

VERSION 5.00
Begin VB.Form AppInternetFrm
ClientHeight = 4245
ClientLeft = 6000
ClientTop = 7545
ClientWidth = 4875
FillColor = &H000000FF&
LinkTopic = "Form1"
ScaleHeight = 4245
ScaleWidth = 4875
Begin VB.CommandButton Fin2
BackColor = &H00FFFFC0&
Caption = "Fin ou Echap"
BeginProperty Font
Name = "Arial"
Size = 12
Charset = 0
Weight = 700
Underline = -1 'True
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 2400
TabIndex = 26
Top = 0
Width = 2175
End
Begin VB.CommandButton Recommencer
BackColor = &H00FFFF00&
Caption = "Recommencer"
BeginProperty Font
Name = "Arial"
Size = 12
Charset = 0
Weight = 700
Underline = -1 'True
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 3000
TabIndex = 25
Top = 960
Width = 1815
End
Begin VB.CommandButton Fin
BackColor = &H00FFFFC0&
Caption = "Fin ou Echap"
BeginProperty Font
Name = "Arial"
Size = 12
Charset = 0
Weight = 700
Underline = -1 'True
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 1320
TabIndex = 19
Top = 3720
Width = 2175
End
Begin VB.CommandButton Confimer
BackColor = &H00FFFF00&
Caption = "Confirmer"
BeginProperty Font
Name = "Arial"
Size = 12
Charset = 0
Weight = 700
Underline = -1 'True
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 240
TabIndex = 18
Top = 960
Width = 1815
End
Begin VB.TextBox Appli
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 375
Left = 240
MultiLine = -1 'True
TabIndex = 17
Top = 600
Width = 4575
End
Begin VB.Timer Tmr
Interval = 1000
Left = 360
Top = 4080
End
Begin VB.Label Code
Caption = "Code"
Height = 255
Left = 3720
TabIndex = 24
Top = 3000
Width = 975
End
Begin VB.Label Identifiant
Caption = "Identifiant"
Height = 255
Left = 3720
TabIndex = 23
Top = 2760
Width = 975
End
Begin VB.Label Label2
Caption = "Organisme qqconque"
BeginProperty Font
Name = "Times New Roman"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 255
Left = 3720
TabIndex = 22
Top = 2400
Width = 855
End
Begin VB.Label Téléport
Caption = "Télé Port."
Height = 255
Index = 1
Left = 3720
TabIndex = 21
Top = 1920
Width = 975
End
Begin VB.Label TéléFixe
Caption = "Télé Fixe"
Height = 255
Index = 1
Left = 3720
TabIndex = 20
Top = 1680
Width = 1095
End
Begin VB.Label Label1
Caption = "Appli trouvée"
BeginProperty Font
Name = "Ariane Extra Bold DB"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 240
TabIndex = 16
Top = 120
Width = 1815
End
Begin VB.Label Crypto
Caption = "Crypto"
Height = 255
Index = 0
Left = 1920
TabIndex = 15
Top = 3480
Width = 855
End
Begin VB.Label AnnéeFin
Caption = "Année fin"
Height = 255
Index = 0
Left = 1920
TabIndex = 14
Top = 3240
Width = 975
End
Begin VB.Label MoisFin
Caption = "Mois Fin"
Height = 255
Index = 0
Left = 1920
TabIndex = 13
Top = 3000
Width = 975
End
Begin VB.Label Carte
Caption = "Carte bleue"
Height = 255
Index = 0
Left = 1920
TabIndex = 12
Top = 2760
Width = 1215
End
Begin VB.Label AnnéeNais
Caption = "Année naissance"
Height = 255
Index = 0
Left = 120
TabIndex = 11
Top = 2640
Width = 1575
End
Begin VB.Label MoisNais
Caption = "Mois Naissance"
Height = 255
Index = 0
Left = 120
TabIndex = 10
Top = 2400
Width = 1455
End
Begin VB.Label JourNais
Caption = "Jour Naissance"
Height = 255
Index = 0
Left = 120
TabIndex = 9
Top = 2160
Width = 1335
End
Begin VB.Label Pays
Caption = "Pays"
Height = 255
Index = 0
Left = 1920
TabIndex = 8
Top = 2400
Width = 735
End
Begin VB.Label Ville
Caption = "Ville"
Height = 255
Index = 0
Left = 1920
TabIndex = 7
Top = 2160
Width = 855
End
Begin VB.Label CodeP
Caption = "Code postal"
Height = 255
Index = 0
Left = 1920
TabIndex = 6
Top = 1920
Width = 1215
End
Begin VB.Label Adresse
Caption = "Adresse"
Height = 255
Index = 0
Left = 1920
TabIndex = 5
Top = 1680
Width = 1095
End
Begin VB.Label PassWord
Caption = "PassWord"
Height = 255
Index = 0
Left = 120
TabIndex = 4
Top = 3480
Width = 1095
End
Begin VB.Label Mail
Caption = "Mail"
Height = 255
Index = 0
Left = 120
TabIndex = 3
Top = 3240
Width = 615
End
Begin VB.Label Login
Caption = "Login"
Height = 255
Index = 0
Left = 120
TabIndex = 2
Top = 3000
Width = 735
End
Begin VB.Label Prénom
Caption = "Prénom"
Height = 255
Index = 1
Left = 120
TabIndex = 1
Top = 1920
Width = 1935
End
Begin VB.Label Nom
Caption = "Nom"
Height = 255
Index = 0
Left = 120
TabIndex = 0
Top = 1680
Width = 1935
End
End

Attribute VB_Name = "AppInternetFrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

'Le code dans la form:

Private Sub Form_Load()

' Pour garder toujours la form en premier plan
PositionForm AppInternetFrm

End Sub
'__________________________________
Private Sub Tmr_Timer()
'Déclare 2 nouvelles variables :
'Entree qui contiendra la phrase finale à enregistrer
'hwnd qui recupere le handle de la fenêtre qui a le focus
Dim hwnd As Long
Recommence:

'On définit pour valeur au handle celui de la fenêtre active

hwnd = 0
hwnd = GetForegroundWindow
Trouvé = False

App_hwnd = hwnd
Appli.Text = "(Pas trouvé)"
AppInternetFrm.Refresh

If Not Trouvé Then '(on ne cherche que la fenêtre ouverte comportant 'Internet' dans son nom
App_Title = Titreapplication(hwnd)
If App_Title <> "" Then
Entrée = App_Title

Appli.Text = "(Pas trouvé)"
AppInternetFrm.Refresh
Trouvé = False
y = InStr(1, Entrée, "Internet") 'On ne travaille que sur une fenêtre 'Internet'
If y > 0 Then
Trouvé = True
Appli.Text = Entrée
AppInternetFrm.Refresh
AppInternetFrm.Show

AttenteSaisie 'C'est trouvé : on bascule sur le module de saisie

End If
Else
Delay 1
GoTo Recommence 'sinon on boucle sur une app ouverte différente
End If
End If
'End If
End Sub
Private Sub Nom_Click(Index As Integer)
AppActivate Entrée
SendKeys "Votre nom", True
SendKeys "{TAB}", True 'tous les sendkeys 'tab' permettent de se positionner automatiquement sur la
' zone de saisie suivante
End Sub

'Envoi des info sur la zone sélectionnée correspondante de la page Internet

Private Sub Prénom_Click(Index As Integer)
AppActivate Entrée
SendKeys "prénom", True
SendKeys "{TAB}", True

End Sub

Private Sub JourNais_Click(Index As Integer)
AppActivate Entrée
SendKeys "jour naissance", True
SendKeys "{TAB}", True

End Sub
Private Sub MoisNais_Click(Index As Integer)
AppActivate Entrée
SendKeys "mois naissance", True
SendKeys "{TAB}", True

End Sub
Private Sub AnnéeNais_Click(Index As Integer)
AppActivate Entrée
SendKeys "année naissance", True
SendKeys "{TAB}", True
End Sub

Private Sub Login_Click(Index As Integer)
AppActivate Entrée
SendKeys "identifiant login", True
SendKeys "{TAB}", True
End Sub
Private Sub Mail_Click(Index As Integer)
AppActivate Entrée
SendKeys "mail@wanadoo.fr", True
SendKeys "{TAB}", True
End Sub
Private Sub PassWord_Click(Index As Integer)
AppActivate Entrée
SendKeys "Password", True
SendKeys "{TAB}", True

End Sub

Private Sub Adresse_Click(Index As Integer)
AppActivate Entrée
SendKeys "adresse", True
SendKeys "{TAB}", True

End Sub
Private Sub CodeP_Click(Index As Integer)
AppActivate Entrée
SendKeys "code postal", True
SendKeys "{TAB}", True

End Sub
Private Sub Ville_Click(Index As Integer)
AppActivate Entrée
SendKeys "Ville", True
SendKeys "{TAB}", True

End Sub
Private Sub Pays_Click(Index As Integer)
AppActivate Entrée
SendKeys "FRANCE", True
SendKeys "{TAB}", True

End Sub

Private Sub Carte_Click(Index As Integer)
AppActivate Entrée
SendKeys "N° carte bleue", True
SendKeys "{TAB}", True

End Sub
Private Sub MoisFin_Click(Index As Integer)
AppActivate Entrée
SendKeys "mois fin de la CB", True
SendKeys "{TAB}", True

End Sub
Private Sub AnnéeFin_Click(Index As Integer)
AppActivate Entrée
SendKeys "année fin de la CB", True
SendKeys "{TAB}", True

End Sub
Private Sub Crypto_Click(Index As Integer)
AppActivate Entrée
SendKeys "crypto de la CB", True
SendKeys "{TAB}", True

End Sub
Private Sub TéléFixe_Click(Index As Integer)
AppActivate Entrée
SendKeys "0188552233", True 'Téléphone fixe
SendKeys "{TAB}", True

End Sub
Private Sub Téléport_Click(Index As Integer)
AppActivate Entrée
SendKeys "0688552233", True 'Téléphone portable
SendKeys "{TAB}", True

End Sub

Private Sub Identifiant_Click()
AppActivate Entrée
SendKeys "ce que vous voulez", True
SendKeys "{TAB}", True

End Sub
Private Sub Code_Click()
AppActivate Entrée
SendKeys "ce que vous voulez", True
SendKeys "{TAB}", True

End Sub

Private Sub Confimer_Click()

If Trouvé Then AppActivate Entrée
AttenteSaisie
End Sub
Private Sub Fin_Click()
End
End Sub
Private Sub Fin2_Click()
End
End Sub

Private Sub Recommencer_Click()
Trouvé = False
Tmr_Timer
End Sub

'------------------ Terminé pour la form

Ajouter les modules suivants:

Module 1:AppInternet.bas

Option Explicit
'Variable pour récuperer le handle précédent de la fenêtre (voir Form1)
Global App_hwnd As Long
'Variable pour récupérer le nom de la fenêtre
Global App_Title As String

'Variable à déclarer
'Cette fonction recupere le text de la fenêtre avec 3 arguments :
' - le handle de la fenêtre
' - le buffer qui contiendra le texte
' - la longueur maximale du nom de l'application
Public Declare Function GetWindowText Lib "user32.dll" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long

'Cette fonction recupere la longeur du titre de l'application
'par son handle. Ici elle servira a fournir la longueur
'maximale du titre a récupérer via GetWindowText (dernier argument)
Public Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long

'Cette fonction sert a renvoyer le handle de la fenêtre qui
'a le focus, ou bien si vous préferez sur laquelle on travaille
Public Declare Function GetForegroundWindow Lib "user32.dll" () As Long

Global PremTouche, Appuyée'faire Appuyée Touche . Si au retour appuyée true, la touche a été appuyée
Global Entrée As String, Trouvé, y

'Fonction qui sert a obtenir le nom de l'application active.
'Son argument est le handle renvoyé dans le Timer via la
'fonction GetForegroundWindow
Function Titreapplication(hwnd As Long)
'Variable pour obtenir la longueur du titre ainsi que sont nom
Dim hWndlength As Long, hWndTitle As String, returnvalue As Long

'Longeur du titre envoyée dans la variable via la fonction
hWndlength = GetWindowTextLength(hwnd)
'Création d'un buffer
hWndTitle = String$(hWndlength, 0)
'Recupere finalement le titre de la fenêtre de handle
'hwnd, pour le mettre dans le buffer de taille adaptée, et
'avec une longeur maximale de caractère obtenu plus haut
'+ 1 avec le caractère NULL
returnvalue = GetWindowText(hwnd, hWndTitle, (hWndlength + 1))
'Finalement, on retourne le tout
Titreapplication = hWndTitle


End Function

Sub AttenteSaisie()
Dim I

AppInternetFrm.Appli.Text = Entrée
AppInternetFrm.Refresh
AppInternetFrm.Show


On Error GoTo Pasla
AppActivate Entrée
GoTo Suite
Pasla:
MsgBox "App: " & Entrée & " non ouverte"
Stop
Suite:
Appuyée = False

Do While Not Appuyée
Appuyée = Touche
For I = 1 To 100000
DoEvents
Next
Loop

End

End Sub

'______________ Module 2: ToucheFinale.bas

'Permet d'attendre que la touche 'Echap' soit appuyée pour terminer et fermer le programme

Declare Function GetAsyncKeyState% Lib "user32" (ByVal vKey As Long)
Dim xfin

Function Touche() As Variant
Touche = False
'Voir si la touche cherchée a été appuyée.

'Pour le code de la touche, voir la valeur dans le help en cherchant 'constante' puis 'code de touche'
'Dans appellant

'Déclarer: PremTouche et Appuyée à false'faire Appuyée Touche . Si au retour appuyée true, la touche a été appuyée

CarFin = vbKeyEnd 'Touche fin
CarEscape = vbKeyEscape
Touche = False
xfin = GetAsyncKeyState(36)
For I = 1 To 5000
If GetAsyncKeyState(CarFin) Or GetAsyncKeyState(CarEscape) Then
If Not PremTouche Then
xfin = GetAsyncKeyState(36)
PremTouche = True
Touche = False
Exit Function
End If

'Sinon
Touche = True
End If
DoEvents
Next
'MsgBox "Sortie de XFIN"
End Function

'______________ Module 3: Delay.bas

'Permet d'attendre un certain nbre de secondes passées en paramètre
Sub Delay (ByVal Sec As Integer)
Fini = Timer + Sec
AttDelai:
If Timer > Fini Then Exit Sub
GoTo AttDelai
End Sub
0

Discussions similaires

Récupération d'un mot aléatoire depuis un fichier texte
mornaloce -
buno -

24 réponses
lettre aléatoire
Thanos_the_yopper -
Thanos_the_yopper -

3 réponses
génerateur de nombre aléatoire
cs_samnick -
rt15 -

8 réponses
Reconnaissance de numéro par une webcam
ylaroche -
cs_EBArtSoft -

11 réponses
recuperer tirages numero roulette casino en ligne
rapido6 -
khemarak -

12 réponses
Rejoignez-nous