Hier eine Idee für Callback ohne Mod (ich weiß nicht ob das schon mal diskutiert wurde).
Ich habe einen Heimserver wo sowiso der PowerISDNMonitor (PIM) drauf läuft (damit kann man z.B. auch Name+Nummer auf der DBox anzeigen lassen). Es hat auch ein Plugin, was ein externes Programm mit Parametern starten kann.
Das Ganze funktioniert so:
Ich habe einen Heimserver wo sowiso der PowerISDNMonitor (PIM) drauf läuft (damit kann man z.B. auch Name+Nummer auf der DBox anzeigen lassen). Es hat auch ein Plugin, was ein externes Programm mit Parametern starten kann.
Das Ganze funktioniert so:
- Ich kenne die Nummern die zurückgerufen werden dürfen.
- Ich rufe eine MSN an, die ich sonst nirgendswofür brauche und lege wieder auf.
- PIM erkennt das ich auf dieser MSN anrufe und startet mein Programm mit der Rufnummer als Parameter
- Mein Programm erkennt das es eine Nummer ist die zurückgerufen werden darf, ruft an und beendet sich dann
Code:
Modul code:
-----------
Public Const FBOX_PASSWORD = "dasPasswort"
' Die eigne internationale Landesvorwahl
Public Const EIGENE_LANDESVORWAHL = "0049"
' Wird eine Ziffer zur Amtsholung (z.B. "0") benötigt?
Public Const AMTSHOLUNGSZIFFER = ""
Programm Code:
--------------
Function dialNumber(number As String, clir As Boolean, festnetz As Boolean, fonanschluss As Integer) As String
Dim code As String
Dim i As Integer
Dim c As String
code = ""
' Nur gültige Zeichen in der Nummer erlauben!
For i = 1 To Len(number)
c = Mid(number, i, 1)
If c >= "0" And c <= "9" Then code = code + c
If c = "*" Or c = "#" Then code = code + c
If c = "A" Or c = "T" Or c = "H" Then code = code + c
If c = "+" Then code = code + "00"
Next
' Entfernen der internationalen Vorwahl, wenn die eigene
' Landesvorwahl gewählt wird (das Wählen von 0049 aus dem
' Festnetz der deutschen T-Com verursacht z.B. Probleme)
code = Replace(code, EIGENE_LANDESVORWAHL, "0", 1, 5)
' Amtsholungsziffer voranstellen
code = AMTSHOLUNGSZIFFER & code
If clir Then code = "*31#" & code
If festnetz Then code = "*11#" & code
' Sagt der FB dass die Nummer jetzt zuende ist
code = code & "#"
' Jetzt dialCode an Box senden
dialNumber = sendRequestToBox(code, fonanschluss)
End Function
Function sendRequestToBox(dialCode As String, fonanschluss As Integer) As String
Dim http As New WinHttpRequest
Dim FormData
Dim WinHTTPPostRequest
Dim ResponseInfo As String
'Open URL As POST request
http.Open "POST", "http://fritz.box/cgi-bin/webcm", False
'Set Content-Type header
http.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
'############################################################################
' Formulardaten für Login erzeugen
'
' Wichtig: Erst POST senden um einzuloggen, dann ein weiteres POST
' um die Nummer zu wählen.
' Bei der Fritzbox kann scheinbar innerhalb eines Zeitfensters
' von ca. 10-15 min ein telcfg:command/Dial abgesetzt werden,
' ohne ein login:command/password zu übergeben. Es reicht aus,
' wenn innerhalb der letzten 10-15 min ein login:command/password
' erfolgt ist.
' Wird nun versucht beides innerhalb eines POSTs durchzuführen
' (also einloggen und wählen), und wurde innerhalb der letzten
' 10-15 min noch kein login:command/password aufgerufen, so ist
' lediglich der Login erfolgreich, der Anruf wird aber NICHT
' ausgeführt.
'############################################################################
FormData = URLEncoder("getpage") & "=" & URLEncoder("../html/de/menus/menu2.html") & _
"&" & URLEncoder("login:command/password") & "=" & URLEncoder(FBOX_PASSWORD)
'Send the form data To URL
On Error GoTo catch ' Fehler abfangen
http.Send FormData
On Error GoTo 0 ' Fehler nicht mehr abfangen
'##########################################################################
' Formulardaten erzeugen um Nummer zu wählen
'##########################################################################
FormData = URLEncoder("getpage") & "=" & URLEncoder("../html/de/menus/menu2.html") & _
"&" & URLEncoder("telcfg:settings/DialPort") & "=" & URLEncoder(fonanschluss) & _
"&" & URLEncoder("telcfg:command/Dial") & "=" & URLEncoder(dialCode)
' Formulardaten senden
On Error GoTo catch ' Fehler abfangen
http.Send FormData
On Error GoTo 0 ' Fehler nicht mehr abfangen
' Antwort empfangen
WinHTTPPostRequest = http.responseText
' Antwort auswerten
If (Len(WinHTTPPostRequest) > 0) Then
' Wenn der String "FRITZ!Box Anmeldung" im Reponse enthalten ist, ist etwas schief gelaufen.
' Dann kommt die Fritz Box-Anmeldeseite, wo sich der Benutzer anmelden muss
If (InStr(WinHTTPPostRequest, "FRITZ!Box Anmeldung") <> 0) Then
' Wahrscheinlich falsches Passwort
ResponseInfo = "Fehler!" & vbNewLine & "Evtl. Passwort falsch?"
Else
If dialCode = "ATH" Then
ResponseInfo = "Verbindungsaufbau" & vbNewLine & "wurde abgebrochen!"
Else
ResponseInfo = "Wähle " & dialCode & vbNewLine & "Jetzt abheben!"
End If
End If
End If
' Fertig
GoTo finally
catch:
ResponseInfo = vbNewLine & "Fehler bei HTTP/Post"
If Err.number = -2147012889 Then
' MsgBox "Fritz!Box konnte nicht gefunden werden. Ist die Netzwerkverbindung OK?", vbCritical, "Fehler"
Else
' MsgBox "Fehler: " & Err.Description, vbCritical, "Fehler"
End If
finally:
' Fenster schließen
'formSelTel.Hide
sendRequestToBox = ResponseInfo
End
End Function
Public Function URLEncoder(strText)
' Codiert die in einer URL nicht zugelassenen Zeichen.
Dim lngPlace
Dim strBuffer
Dim strCharacter
Dim Buffer
Do While lngPlace < Len(strText)
lngPlace = lngPlace + 1
strCharacter = Mid(strText, lngPlace, 1)
Select Case strCharacter
Case " "
Buffer = Buffer & "+"
Case "~"
Buffer = Buffer & "%7E"
Case "!"
Buffer = Buffer & "%21"
Case "#"
Buffer = Buffer & "%23"
Case "$"
Buffer = Buffer & "%24"
Case "%"
Buffer = Buffer & "%25"
Case "^"
Buffer = Buffer & "%5E"
Case "&"
Buffer = Buffer & "%26"
Case "("
Buffer = Buffer & "%28"
Case ")"
Buffer = Buffer & "%29"
Case "+"
Buffer = Buffer & "%2B"
Case "="
Buffer = Buffer & "%3D"
Case "["
Buffer = Buffer & "%5B"
Case "{"
Buffer = Buffer & "%7B"
Case "]"
Buffer = Buffer & "%5D"
Case "}"
Buffer = Buffer & "%7D"
Case "\"
Buffer = Buffer & "%5C"
Case "|"
Buffer = Buffer & "%7C"
Case "`"
Buffer = Buffer & "%60"
Case "'"
Buffer = Buffer & "%27"
Case ":"
Buffer = Buffer & "%3A"
Case ";"
Buffer = Buffer & "%3B"
Case "/"
Buffer = Buffer & "%2F"
Case "<"
Buffer = Buffer & "%3C"
Case ">"
Buffer = Buffer & "%3E"
Case "@"
Buffer = Buffer & "%40"
Case Chr(13)
Buffer = Buffer & "%0D"
Case Chr(10)
'ignore it
Case Else
Buffer = Buffer & strCharacter
End Select
Loop
URLEncoder = Buffer
End Function
Private Sub Form_Load()
If Command() = "+49 (171) 123456" Then a = dialNumber("0171123456", False, False, "52")
If Command() = "+49 (1234) 56789" Then a = dialNumber("0123456789", False, False, "52")
End Sub
Private Sub Timer1_Timer()
End
End Sub
