chnocombre | voila le code (attention c'est long):
Code :
- Private Function funcMSN()
-
- '
- 'Declare Some variables for the process
- '
-
- With frmAuditMaker
-
- 'Domain and searchengine string
- Dim strDomain As String
- Dim strSearchEngine As String
-
- 'Double for the navigation in the code
- Dim dblStart As Double
- Dim dblLen As Double
-
- 'Byte for the place of the keywords
- Dim bytPlaceCounter As Byte
-
- 'String for the text check
- Dim strKeywords As String
- Dim strBody As String
- Dim strCheck As String
-
- 'Boolean if the domain is found
- Dim boolTargetFound As Boolean
-
- 'Html Object to read html code
- Dim Webdoc As MSHTML.HTMLDocument
- Set Webdoc = wbbViewer.document
-
- '
- 'Initialize Variables
- '
-
- 'Replace " " by + for the search engin and the é too
- strKeywords = Replace(.txtKeywords, " ", "+" )
- strKeywords = Replace(strKeywords, "é", "%C3%A9" )
-
- 'Place Counter initialize
- bytPlaceCounter = 1
-
- 'Initialize Domain name
- strDomain = .txtDomain.Text
-
- 'Initialize searchengine
- strSearchEngine = .cmbSearchEngine.Text
-
- 'Load webPage
- .wbbViewer.navigate strSearchEngine & "/results.aspx?q=" & strKeywords & "&FORM=QBHP"
-
- 'Wait for the page to be full loaded
- Do Until .wbbViewer.readyState = READYSTATE_COMPLETE
- DoEvents
- Loop
-
-
- 'Initialize to not found
- boolTargetFound = False
-
- 'Initialize the HTML Body to check
- strBody = Webdoc.body.innerHTML
-
- 'Initialize the check start
- dblStart = 1
-
- 'Initialize the place
- bytPlaceCounter = 1
-
- 'Initialize the starting point (for MSN only)
- dblStart = InStr(dblStart, strBody, "</P></LI></UL></DIV></DIV>", vbTextCompare) + 1
-
- 'Check the HTML for the 50 first result
- Do Until bytPlaceCounter = 50
-
- 'Récupération du texte de la page web:
- dblStart = InStr(dblStart, strBody, "<H3><A href=", vbTextCompare) + 13
-
- 'Obselete test, may be in use in the futur
- 'If Not (InStr(dblStart - 40, strBody, "<BLOCKQUOTE>", vbTextCompare)) > 20 Then
-
- 'Initialize the lenght of string to check
- dblLen = InStr(dblStart, strBody, ">", vbTextCompare) - 1
-
- 'Save the string to check
- strCheck = Mid(strBody, dblStart, (dblLen - dblStart))
-
- 'Check the string
- If Not InStr(1, strCheck, strDomain, vbTextCompare) = 0 Then
-
- 'Set the found variable to true
- boolTargetFound = True
-
- 'Exit the check
- Exit Do
-
- End If
-
- 'Next place to check
- bytPlaceCounter = bytPlaceCounter + 1
-
- 'End If
-
- Loop
-
- 'If the domain eas found
- If boolTargetFound Then
-
- 'Return the place found
- funcMSN = bytPlaceCounter
-
- Else
-
- 'Return the default value
- funcMSN = "Not found in the 60 first result"
-
- End If
-
- End With
-
- End Function
|
le but du programme: rechercher un lien pointant vers un site contenu dans strDomain, depuis une page d'un moteur de recherche (genre google) URL formée en partie de cmbSearchEngine et de strKeywords puis de trouver à quelle place ce site vient ce placer grace à bytPlaceCounter. Message édité par chnocombre le 14-02-2005 à 10:23:19
|