Rückwärtssuche "Das Örtliche"
Hallo,
wer, wie gewohnt die Rückwärtssuche von DasÖrtliche.de benutzen möchte, braucht nur folgenden Code in das Formular Winsock kopieren und die alte Funktion löschen:
Danke erst einmal für Ford Prefect, der sehr sehr fleißig mit an der Entwicklung des Scriptes beteiligt ist.
@Ford Prefect:
Das mit der Uhrzeit des Anrufes war wirklich eine Dummheit von mir und natürlich macht es erst jetzt richtig sinn...
Danke auch für GoYellow. Ich habe es noch nicht ausprobiert, werde es aber demnächst mit einbauen...
@all:
Habe den Fehler von Yannick gefunden. Ich werde demnächst eine neue Version veröffentlichen. Ich denke, es wird Anfang nächster Woche werden. Dort sind dann alle Bugfixes mit enthalten...
Gruß
MarcoMarco
Hallo,
wer, wie gewohnt die Rückwärtssuche von DasÖrtliche.de benutzen möchte, braucht nur folgenden Code in das Formular Winsock kopieren und die alte Funktion löschen:
Code:
Function RueckwaertssucheDasOertliche(ByVal Ruf_NR As String)
Dim myurl, Anrufer, Adresse As String
Dim oIE As Variant
Dim Oertliche_HTML As String
If Left(Ruf_NR, 2) = "49" Then Ruf_NR = "0" & Right(Ruf_NR, Len(Ruf_NR) - 2)
If Left(Ruf_NR, 3) = "+49" Then Ruf_NR = "0" & Right(Ruf_NR, Len(Ruf_NR) - 3)
myurl = "http://www2.dasoertliche.de/?form_name=search_inv&page=RUECKSUCHE&context=RUECKSUCHE&action=STANDARDSUCHE&la=de&rci=no&ph=" & Ruf_NR
On Error GoTo KeineRuecksuche
Set oIE = CreateObject("InternetExplorer.Application")
oIE.Navigate myurl
Sleep 300 'Dreihundert Millisekunden
While Not oIE.ReadyState = 4
DoEvents 'Gibt Kontrolle für neues Scheduling an MS Windows zurück
Sleep 100 'Hundert Millisekunden warten
Wend
Oertliche_HTML = oIE.document.Body.InnerHtml
Dim Pos As Long, Pos2 As Long
Dim strTemp1 As String, strTemp2 As String
Pos = InStr(1, Oertliche_HTML, "</A> <SPAN style=", vbTextCompare)
Anrufer = Left(Oertliche_HTML, Pos - 1)
Oertliche_HTML = Right(Oertliche_HTML, Len(Oertliche_HTML) - Pos)
Pos = InStr(1, Oertliche_HTML, "<BR><INPUT type=hidden", vbTextCompare)
Adresse = Left(Oertliche_HTML, Pos - 1)
Oertliche_HTML = Right(Oertliche_HTML, Len(Oertliche_HTML) - Pos)
Pos = 1
Do While Pos <> 0
Pos = 1
Pos = InStr(Pos, Anrufer, ">", vbTextCompare)
Anrufer = Right(Anrufer, Len(Anrufer) - Pos)
Loop
Pos = 1
Do While Pos <> 0
Pos = 1
Pos = InStr(Pos, Adresse, ">", vbTextCompare)
Adresse = Right(Adresse, Len(Adresse) - Pos)
Loop
' Oertliche_HTML-Tags entfernen
Oertliche_HTML = Replace$(Oertliche_HTML, "<.*?>", "", , , vbTextCompare)
Adresse = Replace$(Adresse, " ", " ", , , vbTextCompare)
RueckwaertssucheDasOertliche = Anrufer & " " & Adresse
Exit Function
KeineRuecksuche:
RueckwaertssucheDasOertliche = "Unbekannter Teilnehmer"
End FunctionDanke erst einmal für Ford Prefect, der sehr sehr fleißig mit an der Entwicklung des Scriptes beteiligt ist.
@Ford Prefect:
Das mit der Uhrzeit des Anrufes war wirklich eine Dummheit von mir und natürlich macht es erst jetzt richtig sinn...
Danke auch für GoYellow. Ich habe es noch nicht ausprobiert, werde es aber demnächst mit einbauen...
@all:
Habe den Fehler von Yannick gefunden. Ich werde demnächst eine neue Version veröffentlichen. Ich denke, es wird Anfang nächster Woche werden. Dort sind dann alle Bugfixes mit enthalten...
Gruß
MarcoMarco
Zuletzt bearbeitet:
