If InStr(1, Text, "Antwort", vbTextCompare) > 0 ThenTCP/IP Fehler
Error in OpenConnection::inet_Addr -Case unknown in TCPIP::SetLastErrorCode=0
tcp.LocalHostIP = LocalIPAddress()tcp.LocalHostIP = "192.168.178.2"Sub CbCtesten()
Dim TelNr As String
TelNr = "0123456789"
CbCBilligerTelefonieren TelNr
formCallbyCall.Show
End SubIf http.readyState = 4 Then HTTPTransfer = StrConv(http.responseBody, vbUnicode)Function LocalIPAddress() As String
[B]' Ermittelt die eigene IP Adresse, die für die Verbindung zur Fritzbox benutzt wird.
' Dazu werden alle verfügbaren Netzadapter auf das gleiche Subnetz zu dem der FritzBox verglichen,
' was momentan noch zu Problemen führt, wenn die FritzBox in einem anderen IP-Raum steht[/B]
On Error Resume Next
'für API-Aufrufe
Dim cbRequired As Long
Dim buff() As Byte
Dim Adapter As IP_ADAPTER_INFO
Dim AdapterStr As IP_ADDR_STRING
'allgemeine Variablen
Dim ptr1 As Long
Dim sIPAddr As String
Dim sAllAddr As String
Dim sGWAddr As String
Dim FB_ADD As String
Dim pos As Long
Dim DateiPfad As String
DateiPfad = GetSetting("FritzBox", "Optionen", "TBini", StandardPfad & "\Einstellungen.ini")
FB_ADD = GetINI(DateiPfad, "Optionen", "TBFBAdr", "192.168.178.1")
[B]
' Ggf. die Adresse der Gegenstelle auflösen[/B]
Ping FB_ADD
pos = InStrRev(FB_ADD, ".", , vbTextCompare)
FB_ADD = Left(FB_ADD, pos)
GetAdaptersInfo ByVal 0&, cbRequired
If cbRequired > 0 Then
ReDim buff(0 To cbRequired - 1) As Byte
If GetAdaptersInfo(buff(0), cbRequired) = 0 Then
'Zeiger (Pointer) zu den gespeicherten Daten (buff) ermitteln
ptr1 = VarPtr(buff(0))
'ptr1 ist 0 wenn keine weiteren Adapter vorhanden sind
Do While Not ptr1 = 0
'aktuellen Zeiger auf Datenstruktur (Adapter) zuweisen
CopyMemory Adapter, ByVal ptr1, LenB(Adapter)
With Adapter
'IP-Adresse des Adapters auslesen
sIPAddr = TrimNull(StrConv(.IpAddressList.ipaddress.ipAddr, vbUnicode))
' IP-Adresse des zugehörigen Gateways auslesen
sGWAddr = TrimNull(StrConv(.GatewayList.ipaddress.ipAddr, vbUnicode))
If Not InStr(1, sGWAddr, FB_ADD, vbTextCompare) = 0 _
Or Not InStr(1, sIPAddr, FB_ADD, vbTextCompare) = 0 Then
LocalIPAddress = sIPAddr
End If
'[B]Pointer [/B]auf nächsten Adapter setzen
ptr1 = .dwNext
End With
Loop
End If
End If
End FunctionPrivate Sub ButtonWeiter_Click()
' Fenster schließen und Wählbox starten
Dim DateiPfad As String
Dim TelNr As String
DateiPfad = GetSetting("FritzBox", "Optionen", "TBini", StandardPfad & "\Einstellungen.ini")
TelNr = nurZiffern(Me.TelNrBox.Value, "")
[B]If Not Len(TelNr) = 0 Then[/B]
FritzBox.Wählbox "-1;", "-1", TelNr
Unload Me
End If
End Sub
Private Sub TelNrBox_Change()
' Sicherheit, damit keine leere Nummer übergeben wird
[B]If Not Len(nurZiffern(Me.TelNrBox.Value, "")) = 0 Then[/B]
Me.ButtonWeiter.Enabled = True
Else
Me.ButtonWeiter.Enabled = False
End If
End Sub If Meldung("[B]Möchten [/B]Sie die Anrufliste auswerten?", vbYesNo) = vbYes Then If Not InStr(1, Text, "Anmeldung", vbTextCompare) = 0 Then
FBLogin = False
LogFile "Einloggen in die Fritz!Box war nicht erfolgreich."
[B]Meldung "Überprüfen Sie das Passwort der Fritz!Box in den Einstellungen!", vbCritical[/B]
ElseIf Text = "" Then
FBLogin = False
LogFile "Keine Fritz!Box gefunden."
Meldung "Es wurde keine Fritz!Box gefunden.", vbCritical
Else
WriteINI DateiPfad, "Optionen", "EinloggZeit", Date + Time
LogFile "Erfolgreich in die Fritz!Box eingeloggt."
FBLogin = True
End IfIf Meldung("Das Passwort der " & tempZugang & " kann nicht entschlüsselt werden. Es muss zurückgesetzt werden.[B]" & vbNewLine & "Geben Sie es in den Einstellungen neu ein." & vbNewLine & vbNewLine & "[/B]Soll es jetzt zurückgesetzt werden?", vbYesNo) = vbYes ThenFunction Meldung(ByVal Text As String, Typ As VbMsgBoxStyle[B], Optional Zusatzüberschrift As String[/B]) As VbMsgBoxResult
' Diese Funktion ist nur hinzugefügt worden, damit alle Fehlermeldungen gleich aussehen
Dim Überschrift As String
Überschrift = "Fritz!Box Dingsbums"
Select Case Typ
Case vbCritical
Überschrift = Überschrift + " - Ein Fehler ist aufgetreten!"
Case vbExclamation
Überschrift = Überschrift + " - Achtung!"
Case vbInformation
Überschrift = Überschrift + " - Information"
Case vbYesNo
Überschrift = Überschrift + " - Frage"
End Select
[B] If Len(Zusatzüberschrift) > 0 Then
Überschrift = Überschrift + ": " + Zusatzüberschrift
End If[/B]
Meldung = MsgBox(Text, Typ, Überschrift)
End Function If Meldung("Es gibt eine neue Version des Fritz!Box Telefon-dingsbums vom " & Mid(Text, pos + 1, 10) & "." & _
vbNewLine & "Ihre Version: " & aktVersion & vbNewLine & "Neue Version: " & neuVersion & vbNewLine & "Bitte die readme.txt beachten!" & _
vbNewLine & vbNewLine & "Möchten Sie die neue Version jetzt herunterladen?", vbYesNo[B], "Neue Version gefunden!"[/B]) = vbYes Then
formConfig.Herunterladen neuVersion
End IfPublic Function Crypt(Inp As String, Key As String, Mode As Boolean) As String
[B] If Len(Key) > 0 Then[/B]
Dim z As String
Dim i As Integer, Position As Integer
Dim cptZahl As Long, orgZahl As Long
Dim keyZahl As Long, cptString As String
For i = 1 To Len(Inp)
Position = Position + 1
If Position > Len(Key) Then Position = 1
keyZahl = Asc(Mid(Key, Position, 1))
If Mode Then
'Verschlüsseln
orgZahl = Asc(Mid(Inp, i, 1))
cptZahl = orgZahl Xor keyZahl
cptString = Hex(cptZahl)
If Len(cptString) < 2 Then cptString = "0" & cptString
z = z & cptString
Else
'Entschlüsseln
If i > Len(Inp) \ 2 Then Exit For
cptZahl = CByte("&H" & Mid$(Inp, i * 2 - 1, 2))
orgZahl = cptZahl Xor keyZahl
z = z & Chr$(orgZahl)
End If
Next i
Crypt = z
[B] Else
Crypt = ""
End If
End Function[/B] 'Festnetznummer ermitteln
pos1 = InStr(1, Text, "telcfg:settings/MSN/POTS", vbTextCompare)
pos2 = [B]InStr[/B](pos1, Text, "value='", vbTextCompare) + 7
pos3 = InStr(pos2, Text, "' id", vbTextCompare)
TelNr = Mid(Text, pos2, pos3 - pos2)Im Prinzip ist es egal.
Das ist möglich. Aber die If-Abfrage brauchst du nicht. Wenn du in Zusatzüberschrift nichts reichschreibst ist es eh ein "Leer"-string
Ich hatte es so eingebaut, damit man bei Eingabe eines nicht gewählten Zeichens nicht den wählen-Button bekommt. Das Wählen kann in diesem Fall ja auch nicht klappen. So spart man sich aber auch jede Abfrage beim Klick auf wählen, also neuer Vorschlag (benötigt man den entfernten Dateipfad hier?)
Private Sub ButtonWeiter_Click()
' Fenster schließen und Wählbox starten
' Die Telefonnnumer wird bereits bei der Eingabe geprüft, daher hier nicht notwendig
FritzBox.Wählbox "-1;", "-1", nurZiffern(Me.TelNrBox.Value, "")
Unload Me
End Sub
Private Sub TelNrBox_Change()
' Sicherheit, damit keine leere Nummer übergeben wird
If Not Len(nurZiffern(Me.TelNrBox.Value, "")) = 0 Then
Me.ButtonWeiter.Enabled = True
Else
Me.ButtonWeiter.Enabled = False
End If
End SubDas ist ja gerade der Sinn der Abfrage: wenn die Zusatzüberschrift nicht leer ist wird nämlich auch ": " zwischen Überschrift und Zusatzüberschrift geschrieben.
Klingt gut. Hatte übrigens heute auch mitten beim Arbeiten am PC den o.g. Fehler bekommen. Angerufen hat mich da keiner, ich auch niemanden und Outlook war minimiert. Seltsam.
