visual-basic - Google søge resultater i listview - Udvikleren.dk

Tags: visual-basic

<< < 1 2 3 > >>

Bruger #8719 @ 23.11.06 18:38

Er der nogen der kan forklare hvordan man får googles søge resultater ind i listview eller listbox.

Det jeg mener er at hvis man laver et program som søger på google, skal resultaterne komme frem i listview som links og med navnet på siden.. som hvis jeg for eksempel søger på google på dvd, ville det første link være:
DVDpriser.dk Din danske prisguide - DVDpriser.dk

Det er lidt ligesom det der er her:
http://planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=66496&lngWId=1

jeg kan ikke finde noget nogen steder som forklare hvordan man får forkortet/encoded eller sådan noget en url adresse.
der er en kode i det program der er link til lige ovenover
som er:

Kode

regex.Pattern = "<a title=\\x22[^>]*\\x22 href=([^>]*)>(.*?)</a>"

men det forstår jeg ingenting af.. :-(

25 svar postet i denne tråd vises herunder
1 indlæg har modtaget i alt 4 karma

Sorter efter stemmer Sorter efter dato

Bruger #8913 @ 26.11.06 20:43

Prøv at studere de forskellige VB funktioner, måske du kunne lære noget

Først definere du 3 nye globale variable øverst i projektet:

Kode

Dim SearchURL As String
Dim StartSide As Integer
Dim HitsPrSide As Integer

Dernæst 3 nye funktioner:
NewSearch: Kaldes med søgetekst og antal hits pr. side. den returnere Googles søge URL.
SearchNext: Kaldes og returnere Googles søge URL.
SearchPrevius: Kaldes og returnere Googles søge URL.
HUSK at i din søge tekstbox skal du nu ikke skrive hele URL'en men kun det søgeord du er interessere i.

Kode

Private Function NewSearch(Search As String, Optional Hits As Integer = 10) As String
SearchURL = "http://www.google.dk/search?q=¤&num=¤&hl=da&lr=&as_qdr=all&sa=N"
SearchURL = Replace(SearchURL, "?q=¤", "?q=" & Replace(Search, " ", "+"))
SearchURL = Replace(SearchURL, "&num=¤", "&num=" & CStr(Hits))
NewSearch = SearchURL & "&start=0"
HitsPrSide = Hits

End Function

Private Function SearchNext() As String
StartSide = StartSide + HitsPrSide
SearchNext = SearchURL & "&start=" & CStr(StartSide)

End Function

Private Function SearchPrevius() As String
StartSide = StartSide - HitsPrSide
If StartSide < 0 Then StartSide = 0
SearchPrevius = SearchURL & "&start=" & CStr(StartSide)

End Function

Så har du dine 3 knapper:
Command1: Søg
Command2: Næste
Command3: Forrige

Koden til de 3 knapper ser således ud:

Kode


Private Sub Command1_Click()
Dim Text As String

GetHTTPSource NewSearch(Text1.Text, 10), Text
ParseText Text

End Sub

Private Sub Command2_Click()
Dim Text As String

GetHTTPSource SearchNext, Text
ParseText Text

End Sub

Private Sub Command3_Click()
Dim Text As String

GetHTTPSource SearchPrevius, Text
ParseText Text

End Sub

Bruger #8913 @ 24.11.06 11:55

Jeg har lavet en test hvor jeg søger efter "hej" på google. Lav en form men følgende:
Knap: Command1 (Søge knap)
Tekstboks: Text1 (URL adressen)
Tekstboks: Text2 (Resultat) Husk at sætte Multiline=True
I menuen Project > References, marker udfor Microsoft XML v2.6

Indsæt URL adressen i tekstboks1 og tryk på Command1.
Feks: "http://www.google.dk/search?hl=da&q=hej&meta="
Se resultatet i tekstboks2. Nu må du så parse denne tekst og vise det indhold du syntes er interessant i en listboks.

Kode

Private Function GetHTTPSource(ByVal URL As String, Text As String) As Long
Dim objHTTP  As New XMLHTTP

objHTTP.open "GET", URL, False
objHTTP.send

If (objHTTP.Status = "200") Then
    Text = objHTTP.responseText
    GetHTTPSource = 0
    
Else
    GetHTTPSource = 1
End If

Set objHTTP = Nothing

End Function

Private Sub Command1_Click()
Dim Text As String

GetHTTPSource Text1.Text, Text
Text2.Text = Text

End Sub

Bruger #8719 @ 24.11.06 14:56

Hmm det virker fint nok, hvordan får man så fjernet alle de tags der nu kommer frem så det bliver til for eksempel det første der kommer frem når man søger på google på hej som er
"Tju Hej - Sikker Leg"

Altså hvordan får jeg lige fjernet alt det tekst jeg ikk skal bruge.. der kommer jo rigtig mange linier frem med tekst som dette:

<html><head><meta http-equiv="content-type" content="text/html; charset=UTF-8"><title>hej - Google-søgning</title><style><!--
div,td{color:#000}
.f{color:#6f6f6f}
.flc,.fl:link{color:#77c}
a:link,.w,a.w:link,.w a:link,.q:visited,.q:link,.q:active,.q{color:#00c}

Bruger #8913 @ 24.11.06 19:59

Som jeg skrev, skulle du jo parse dit resultat. Det der ud som om at hvert google link starter med "<a class=l href="
Så vi må lave et loop som søger efter dette, og pille http adressen ud og putte den i listboksen.
Brug eksemplet fra før og add en listboks til din form:
Listboks: List1.
Brug følgende subrutine og kald den med resultatet.. og vupti.

Kode

Private Sub ParseText(Text As String)
Dim Tmp As Variant
Dim Pos As Long
Dim X1 As Integer

Tmp = Split(Text, "<a class=l href=")
For X1 = 1 To UBound(Tmp)
    Pos = InStr(2, Tmp(X1), Chr(34))
    If Pos > 0 Then
        List1.AddItem Mid(Tmp(X1), 2, Pos - 2)
    End If
Next X1

End Sub

Bruger #8719 @ 25.11.06 15:27

Som jeg skrev, skulle du jo parse dit resultat. Det der ud som om at hvert google link starter med "<a class=l href="
Så vi må lave et loop som søger efter dette, og pille http adressen ud og putte den i listboksen.
Brug eksemplet fra før og add en listboks til din form:
Listboks: List1.
Brug følgende subrutine og kald den med resultatet.. og vupti.
Kode
Private Sub ParseText(Text As String)
Dim Tmp As Variant
Dim Pos As Long
Dim X1 As Integer

Tmp = Split(Text, "<a class=l href=")
For X1 = 1 To UBound(Tmp)
    Pos = InStr(2, Tmp(X1), Chr(34))
    If Pos > 0 Then
        List1.AddItem Mid(Tmp(X1), 2, Pos - 2)
    End If
Next X1

End Sub

Hmm hvordan kalder du resultatet.. er kun nybegynder.. hehe.. har prøvet i et par timer nu men kan ikke lige regne det ud selv.. det må du undskylde.. heh.. og tak for hjælpen

Bruger #8913 @ 25.11.06 16:26

Ser du, i det første eksempel har du din knap: Command1_Click, Her kalder du GetHPPPSource med søgekriteriet i Text1.Text, og resultatet ´returneres i variablen Text. Bagefter viser du resultatet (indholdet af variablen Text) i tekstboks2 (Altså Text2.Text = Text)

Kode

Private Sub Command1_Click()
Dim Text As String

GetHTTPSource Text1.Text, Text
Text2.Text = Text

End Sub

Igår skrev jeg en routine som ja, du bare skulle kalde med resultatet fra GetHTTPSource. Så istedet for at vise resultatet i Tekstboks2 kalder du bare den nye routine med variablen Text. Din Command1_Click kunne derfor se således ud:

Kode

Private Sub Command1_Click()
Dim Text As String

GetHTTPSource Text1.Text, Text
ParseText Text

End Sub

Bruger #8719 @ 25.11.06 16:38

Når på den måde.. hehe.. det var slet ikke så svært at forstå.. tak for hjælpen.. gir dig lige 100 points.. :-)

Bruger #8719 @ 25.11.06 18:00

hvordan får man flere resultater end kun højest 10...?

Til andre der læser med i denne tråd og vil prøve sig frem, vil jeg lige tilføje nogle ting i måske kan bruge:

Du skal bruge 4 knapper, 1 TekstBox, 1 ListBox og 1 CommonDialog.

I menuen Project > References, marker udfor Microsoft XML v2.6

Knappernes caption:

Command1 = Søg
Command2 = Ryd
Command3 = Fjern valgte
Command4 = Gem

Kode til søg knappen:

Kode

Private Sub Command1_Click()
Dim Text As String
GetHTTPSource ("http://www.google.com/search?q=" & Text1.Text), Text
ParseText Text
End Sub

Kode til ryd knappen:

Kode

Private Sub Command2_Click()
List1.Clear
End Sub

Kode til fjern valgte knappen:

Kode

Private Sub Command3_Click()
Dim a As Integer
For a = 0 To List1.ListCount - 1
recheck:
 If a > List1.ListCount - 1 Then Exit Sub
    If List1.Selected(a) = True Then
        List1.RemoveItem (a)
        GoTo recheck
    End If
Next a
End Sub

Kode til gem knappen:

Kode

Private Sub Command4_Click()
CommonDialog1.InitDir = AppPath
CommonDialog1.ShowSave
If CommonDialog1.FileName & "" = "" Then
    MsgBox "Du mangler at skrive et navn til filen", vbOKOnly, "Fejl"
Else
 Close #1
    Open CommonDialog1.FileName For Append As #1
    For a = 0 To List1.ListCount
      Print #1, List1.List(a)
    Next a
    Close #1
    MsgBox "Fil gemt til " & CommonDialog1.FileName, vbOKOnly, "Færdig"
End If
End Sub

Koden til at parse teksten:

Kode

Private Sub ParseText(Text As String)
Dim Tmp As Variant
Dim Pos As Long
Dim X1 As Integer

Tmp = Split(Text, "<a class=l href=")
For X1 = 1 To UBound(Tmp)
    Pos = InStr(2, Tmp(X1), Chr(34))
    If Pos > 0 Then
        List1.AddItem Mid(Tmp(X1), 2, Pos - 2)
    End If
Next X1

End Sub

Koden til GetHTTPSource:

Kode

Private Function GetHTTPSource(ByVal URL As String, Text As String) As Long
Dim objHTTP  As New XMLHTTP

objHTTP.open "GET", URL, False
objHTTP.send

If (objHTTP.Status = "200") Then
    Text = objHTTP.responseText
    GetHTTPSource = 0
    
Else
    GetHTTPSource = 1
End If

Set objHTTP = Nothing

End Function

Kode til når man klikker på et link i listboxen:

Kode

Private Sub List1_Click()
ShellExecute List1.hwnd, vbNullString, List1.Text, vbNullString, "C:\\", SW_SHOWNORMAL
End Sub

Declarations:

Kode

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Indlæg senest redigeret d. 25.11.2006 18:26 af Bruger #8719

Bruger #8913 @ 26.11.06 09:30

Prøv selv at gå ind på Google og leg lidt med det. Men prøv at gætte hvormange "hej" hits den finder med denne URL:
"http://www.google.dk/search?num=40&hl=da&as_qdr=all&q=hej&meta="

Bruger #8719 @ 26.11.06 15:05

Hmm det kan jeg ikke lige regne ud.. har prøvet at ændre på de tal i koden men så virker skidtet ikk..
og med den url finder den jo:
Søgeresultaterne 1 - 40 ud af ca. 36.700.000 for hej. (0,07 sekunder)

kan ikke se hvad det er der begrænser den til kun 10...?

<< < 1 2 3 > >>

Google søge resultater i listview

Karma barometer (30 dage)

Modtaget

Givet

Favorit hos
Forum tråde
Artikler