Fritzbox Telefonbuch go´s Cisco IP Phone [DONE]

zaphi1 · 18 Nov 2010

Hallo erstmal,

habe seit einiger zeit mein Cisco 7940 erfolgreich über SIP mit meiner Friztbox 7270 verbunden.
Jetzt würde ich gerne das Telefonbuch der Fritzbox an meinem 7940 nutzen.

Theorie:
Ich hole mir mittels VB-Script das Telefonbuch der fritzbox ab.
Autor: Michael Engelke www.mengelke.de

Code:

'fb_get_book.vbs (c) 2010 by Michael Engelke <http://www.mengelke.de>

On Error Resume Next

host = "fritz.box" '169.254.1.1
pass = "passwort"

Private Const BITS_TO_A_BYTE=8
Private Const BYTES_TO_A_WORD=4
Private Const BITS_TO_A_WORD=32
Private m_lOnBits(30)
Private m_l2Power(30)
m_lOnBits(0)=CLng(1)
m_lOnBits(1)=CLng(3)
m_lOnBits(2)=CLng(7)
m_lOnBits(3)=CLng(15)
m_lOnBits(4)=CLng(31)
m_lOnBits(5)=CLng(63)
m_lOnBits(6)=CLng(127)
m_lOnBits(7)=CLng(255)
m_lOnBits(8)=CLng(511)
m_lOnBits(9)=CLng(1023)
m_lOnBits(10)=CLng(2047)
m_lOnBits(11)=CLng(4095)
m_lOnBits(12)=CLng(8191)
m_lOnBits(13)=CLng(16383)
m_lOnBits(14)=CLng(32767)
m_lOnBits(15)=CLng(65535)
m_lOnBits(16)=CLng(131071)
m_lOnBits(17)=CLng(262143)
m_lOnBits(18)=CLng(524287)
m_lOnBits(19)=CLng(1048575)
m_lOnBits(20)=CLng(2097151)
m_lOnBits(21)=CLng(4194303)
m_lOnBits(22)=CLng(8388607)
m_lOnBits(23)=CLng(16777215)
m_lOnBits(24)=CLng(33554431)
m_lOnBits(25)=CLng(67108863)
m_lOnBits(26)=CLng(134217727)
m_lOnBits(27)=CLng(268435455)
m_lOnBits(28)=CLng(536870911)
m_lOnBits(29)=CLng(1073741823)
m_lOnBits(30)=CLng(2147483647)
m_l2Power(0)=CLng(1)
m_l2Power(1)=CLng(2)
m_l2Power(2)=CLng(4)
m_l2Power(3)=CLng(8)
m_l2Power(4)=CLng(16)
m_l2Power(5)=CLng(32)
m_l2Power(6)=CLng(64)
m_l2Power(7)=CLng(128)
m_l2Power(8)=CLng(256)
m_l2Power(9)=CLng(512)
m_l2Power(10)=CLng(1024)
m_l2Power(11)=CLng(2048)
m_l2Power(12)=CLng(4096)
m_l2Power(13)=CLng(8192)
m_l2Power(14)=CLng(16384)
m_l2Power(15)=CLng(32768)
m_l2Power(16)=CLng(65536)
m_l2Power(17)=CLng(131072)
m_l2Power(18)=CLng(262144)
m_l2Power(19)=CLng(524288)
m_l2Power(20)=CLng(1048576)
m_l2Power(21)=CLng(2097152)
m_l2Power(22)=CLng(4194304)
m_l2Power(23)=CLng(8388608)
m_l2Power(24)=CLng(16777216)
m_l2Power(25)=CLng(33554432)
m_l2Power(26)=CLng(67108864)
m_l2Power(27)=CLng(134217728)
m_l2Power(28)=CLng(268435456)
m_l2Power(29)=CLng(536870912)
m_l2Power(30)=CLng(1073741824)
Private Function LShift(lValue,iShiftBits)
 If iShiftBits=0 Then
  LShift=lValue
  Exit Function
 ElseIf iShiftBits=31 Then
  If lValue And 1 Then
   LShift=&H80000000
  Else
   LShift=0
  End If
  Exit Function
 ElseIf iShiftBits<0 Or iShiftBits>31 Then
  Err.Raise 6
 End If
 If(lValue And m_l2Power(31-iShiftBits))Then
  LShift=((lValue And m_lOnBits(31-(iShiftBits+1)))*m_l2Power(iShiftBits))Or &H80000000
 Else
  LShift=((lValue And m_lOnBits(31-iShiftBits))*m_l2Power(iShiftBits))
 End If
End Function
Private Function RShift(lValue,iShiftBits)
 If iShiftBits=0 Then
  RShift=lValue
  Exit Function
 ElseIf iShiftBits=31 Then
  If lValue And &H80000000 Then
   RShift=1
  Else
   RShift=0
  End If
  Exit Function
 ElseIf iShiftBits<0 Or iShiftBits>31 Then
  Err.Raise 6
 End If
 RShift=(lValue And &H7FFFFFFE)\m_l2Power(iShiftBits)
 If(lValue And &H80000000)Then
  RShift=(RShift Or(&H40000000\m_l2Power(iShiftBits-1)))
 End If
End Function
Private Function RotateLeft(lValue,iShiftBits)
 RotateLeft=LShift(lValue,iShiftBits)Or RShift(lValue,(32-iShiftBits))
End Function
Private Function AddUnsigned(lX,lY)
 Dim lX4
 Dim lY4
 Dim lX8
 Dim lY8
 Dim lResult
 lX8=lX And &H80000000
 lY8=lY And &H80000000
 lX4=lX And &H40000000
 lY4=lY And &H40000000
 lResult=(lX And &H3FFFFFFF)+(lY And &H3FFFFFFF)
 If lX4 And lY4 Then
  lResult=lResult Xor &H80000000 Xor lX8 Xor lY8
 ElseIf lX4 Or lY4 Then
  If lResult And &H40000000 Then
   lResult=lResult Xor &HC0000000 Xor lX8 Xor lY8
  Else
   lResult=lResult Xor &H40000000 Xor lX8 Xor lY8
  End If
 Else
  lResult=lResult Xor lX8 Xor lY8
 End If
 AddUnsigned=lResult
End Function
Private Function F(x,y,z)
 F=(x And y)Or((Not x)And z)
End Function
Private Function G(x,y,z)
 G=(x And z)Or(y And(Not z))
End Function
Private Function H(x,y,z)
 H=(x Xor y Xor z)
End Function
Private Function I(x,y,z)
 I=(y Xor(x Or(Not z)))
End Function
Private Sub FF(a,b,c,d,x,s,ac)
 a=AddUnsigned(a,AddUnsigned(AddUnsigned(F(b,c,d),x),ac))
 a=RotateLeft(a,s)
 a=AddUnsigned(a,b)
End Sub
Private Sub GG(a,b,c,d,x,s,ac)
 a=AddUnsigned(a,AddUnsigned(AddUnsigned(G(b,c,d),x),ac))
 a=RotateLeft(a,s)
 a=AddUnsigned(a,b)
End Sub
Private Sub HH(a,b,c,d,x,s,ac)
 a=AddUnsigned(a,AddUnsigned(AddUnsigned(H(b,c,d),x),ac))
 a=RotateLeft(a,s)
 a=AddUnsigned(a,b)
End Sub
Private Sub II(a,b,c,d,x,s,ac)
 a=AddUnsigned(a,AddUnsigned(AddUnsigned(I(b,c,d),x),ac))
 a=RotateLeft(a,s)
 a=AddUnsigned(a,b)
End Sub
Private Function ConvertToWordArray(sMessage)
 Dim lMessageLength
 Dim lNumberOfWords
 Dim lWordArray()
 Dim lBytePosition
 Dim lByteCount
 Dim lWordCount
 Const MODULUS_BITS=512
 Const CONGRUENT_BITS=448
 lMessageLength=Len(sMessage)
 lNumberOfWords=(((lMessageLength+((MODULUS_BITS-CONGRUENT_BITS)\BITS_TO_A_BYTE))\(MODULUS_BITS\BITS_TO_A_BYTE))+1)*(MODULUS_BITS\BITS_TO_A_WORD)
 ReDim lWordArray(lNumberOfWords-1)
 lBytePosition=0
 lByteCount=0
 Do Until lByteCount>=lMessageLength
  lWordCount=lByteCount\BYTES_TO_A_WORD
  lBytePosition=(lByteCount Mod BYTES_TO_A_WORD)*BITS_TO_A_BYTE
  lWordArray(lWordCount)=lWordArray(lWordCount)Or LShift(Asc(Mid(sMessage,lByteCount+1,1)),lBytePosition)
  lByteCount=lByteCount+1
 Loop
 lWordCount=lByteCount\BYTES_TO_A_WORD
 lBytePosition=(lByteCount Mod BYTES_TO_A_WORD)*BITS_TO_A_BYTE
 lWordArray(lWordCount)=lWordArray(lWordCount)Or LShift(&H80,lBytePosition)
 lWordArray(lNumberOfWords-2)=LShift(lMessageLength,3)
 lWordArray(lNumberOfWords-1)=RShift(lMessageLength,29)
 ConvertToWordArray=lWordArray
End Function
Private Function WordToHex(lValue)
 Dim lByte
 Dim lCount
 For lCount=0 To 3
  lByte=RShift(lValue,lCount*BITS_TO_A_BYTE)And m_lOnBits(BITS_TO_A_BYTE-1)
  WordToHex=WordToHex & Right("0" & Hex(lByte),2)
 Next
End Function
Public Function MD5(sMessage)
 Dim x
 Dim k
 Dim AA
 Dim BB
 Dim CC
 Dim DD
 Dim a
 Dim b
 Dim c
 Dim d
 Const S11=7
 Const S12=12
 Const S13=17
 Const S14=22
 Const S21=5
 Const S22=9
 Const S23=14
 Const S24=20
 Const S31=4
 Const S32=11
 Const S33=16
 Const S34=23
 Const S41=6
 Const S42=10
 Const S43=15
 Const S44=21
 x=ConvertToWordArray(sMessage)
 a=&H67452301
 b=&HEFCDAB89
 c=&H98BADCFE
 d=&H10325476
 For k=0 To UBound(x)Step 16
  AA=a
  BB=b
  CC=c
  DD=d
  FF a,b,c,d,x(k+0),S11,&HD76AA478
  FF d,a,b,c,x(k+1),S12,&HE8C7B756
  FF c,d,a,b,x(k+2),S13,&H242070DB
  FF b,c,d,a,x(k+3),S14,&HC1BDCEEE
  FF a,b,c,d,x(k+4),S11,&HF57C0FAF
  FF d,a,b,c,x(k+5),S12,&H4787C62A
  FF c,d,a,b,x(k+6),S13,&HA8304613
  FF b,c,d,a,x(k+7),S14,&HFD469501
  FF a,b,c,d,x(k+8),S11,&H698098D8
  FF d,a,b,c,x(k+9),S12,&H8B44F7AF
  FF c,d,a,b,x(k+10),S13,&HFFFF5BB1
  FF b,c,d,a,x(k+11),S14,&H895CD7BE
  FF a,b,c,d,x(k+12),S11,&H6B901122
  FF d,a,b,c,x(k+13),S12,&HFD987193
  FF c,d,a,b,x(k+14),S13,&HA679438E
  FF b,c,d,a,x(k+15),S14,&H49B40821
  GG a,b,c,d,x(k+1),S21,&HF61E2562
  GG d,a,b,c,x(k+6),S22,&HC040B340
  GG c,d,a,b,x(k+11),S23,&H265E5A51
  GG b,c,d,a,x(k+0),S24,&HE9B6C7AA
  GG a,b,c,d,x(k+5),S21,&HD62F105D
  GG d,a,b,c,x(k+10),S22,&H2441453
  GG c,d,a,b,x(k+15),S23,&HD8A1E681
  GG b,c,d,a,x(k+4),S24,&HE7D3FBC8
  GG a,b,c,d,x(k+9),S21,&H21E1CDE6
  GG d,a,b,c,x(k+14),S22,&HC33707D6
  GG c,d,a,b,x(k+3),S23,&HF4D50D87
  GG b,c,d,a,x(k+8),S24,&H455A14ED
  GG a,b,c,d,x(k+13),S21,&HA9E3E905
  GG d,a,b,c,x(k+2),S22,&HFCEFA3F8
  GG c,d,a,b,x(k+7),S23,&H676F02D9
  GG b,c,d,a,x(k+12),S24,&H8D2A4C8A
  HH a,b,c,d,x(k+5),S31,&HFFFA3942
  HH d,a,b,c,x(k+8),S32,&H8771F681
  HH c,d,a,b,x(k+11),S33,&H6D9D6122
  HH b,c,d,a,x(k+14),S34,&HFDE5380C
  HH a,b,c,d,x(k+1),S31,&HA4BEEA44
  HH d,a,b,c,x(k+4),S32,&H4BDECFA9
  HH c,d,a,b,x(k+7),S33,&HF6BB4B60
  HH b,c,d,a,x(k+10),S34,&HBEBFBC70
  HH a,b,c,d,x(k+13),S31,&H289B7EC6
  HH d,a,b,c,x(k+0),S32,&HEAA127FA
  HH c,d,a,b,x(k+3),S33,&HD4EF3085
  HH b,c,d,a,x(k+6),S34,&H4881D05
  HH a,b,c,d,x(k+9),S31,&HD9D4D039
  HH d,a,b,c,x(k+12),S32,&HE6DB99E5
  HH c,d,a,b,x(k+15),S33,&H1FA27CF8
  HH b,c,d,a,x(k+2),S34,&HC4AC5665
  II a,b,c,d,x(k+0),S41,&HF4292244
  II d,a,b,c,x(k+7),S42,&H432AFF97
  II c,d,a,b,x(k+14),S43,&HAB9423A7
  II b,c,d,a,x(k+5),S44,&HFC93A039
  II a,b,c,d,x(k+12),S41,&H655B59C3
  II d,a,b,c,x(k+3),S42,&H8F0CCC92
  II c,d,a,b,x(k+10),S43,&HFFEFF47D
  II b,c,d,a,x(k+1),S44,&H85845DD1
  II a,b,c,d,x(k+8),S41,&H6FA87E4F
  II d,a,b,c,x(k+15),S42,&HFE2CE6E0
  II c,d,a,b,x(k+6),S43,&HA3014314
  II b,c,d,a,x(k+13),S44,&H4E0811A1
  II a,b,c,d,x(k+4),S41,&HF7537E82
  II d,a,b,c,x(k+11),S42,&HBD3AF235
  II c,d,a,b,x(k+2),S43,&H2AD7D2BB
  II b,c,d,a,x(k+9),S44,&HEB86D391
  a=AddUnsigned(a,AA)
  b=AddUnsigned(b,BB)
  c=AddUnsigned(c,CC)
  d=AddUnsigned(d,DD)
 Next
 MD5=LCase(WordToHex(a)&WordToHex(b)&WordToHex(c)&WordToHex(d))
End Function
Public Function SendPost(http,page,host,post)
 With http
  .Open "POST", page,false
  .setRequestHeader "HOST", host
  .setRequestHeader "Connection", "Keep-Alive"
  .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
  .setRequestHeader "Content-Length", Len(post)
  .Send post
 End With
 SendPost = http.responseText
End Function

sid = ""
sep = ";"
quot = """"
name = "fonbook"
page = "http://" & host & "/cgi-bin/webcm"
auth = "login:command/password=" & pass
menu = "getpage=../html/de/menus/menu2.html&var:lang=de"
login = "getpage=../html/login_sid.xml"
config = "/cgi-bin/firmwarecfg"
getbook = menu & "&var:pagename=newfonbuch&var:menu=home"
selbook = "telcfg:settings/Phonebook/Books/Select="
fonbook = "&var:pagename=fonbuch&var:menu=fon"
pattern = "Phonebook/Books/\w+(\d+).*?value=""(.*?)"""
csvpatn = "(Name\(""([^""]*)"",\s""([^""]*)"",\s""([^""]*)""(?:,\s""([^""]*)"")?\)|Nr\(""([^""]*)"",\s""([^""]*)"",\s""([^""]*)"",\s""([^""]*)""\))"
csvpato = """([^""]*)"",\s*""(!?)([^""]*)"",\s*""([^""]*)"",\s*""([^""]*)"",\s*""([^""]*)"""
csvhead = "sep=" & sep & vbcrlf & quot & "nr" & quot & sep & quot & "name" & quot & sep & quot & "wichtig" & quot _
     & sep & quot & "bild" & quot & sep & quot & "typ" & quot & sep & quot & "nummer" & quot _
     & sep & quot & "kurzwahl" & quot & sep & quot & "vanity" & quot & vbcrlf
Set http = Nothing
Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
If http Is Nothing Then Set http = CreateObject("WinHttp.WinHttpRequest.5")
If http Is Nothing Then Set http = CreateObject("WinHttp.WinHttpRequest")
If http Is Nothing Then Set http = CreateObject("MSXML2.ServerXMLHTTP")
If http Is Nothing Then Set http = CreateObject("Microsoft.XMLHTTP")
If http Is Nothing Then
 MsgBox "Kein HTTP-Objekt verfügbar!",16,"Fehler:"
Else
 On Error Goto 0
 http.Open "GET", page & "?" & login,false
 http.Send
 first = InStr(http.responseText, "<Challenge>") + Len("<Challenge>")
 last = InStr(http.responseText, "</Challenge>")
 If last > 0 Then
  auth = Mid(http.responseText, first, last - first)
  code = ""
  pass = auth & "-" & pass
  For a = 1 To Len(Pass)
   code = code & Mid(Pass, a, 1) & chr(0)
  Next
  auth = "login:command/response=" & auth & "-" & md5(code) & "&" & login
 End If
 text = SendPost(http,page,host,auth)
 first = InStr(text, "<SID>") + Len("<SID>")
 last = InStr(text, "</SID>")
 If last > 0 Then
  If Mid(text, first, last - first) <> "0000000000000000" Then
   id = Mid(text, first, last - first)
   sid = "&sid=" & id
  End If
 End If
 a = 0
 b = 0
 c = 0
 max = 1
 http.Open "GET", page & "?" & getbook & sid,false
 http.Send post
 If Len(http.responseText) > 0 Then
  Set re = new regexp
  With re
   .Pattern = pattern
   .IgnoreCase = True
   .Global = True
   Set book = .Execute(http.responseText)
  End With
 End If
 While a < max
  If book.count > 0 Then
   max = book.count/2
   Set row = book(a*2)
   name = row.SubMatches(1)
   Set row = book(a*2+1)
   b = row.SubMatches(1)
  End If
  post = selbook & b & "&" & menu & fonbook & sid
  text = SendPost(http,page,host,post)
  If Len(text) > 0 Then
   csv = ""
   row = ""
   Set re = new regexp
   trfon = Split(text,">TrFon")
   For Each line In trfon
    With re
     .Pattern = csvpatn
     .IgnoreCase = True
     .Global = True
     Set Matches = .Execute(line)
    End With
    For Each Match in Matches
     If Match.SubMatches(1) <> "" Then
      row = quot & Match.SubMatches(1) & quot & sep & quot & Match.SubMatches(2) & quot & sep _
       & quot & Match.SubMatches(3) & quot & sep & quot & Match.SubMatches(4) & quot & sep
     Else
      If Match.SubMatches(6) <> "" or Match.SubMatches(7) <> "" or Match.SubMatches(8) <> "" Then 
       csv = csv & row & quot & Match.SubMatches(5) & quot & sep & quot & Match.SubMatches(6) & quot & sep _
        & quot & Match.SubMatches(7) & quot & sep & quot & Match.SubMatches(8) & quot & vbcrlf
      End If
     End If
    Next
   Next
   If csv = "" Then
    trfon = Split(text,"(TrFon(")
    For Each line In trfon
     With re
      .Pattern = csvpato
      .IgnoreCase = True
      .Global = True
      Set Matches = .Execute(line)
     End With
     For Each Match in Matches
      csv = csv & quot & Match.SubMatches(0) & quot & sep & quot & Match.SubMatches(2) & quot & sep _
       & quot & Replace(Match.SubMatches(1),"!","1") & quot & sep & quot & quot & sep & quot & "home" & quot & sep & quot & Match.SubMatches(3) & quot & sep _
       & quot & Match.SubMatches(4) & quot & sep & quot & Match.SubMatches(5) & quot & vbcrlf
     Next
    Next   
   End If
   If csv <> "" Then
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set file = objFSO.OpenTextFile(name & ".csv",2,true)
    file.WriteLine(csvhead & csv)
    Set file = Nothing
    c = c+1
   End If
  End If
  row = "---" & 12345 + Rnd * 16777216
  post = row & vbcrlf & "Content-Disposition: form-data; name=""sid""" & vbcrlf & vbcrlf & id & vbcrlf _
   & row & vbcrlf & "Content-Disposition: form-data; name=""PhonebookId""" & vbcrlf & vbcrlf & b & bcrlf _
   & row & vbcrlf & "Content-Disposition: form-data; name=""PhonebookExportName""" & vbcrlf & vbcrlf & name & vbcrlf _
   & row & vbcrlf & "Content-Disposition: form-data; name=""PhonebookExport""" & vbcrlf & vbcrlf & vbcrlf & row & "--" & vbcrlf
  With http
   .Open "POST", "http://" & host & config,false
   .setRequestHeader "HOST", host
   .setRequestHeader "Connection", "Keep-Alive"
   .setRequestHeader "Content-Type", "multipart/form-data; boundary=" & row
   .setRequestHeader "Content-Length", Len(post)
   .Send post
  End With
  If Len(http.responseText) > 0 Then
   row = http.getAllResponseHeaders
   first = InStr(row, "filename=""") + Len("filename=""")
   last = InStr(row, ".xml""")
   If last > 0 Then
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set file = objFSO.OpenTextFile(Mid(row, first, last - first +4),2,true)
    file.WriteLine(http.responseText)
    Set file = Nothing
   End If
  End If
 a = a+1
 Wend
 If sid <> "" Then
  text = SendPost(http,page,host,"security:command/logout=1" & sid)
 End If
 If c = 0 Then
  MsgBox "Routerangaben falsch oder keine Telefonbucheinträge verfügbar!",48,"Fehler:"
 End If
End If

dass funktioniert auch recht gut. die xml datei die er ausspuckt siet dann so aus

Code:

<?xml version="1.0" encoding="iso-8859-1"?>
<phonebooks>
<phonebook owner="1" name="Tobias"><contact><category>0</category><person><realName>Andi</realName></person><telephony><number
type="home" prio="1">6409868</number></telephony><services /><setup /><mod_time>1290095243</mod_time></contact><contact><category>0</category><person><realName>Steffi</realName><imageURL /></person><telephony><number
type="home" prio="1">56991130</number></telephony><services /><setup /><mod_time>1289640022</mod_time></contact></phonebook>
</phonebooks>

mit dem kann natürlich dass 7940 noch nichts anfangen und genau da fängt mein problem an. Jetzt muss aus dem oberigen xml file Name und Telefonnummer ausgelesen werden und im Cisco kompatiblem format abspeichern.

Code:

<CiscoIPPhoneDirectory>
<DirectoryEntry>
<Name>Mama</Name>
<Telephone>003642310034</Telephone>
</DirectoryEntry>
<DirectoryEntry>
<Name>Feri</Name>
<Telephone>003642341171</Telephone>
</DirectoryEntry>
<DirectoryEntry>
<Name>Magda</Name>
<Telephone>07071888209</Telephone>
</DirectoryEntry>
<DirectoryEntry>
<Name>Daniel Handy</Name>
<Telephone>017622766356</Telephone>
</DirectoryEntry>
<DirectoryEntry>
<Name>Sahab</Name>
<Telephone>07073852080</Telephone>
</DirectoryEntry>
</CiscoIPPhoneDirectory>

vermutlich wäre das vb-script sogar recht simpel aber meine script kenntnisse sind recht beschränkt...

dass ganze soll dann mittels cron.exe als service x mal am tag durchlaufen und die cisco taugliche xml dann in ein bestimmtes verzeichniss legen.

hoffe ihr könnt mir helfen!
mfg
zaphi

zaphi1 · 18 Nov 2010

hab da noch ein bisal was rausgefunden...
das vb-script dass mir das telefonbuch aus der fritzbox holt erstellt neben der xml noch eine csv

Code:

sep=;
"nr";"name";"wichtig";"bild";"typ";"nummer";"kurzwahl";"vanity"
"0";"Alle (Rundruf)";"";"";"intern";"**9";"";""
"1";"Anrufbeantworter Tobias";"";"";"intern";"**600";"";""
"2";"AVM Ansage (HD)";"";"";"work";"[email protected]";"97";""
"3";"Cisco";"";"";"intern";"**621";"";""
"4";"Cisco2";"";"";"intern";"**620";"";""
"5";"Eltern";"";"";"intern";"**612";"";""
"6";"Eltern Schalfzimmer";"";"";"intern";"**613";"";""
"7";"Papa Büro";"";"";"intern";"**611";"";""
"8";"Papa Fax";"";"";"intern";"**2";"";""
"9";"Tobias";"";"";"intern";"**610";"";""

wenn man jetzt ein vb-script schreiben könnte, dass die spalte 2 und 6 in eine neue csv abspeichert und die header auf Name und Telephone ändert.
könnte man sie mit einem csv2xml converter in das passende xml format bringen.
hab das ganze mal "zu fuß" gemacht. die geänderte csv sieht dann so aus

Code:

"Name";"Telephone"
"Alle (Rundruf)";"**9"
"Anrufbeantworter Tobias";"**600"
"AVM Ansage (HD)";"[email protected]"
"Cisco";"**621"
"Cisco2";"**620"
"Eltern";"**612"
"Eltern Schalfzimmer";"**613"
"Papa Büro";"**611"
"Papa Fax";"**2"
"Tobias";"**610"

nach dem umwandeln in xml

Code:

<?xml version="1.0"?>
<CiscoIPPhoneDirectory>
<DirectoryEntry>
<Name>Alle (Rundruf)</Name>
<Telephone>**9</Telephone>
</DirectoryEntry>
<DirectoryEntry>
<Name>Anrufbeantworter Tobias</Name>
<Telephone>**600</Telephone>
</DirectoryEntry>
<DirectoryEntry>
<Name>AVM Ansage (HD)</Name>
<Telephone>[email protected]</Telephone>
</DirectoryEntry>
<DirectoryEntry>
<Name>Cisco</Name>
<Telephone>**621</Telephone>
</DirectoryEntry>
<DirectoryEntry>
<Name>Cisco2</Name>
<Telephone>**620</Telephone>
</DirectoryEntry>
<DirectoryEntry>
<Name>Eltern</Name>
<Telephone>**612</Telephone>
</DirectoryEntry>
<DirectoryEntry>
<Name>Eltern Schalfzimmer</Name>
<Telephone>**613</Telephone>
</DirectoryEntry>
<DirectoryEntry>
<Name>Papa Büro</Name>
<Telephone>**611</Telephone>
</DirectoryEntry>
<DirectoryEntry>
<Name>Papa Fax</Name>
<Telephone>**2</Telephone>
</DirectoryEntry>
<DirectoryEntry>
<Name>Tobias</Name>
<Telephone>**610</Telephone>
</DirectoryEntry>
</CiscoIPPhoneDirectory>

so würde es funktionieren.

im prinzip fehlt mir nur noch das vp-script um die csv zu "reinigen" dann sollte es klappen dass 1x am tag das fritzbox telefonbuch kopiert, konvertiert und für´s Cisco Phone bereitstellt wird.
wenn mir jemand dabei hilft mein projekt zu beenden werd ich euch natürlich ein schönes tut schreiben wie ihr euer fritzbox telefonbuch auf das cisco phone bekommt
so long
zaphi

zaphi1 · 19 Nov 2010

ich schon wieder jetzt dachte ich dass ich kurz vor dem durchbruch stehe und nun verweigert dieses blöde vb-script den dienst.... gefunden durch google und an meine bedürfnisse angepasst.

Code:

'On Error Resume Next
Dim objFSO, dataArray, clippedArray()
Set objFSO = CreateObject("Scripting.FileSystemObject")


'Create an array out of the CSV

'open the data file
Set oTextStream = objFSO.OpenTextFile("C:\test\Telefonbuch.csv")
Set newFile = objFSO.CreateTextFile("C:\test\newCSV.csv")
'make an array from the data file
dataArray = Split(oTextStream.ReadAll, vbNewLine)
'close the data file
oTextStream.Close

x = 0
For Each strLine In dataArray
    'Now make an array from each line
    ReDim Preserve clippedArray(x)
    clippedArray(x) =  Split(strLine,",")
    CutColumn = 8
    CutColumn = 7
    CutColumn = 5
    CutColumn = 4
    CutColumn = 3
    CutColumn = 1
    intCount = 0
    newLine = ""
    For Each Element In clippedArray(x)
        If intCount = UBound(clippedArray(x)) Then
            EndChar = vbCrLf
        Else
            EndChar = ","
        End If
    
        If intCount <> CutColumn Then
           newLine = newLine & Element & EndChar
        End If
        intCount = intCount + 1
        If intCount = UBound(clippedArray(x))+1 Then
            newFile.Write newLine
        End If
    Next
    
Next
WScript.Echo "Done"

nach durchlauf des scripts sieht meine neue datei genauso aus sie die alte

nach etwas suche bin ich dann darauf gestoßen dass man die zeile

If intCount <> CutColumn Then

in

If intCount <> CutColumn -1 Then

ändern muss nur leider gibt er jetzt eine leere csv aus ....

chaos2000 · 19 Nov 2010

mal ne ganz andere frage, warum muss es ein vb script sein?
Wer ruft eigentlich das script auf?

Wenn Du das script behalten möchtest, da mach doch einfach eine xls-transformation über die xml, fertig

zaphi1 · 19 Nov 2010

es muss kein vbscript sein war nur so ne idee von mir *g*
xls-transformation sagt mir jetzt recht wenig google konnte auf die schnelle auch net die passende antwort finden.

Ich will mittels eines CroneJob services eine batch starten die dann die jeweiligen scripte aufruft und die dateien verschiebt.

Pikachu · 20 Nov 2010

Hallo,

Eins mal vorweg VB Script ist nicht mein Ding, aber auch das ist Teilweise Lösbar,

Hier:

Code:

' FB_TB_Csv_to_Cisco_xml_02.vbs by StSn
' 20.11.2010 -> VB Script
' On Error Resume Next

 Dim objFSO, dataArray, clippedArray()

 Set objFSO = CreateObject("Scripting.FileSystemObject")

' Create an array out of the CSV

' open the data file
 Set oTextStream = objFSO.OpenTextFile("FB_Telefonbuch.csv")
' make an array from the data file
  dataArray = Split(oTextStream.ReadAll, vbNewLine)
' close the data file
 oTextStream.Close

' Create Cisco XML File
 Set newFile = objFSO.CreateTextFile("newXML.xml", True)

  newFile.WriteLine("<?xml version=" & chr(34) & "1.0" & chr(34) & "?>")

  newFile.WriteLine("<CiscoIPPhoneDirectory>")

  sep = ";"
  x = 0
  intCountData = 0

  For Each strLine In dataArray

   'Now make an array from each line
   ReDim Preserve clippedArray(x)
   clippedArray(x) =  Split(strLine, sep)

   CutColumn = 8
   intCount = 0
   newLine = ""
   sTmp = ""

   For Each Element In clippedArray(x)

    If intCount = UBound(clippedArray(x)) Then
     EndChar = vbCrLf
    Else
     EndChar = sep
    End If

    If intCountData >= 2 then

     If intCount <> CutColumn Then

      If intCount = 1 Then

       sTmp = Element

       If Left(sTmp, 1) = chr(34) then sTmp = Right(sTmp, Len(sTmp) -1)
       If Right(sTmp, 1) = chr(34) then sTmp = Left(sTmp, Len(sTmp) -1)

       sTmp = Replace( sTmp, "&", "&amp;")
       sTmp = Replace( sTmp, "<", "&lt;")
       sTmp = Replace( sTmp, ">", "&gt;")

       newLine = newLine & "<Name>"
       newLine = newLine & sTmp
       newLine = newLine & "</Name>"

       newLine = newLine & vbCrLf

      ElseIf intCount = 5 Then

       sTmp = Element

       If Left(sTmp, 1) = chr(34) then sTmp = Right(sTmp, Len(sTmp) -1)
       If Right(sTmp, 1) = chr(34) then sTmp = Left(sTmp, Len(sTmp) -1)

       newLine = newLine & "<Telephone>"
       newLine = newLine & sTmp
       newLine = newLine & "</Telephone>"

       newLine = newLine & vbCrLf

      End If

     End If

    Else

     If intCount <> CutColumn Then
      newLine = newLine & Element & EndChar
     End If

    End If

    intCount = intCount + 1

    If intCount = UBound(clippedArray(x)) + 1 Then

     If instr(newLine, "sep=") or instr(newLine, "vanity") Then
      intCountData = intCountData + 1
     Else

      newFile.WriteLine("<DirectoryEntry>")

      newFile.Write newLine

      newFile.WriteLine("</DirectoryEntry>")

     End If

    End If

   Next

  Next

  newFile.WriteLine("</CiscoIPPhoneDirectory>")

 newFile.Close

 WScript.Echo "Done"

Ich hoffe das Hilft weiter es erstellt aus der FB TB CSV eine Cisco XML
aber es gibt keine Garantie von mir da Ich mit VBS nichts am Hut habe.

Im Script von "Autor: Michael Engelke" im ersten Post ist wohl ein Leichtsinnsfehler hier:

Code:

   & row & vbcrlf & "Content-Disposition: form-data; name=""PhonebookId""" & vbcrlf & vbcrlf & b & [COLOR="Red"]bcrlf[/COLOR] _

das sollte wohl so sein in der Zeile

Code:

   & row & vbcrlf & "Content-Disposition: form-data; name=""PhonebookId""" & vbcrlf & vbcrlf & b & [COLOR="Red"]vbcrlf[/COLOR] _

zu dem kann es nicht mit UniCode Zeichen im Password umgehen,
das müssest du auch noch ändern.

:-Ö

Gruß Erwin

zaphi1 · 20 Nov 2010

Pikachu :groesste:

was soll ich sagen FETT merci! hab gerade mal v1.0 fertig gestellt.
jetzt muss es nur noch 9 uhr werden dann sollte es automatisch starten..

erklärungen in der liesmich.txt

achja unicod passwort hmmm ka wie man das ändert....aber es funzt

wartet lieber auf v1.1 *g*

Pikachu · 23 Nov 2010

Hallo,

Mich Wundert es dass das Script im Post eins bei dir zu gehen scheint,
denn die MD5 Function liefert mir bei einem Test den Falschen Wert hier:
f2e389d88b47eb020d46b647dc1d72dd -> falsch bei Passwort: 1234567z-äbc
richtig müsste es so sein hier:
9e224a41eeefa284df7bb0f26c2913e2 -> richtig bei Passwort: 1234567z-äbc

WScript.Echo MD5("1234567z-äbc")

wenn das bei dir so ist dann müsstest du da einiges ändern,
habe lange nach einer Lösung gesucht,
und das hier:

Code:

'
Public Function makeDots(sInStr)
' Unicode Zeichen die >255 (8364 = ¤) sind mit 46(.) zu ersetzen
' 22.11.2010 -> VB Script by StSn
' Anpassung bezüglich der Zeichen deren Unicode Codepoint > 255 ist 
' Diese werden durch "." ersetzt
'
 Dim sUstr
 Dim nTmp
'
 sUstr = ""
'
 For nTmp = 1 To Len(sInStr)
  If AscW(Mid(sInStr, nTmp, 1)) > 255 Then
   sUstr = sUstr + "."
  Else
   sUstr = sUstr + Mid(sInStr, nTmp, 1)
  End If
 Next
'
 makeDots = sUstr
'
End Function
'
'
Public Function UCode(sInStr)
' Ansi zu Unicode Zeichen
' 23.11.2010 -> VB Script by StSn
'
 Dim sUstr, sTmp
 Dim nTmp
'
 sUstr = ""
'
 If sInStr <> "" Then
'
  For nTmp = 1 To Len(sInStr)
   sTmp = Mid(sInStr, nTmp, 1)
   If AscW(sTmp) > 255 Then
    sUstr = sUstr & Chr("&H" & Right(Hex(AscW(sTmp)), 2)) & Chr("&H" & Left(Hex(AscW(sTmp)), 2))
   Else
    sUstr = sUstr & sTmp & Chr(0)
   End If
  Next
'
 End If
'
 UCode = sUstr
'
End Function
'
'
 WScript.Echo MD5(UCode("1234567z-äbc"))
'
 WScript.Echo MD5(UCode("1234567z-" + makeDots("äbc")))
'

könnte dabei Helfen?!

Keine Garantie dass es geht.

PS: Im "fb_get_book.vbs" VB Script ist die UCode Funktion vorhanden,
aber der Code ist so unübersichtlich dass man es nur nie sofort Findet.

24.11.2010 04:15 Hinzugefügt

Hier das geänderte VB Script "fb_get_book_to_cisco_xml.vbs"

Code:

' fb_get_book.vbs (c) 2010 by Michael Engelke <http://www.mengelke.de>
' fb_get_book_to_cisco_xml.vbs -> geändert 24.11.2010 by StSn
' es erstellt eine Cisco Xml Datei
'
 On Error Resume Next
'
 Dim host, pass
 Dim nOutCiscoXmlFile
 Dim sCiscoXmlFilePath, sCiscoXmlFile
'
 host = "fritz.box" ' 169.254.1.1
 pass = "passwort"
'
'
 nOutCiscoXmlFile = 1 ' 1 = Cisco Xml File, 0 = FB Csv and FB Xml File
 sCiscoXmlFilePath = "" ' Cisco Xml File Path -> "C:\Inetpub\home\"
 sCiscoXmlFile = "Telefonbuch.xml" ' Cisco Xml File
'
'
Public Function FbTbCsvToCiscoXml(sInCSV, sCiscoXmlFile)
'
 Dim objFSO, dataArray, clippedArray(), newFile
 Dim CutColumn, intCount, x, intCountData
 Dim sep, newLine, sTmp, EndChar
 Dim strLine, Element
'
 If sInCSV <> "" Then
'
  Set objFSO = CreateObject("Scripting.FileSystemObject")
'
' Create an array out of the CSV
'
' make an array from the data string
  dataArray = Split(sInCSV, vbNewLine)
'
'  Create Cisco XML File
  Set newFile = objFSO.CreateTextFile(sCiscoXmlFile, True)
'
   newFile.WriteLine("<?xml version=" & chr(34) & "1.0" & chr(34) & "?>")
'
   newFile.WriteLine("<CiscoIPPhoneDirectory>")
'
   sep = ";"
   x = 0
   intCountData = 0
'
   For Each strLine In dataArray
'
    'Now make an array from each line
    ReDim Preserve clippedArray(x)
    clippedArray(x) =  Split(strLine, sep)
'
    CutColumn = 8
    intCount = 0
    newLine = ""
    sTmp = ""
'
    For Each Element In clippedArray(x)
'
     If intCount = UBound(clippedArray(x)) Then
      EndChar = vbCrLf
     Else
      EndChar = sep
     End If
'
     If intCountData >= 2 Then
'
      If intCount <> CutColumn Then
'
       If intCount = 1 Then
'
        sTmp = Element
'
        If Left(sTmp, 1) = chr(34) Then sTmp = Right(sTmp, Len(sTmp) -1)
        If Right(sTmp, 1) = chr(34) Then sTmp = Left(sTmp, Len(sTmp) -1)
'
        sTmp = Replace(sTmp, "&", "&amp;")
        sTmp = Replace(sTmp, "<", "&lt;")
        sTmp = Replace(sTmp, ">", "&gt;")
'
        newLine = newLine & "<Name>"
        newLine = newLine & sTmp
        newLine = newLine & "</Name>"
'
        newLine = newLine & vbCrLf
'
       ElseIf intCount = 5 Then
'
        sTmp = Element
'
        If Left(sTmp, 1) = chr(34) Then sTmp = Right(sTmp, Len(sTmp) -1)
        If Right(sTmp, 1) = chr(34) Then sTmp = Left(sTmp, Len(sTmp) -1)
'
        newLine = newLine & "<Telephone>"
        newLine = newLine & sTmp
        newLine = newLine & "</Telephone>"
'
        newLine = newLine & vbCrLf
'
       End If
'
      End If
'
     Else
'
      If intCount <> CutColumn Then
       newLine = newLine & Element & EndChar
      End If
'
     End If
'
     intCount = intCount + 1
'
     If intCount = UBound(clippedArray(x)) + 1 Then
'
      If instr(newLine, "sep=") or instr(newLine, "vanity") Then
       intCountData = intCountData + 1
      Else
'
       newFile.WriteLine("<DirectoryEntry>")
       newFile.Write newLine
       newFile.WriteLine("</DirectoryEntry>")
'
      End If
'
     End If
'
    Next
'
   Next
'
   newFile.WriteLine("</CiscoIPPhoneDirectory>")
'
  newFile.Close
'
  Set objFSO = Nothing
'
 End If
'
End Function
'
'
Public Function makeDots(sInStr)
' Unicode Zeichen die >255 (8364 = ¤) sind mit 46(.) zu ersetzen
' 22.11.2010 -> VB Script by StSn
' Anpassung bezüglich der Zeichen deren Unicode Codepoint > 255 ist
' Diese werden durch "." ersetzt
'
 Dim sUstr
 Dim nTmp
'
 sUstr = ""
'
 For nTmp = 1 To Len(sInStr)
  If AscW(Mid(sInStr, nTmp, 1)) > 255 Then
   sUstr = sUstr + "."
  Else
   sUstr = sUstr + Mid(sInStr, nTmp, 1)
  End If
 Next
'
 makeDots = sUstr
'
End Function
'
'
Public Function UCode(sInStr)
' Ansi zu Unicode Zeichen
' 23.11.2010 -> VB Script by StSn
'
 Dim sUstr, sTmp
 Dim nTmp
'
 sUstr = ""
'
 If sInStr <> "" Then
'
  For nTmp = 1 To Len(sInStr)
   sTmp = Mid(sInStr, nTmp, 1)
   If AscW(sTmp) > 255 Then
    sUstr = sUstr & Chr("&H" & Right(Hex(AscW(sTmp)), 2)) & Chr("&H" & Left(Hex(AscW(sTmp)), 2))
   Else
    sUstr = sUstr & sTmp & Chr(0)
   End If
  Next
'
 End If
'
 UCode = sUstr
'
End Function
'
'
 Private Const BITS_TO_A_BYTE = 8
 Private Const BYTES_TO_A_WORD = 4
 Private Const BITS_TO_A_WORD = 32
'
 Private m_lOnBits(30)
 Private m_l2Power(30)
'
 m_lOnBits(0) = CLng(1)
 m_lOnBits(1) = CLng(3)
 m_lOnBits(2) = CLng(7)
 m_lOnBits(3) = CLng(15)
 m_lOnBits(4) = CLng(31)
 m_lOnBits(5) = CLng(63)
 m_lOnBits(6) = CLng(127)
 m_lOnBits(7) = CLng(255)
 m_lOnBits(8) = CLng(511)
 m_lOnBits(9) = CLng(1023)
 m_lOnBits(10) = CLng(2047)
 m_lOnBits(11) = CLng(4095)
 m_lOnBits(12) = CLng(8191)
 m_lOnBits(13) = CLng(16383)
 m_lOnBits(14) = CLng(32767)
 m_lOnBits(15) = CLng(65535)
 m_lOnBits(16) = CLng(131071)
 m_lOnBits(17) = CLng(262143)
 m_lOnBits(18) = CLng(524287)
 m_lOnBits(19) = CLng(1048575)
 m_lOnBits(20) = CLng(2097151)
 m_lOnBits(21) = CLng(4194303)
 m_lOnBits(22) = CLng(8388607)
 m_lOnBits(23) = CLng(16777215)
 m_lOnBits(24) = CLng(33554431)
 m_lOnBits(25) = CLng(67108863)
 m_lOnBits(26) = CLng(134217727)
 m_lOnBits(27) = CLng(268435455)
 m_lOnBits(28) = CLng(536870911)
 m_lOnBits(29) = CLng(1073741823)
 m_lOnBits(30) = CLng(2147483647)
'
 m_l2Power(0) = CLng(1)
 m_l2Power(1) = CLng(2)
 m_l2Power(2) = CLng(4)
 m_l2Power(3) = CLng(8)
 m_l2Power(4) = CLng(16)
 m_l2Power(5) = CLng(32)
 m_l2Power(6) = CLng(64)
 m_l2Power(7) = CLng(128)
 m_l2Power(8) = CLng(256)
 m_l2Power(9) = CLng(512)
 m_l2Power(10) = CLng(1024)
 m_l2Power(11) = CLng(2048)
 m_l2Power(12) = CLng(4096)
 m_l2Power(13) = CLng(8192)
 m_l2Power(14) = CLng(16384)
 m_l2Power(15) = CLng(32768)
 m_l2Power(16) = CLng(65536)
 m_l2Power(17) = CLng(131072)
 m_l2Power(18) = CLng(262144)
 m_l2Power(19) = CLng(524288)
 m_l2Power(20) = CLng(1048576)
 m_l2Power(21) = CLng(2097152)
 m_l2Power(22) = CLng(4194304)
 m_l2Power(23) = CLng(8388608)
 m_l2Power(24) = CLng(16777216)
 m_l2Power(25) = CLng(33554432)
 m_l2Power(26) = CLng(67108864)
 m_l2Power(27) = CLng(134217728)
 m_l2Power(28) = CLng(268435456)
 m_l2Power(29) = CLng(536870912)
 m_l2Power(30) = CLng(1073741824)
'
Private Function LShift(lValue, iShiftBits)
 If iShiftBits = 0 Then
  LShift = lValue
  Exit Function
 ElseIf iShiftBits = 31 Then
  If lValue And 1 Then
   LShift = &H80000000
  Else
   LShift = 0
  End If
  Exit Function
 ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
  Err.Raise 6
 End If
'
 If (lValue And m_l2Power(31 - iShiftBits)) Then
  LShift = ((lValue And m_lOnBits(31 - (iShiftBits + 1))) * m_l2Power(iShiftBits)) Or &H80000000
 Else
  LShift = ((lValue And m_lOnBits(31 - iShiftBits)) * m_l2Power(iShiftBits))
 End If
End Function
'
Private Function RShift(lValue, iShiftBits)
 If iShiftBits = 0 Then
  RShift = lValue
  Exit Function
 ElseIf iShiftBits = 31 Then
  If lValue And &H80000000 Then
   RShift = 1
  Else
   RShift = 0
  End If
  Exit Function
 ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
  Err.Raise 6
 End If
'
 RShift = (lValue And &H7FFFFFFE) \ m_l2Power(iShiftBits)
'
 If (lValue And &H80000000) Then
  RShift = (RShift Or (&H40000000 \ m_l2Power(iShiftBits - 1)))
 End If
End Function
'
Private Function RotateLeft(lValue, iShiftBits)
 RotateLeft = LShift(lValue, iShiftBits) Or RShift(lValue, (32 - iShiftBits))
End Function
'
Private Function AddUnsigned(lX, lY)
 Dim lX4
 Dim lY4
 Dim lX8
 Dim lY8
 Dim lResult
'
 lX8 = lX And &H80000000
 lY8 = lY And &H80000000
 lX4 = lX And &H40000000
 lY4 = lY And &H40000000
'
 lResult = (lX And &H3FFFFFFF) + (lY And &H3FFFFFFF)
'
 If lX4 And lY4 Then
  lResult = lResult Xor &H80000000 Xor lX8 Xor lY8
 ElseIf lX4 Or lY4 Then
  If lResult And &H40000000 Then
   lResult = lResult Xor &HC0000000 Xor lX8 Xor lY8
  Else
   lResult = lResult Xor &H40000000 Xor lX8 Xor lY8
  End If
 Else
  lResult = lResult Xor lX8 Xor lY8
 End If
'
 AddUnsigned = lResult
End Function
'
Private Function F(x, y, z)
 F = (x And y) Or ((Not x) And z)
End Function
'
Private Function G(x, y, z)
 G = (x And z) Or (y And (Not z))
End Function
'
Private Function H(x, y, z)
 H = (x Xor y Xor z)
End Function
'
Private Function I(x, y, z)
 I = (y Xor (x Or (Not z)))
End Function
'
Private Sub FF(a, b, c, d, x, s, ac)
 a = AddUnsigned(a, AddUnsigned(AddUnsigned(F(b, c, d), x), ac))
 a = RotateLeft(a, s)
 a = AddUnsigned(a, b)
End Sub
'
Private Sub GG(a, b, c, d, x, s, ac)
 a = AddUnsigned(a, AddUnsigned(AddUnsigned(G(b, c, d), x), ac))
 a = RotateLeft(a, s)
 a = AddUnsigned(a, b)
End Sub
'
Private Sub HH(a, b, c, d, x, s, ac)
 a = AddUnsigned(a, AddUnsigned(AddUnsigned(H(b, c, d), x), ac))
 a = RotateLeft(a, s)
 a = AddUnsigned(a, b)
End Sub
'
Private Sub II(a, b, c, d, x, s, ac)
 a = AddUnsigned(a, AddUnsigned(AddUnsigned(I(b, c, d), x), ac))
 a = RotateLeft(a, s)
 a = AddUnsigned(a, b)
End Sub
'
Private Function ConvertToWordArray(sMessage)
 Dim lMessageLength
 Dim lNumberOfWords
 Dim lWordArray()
 Dim lBytePosition
 Dim lByteCount
 Dim lWordCount
'
 Const MODULUS_BITS = 512
 Const CONGRUENT_BITS = 448
'
 lMessageLength = Len(sMessage)
'
 lNumberOfWords = (((lMessageLength + ((MODULUS_BITS - CONGRUENT_BITS) \ BITS_TO_A_BYTE)) \ (MODULUS_BITS \ BITS_TO_A_BYTE)) + 1) * (MODULUS_BITS \ BITS_TO_A_WORD)
 ReDim lWordArray(lNumberOfWords - 1)
'
 lBytePosition = 0
 lByteCount = 0
'
 Do Until lByteCount >= lMessageLength
  lWordCount = lByteCount \ BYTES_TO_A_WORD
  lBytePosition = (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE
  lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(Asc(Mid(sMessage, lByteCount + 1, 1)), lBytePosition)
  lByteCount = lByteCount + 1
 Loop
'
 lWordCount = lByteCount \ BYTES_TO_A_WORD
 lBytePosition = (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE
'
 lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(&H80, lBytePosition)
'
 lWordArray(lNumberOfWords - 2) = LShift(lMessageLength, 3)
 lWordArray(lNumberOfWords - 1) = RShift(lMessageLength, 29)
'
 ConvertToWordArray = lWordArray
End Function
'
Private Function WordToHex(lValue)
 Dim lByte
 Dim lCount
'
 For lCount = 0 To 3
  lByte = RShift(lValue, lCount * BITS_TO_A_BYTE) And m_lOnBits(BITS_TO_A_BYTE - 1)
  WordToHex = WordToHex & Right("0" & Hex(lByte), 2)
 Next
End Function
'
Public Function MD5(sMessage)
 Dim x
 Dim k
 Dim AA
 Dim BB
 Dim CC
 Dim DD
 Dim a
 Dim b
 Dim c
 Dim d
'
 Const S11 = 7
 Const S12 = 12
 Const S13 = 17
 Const S14 = 22
 Const S21 = 5
 Const S22 = 9
 Const S23 = 14
 Const S24 = 20
 Const S31 = 4
 Const S32 = 11
 Const S33 = 16
 Const S34 = 23
 Const S41 = 6
 Const S42 = 10
 Const S43 = 15
 Const S44 = 21
'
 x = ConvertToWordArray(sMessage) ' sMessage = Ansi
' x = ConvertToWordArray(UCode(sMessage)) ' sMessage = Ansi als UniCode übergeben
'
 a = &H67452301
 b = &HEFCDAB89
 c = &H98BADCFE
 d = &H10325476
'
 For k = 0 To UBound(x) Step 16
'
  AA = a
  BB = b
  CC = c
  DD = d
'
  FF a, b, c, d, x(k + 0), S11, &HD76AA478
  FF d, a, b, c, x(k + 1), S12, &HE8C7B756
  FF c, d, a, b, x(k + 2), S13, &H242070DB
  FF b, c, d, a, x(k + 3), S14, &HC1BDCEEE
  FF a, b, c, d, x(k + 4), S11, &HF57C0FAF
  FF d, a, b, c, x(k + 5), S12, &H4787C62A
  FF c, d, a, b, x(k + 6), S13, &HA8304613
  FF b, c, d, a, x(k + 7), S14, &HFD469501
  FF a, b, c, d, x(k + 8), S11, &H698098D8
  FF d, a, b, c, x(k + 9), S12, &H8B44F7AF
  FF c, d, a, b, x(k + 10), S13, &HFFFF5BB1
  FF b, c, d, a, x(k + 11), S14, &H895CD7BE
  FF a, b, c, d, x(k + 12), S11, &H6B901122
  FF d, a, b, c, x(k + 13), S12, &HFD987193
  FF c, d, a, b, x(k + 14), S13, &HA679438E
  FF b, c, d, a, x(k + 15), S14, &H49B40821
'
  GG a, b, c, d, x(k + 1), S21, &HF61E2562
  GG d, a, b, c, x(k + 6), S22, &HC040B340
  GG c, d, a, b, x(k + 11), S23, &H265E5A51
  GG b, c, d, a, x(k + 0), S24, &HE9B6C7AA
  GG a, b, c, d, x(k + 5), S21, &HD62F105D
  GG d, a, b, c, x(k + 10), S22, &H2441453
  GG c, d, a, b, x(k + 15), S23, &HD8A1E681
  GG b, c, d, a, x(k + 4), S24, &HE7D3FBC8
  GG a, b, c, d, x(k + 9), S21, &H21E1CDE6
  GG d, a, b, c, x(k + 14), S22, &HC33707D6
  GG c, d, a, b, x(k + 3), S23, &HF4D50D87
  GG b, c, d, a, x(k + 8), S24, &H455A14ED
  GG a, b, c, d, x(k + 13), S21, &HA9E3E905
  GG d, a, b, c, x(k + 2), S22, &HFCEFA3F8
  GG c, d, a, b, x(k + 7), S23, &H676F02D9
  GG b, c, d, a, x(k + 12), S24, &H8D2A4C8A
'
  HH a, b, c, d, x(k + 5), S31, &HFFFA3942
  HH d, a, b, c, x(k + 8), S32, &H8771F681
  HH c, d, a, b, x(k + 11), S33, &H6D9D6122
  HH b, c, d, a, x(k + 14), S34, &HFDE5380C
  HH a, b, c, d, x(k + 1), S31, &HA4BEEA44
  HH d, a, b, c, x(k + 4), S32, &H4BDECFA9
  HH c, d, a, b, x(k + 7), S33, &HF6BB4B60
  HH b, c, d, a, x(k + 10), S34, &HBEBFBC70
  HH a, b, c, d, x(k + 13), S31, &H289B7EC6
  HH d, a, b, c, x(k + 0), S32, &HEAA127FA
  HH c, d, a, b, x(k + 3), S33, &HD4EF3085
  HH b, c, d, a, x(k + 6), S34, &H4881D05
  HH a, b, c, d, x(k + 9), S31, &HD9D4D039
  HH d, a, b, c, x(k + 12), S32, &HE6DB99E5
  HH c, d, a, b, x(k + 15), S33, &H1FA27CF8
  HH b, c, d, a, x(k + 2), S34, &HC4AC5665
'
  II a, b, c, d, x(k + 0), S41, &HF4292244
  II d, a, b, c, x(k + 7), S42, &H432AFF97
  II c, d, a, b, x(k + 14), S43, &HAB9423A7
  II b, c, d, a, x(k + 5), S44, &HFC93A039
  II a, b, c, d, x(k + 12), S41, &H655B59C3
  II d, a, b, c, x(k + 3), S42, &H8F0CCC92
  II c, d, a, b, x(k + 10), S43, &HFFEFF47D
  II b, c, d, a, x(k + 1), S44, &H85845DD1
  II a, b, c, d, x(k + 8), S41, &H6FA87E4F
  II d, a, b, c, x(k + 15), S42, &HFE2CE6E0
  II c, d, a, b, x(k + 6), S43, &HA3014314
  II b, c, d, a, x(k + 13), S44, &H4E0811A1
  II a, b, c, d, x(k + 4), S41, &HF7537E82
  II d, a, b, c, x(k + 11), S42, &HBD3AF235
  II c, d, a, b, x(k + 2), S43, &H2AD7D2BB
  II b, c, d, a, x(k + 9), S44, &HEB86D391
'
  a = AddUnsigned(a, AA)
  b = AddUnsigned(b, BB)
  c = AddUnsigned(c, CC)
  d = AddUnsigned(d, DD)
'
 Next
'
' MD5 = UCase(WordToHex(a) & WordToHex(b) & WordToHex(c) & WordToHex(d)) ' Grossbuchstaben
 MD5 = LCase(WordToHex(a) & WordToHex(b) & WordToHex(c) & WordToHex(d)) ' Kleinbuchstaben
'
End Function
'
Public FUNCTION getMd5Hash(sInStr)
' Anpassung bezüglich der Zeichen deren Unicode Codepoint > 255 ist
' Diese werden durch "." ersetzt
' Ansi wird als Unicode an MD5 übergeben und die MD5 Zeichenkette
' wird kleingeschrieben zurückgeliefert
' 23.11.2010 -> VB Script by StSn
'
 getMd5Hash = LCase(MD5(UCode(makeDots(sInStr))))
'
END FUNCTION
'
'
Public Function SendPost(http, page, host, post)
 With http
  .Open "POST", page, false
  .setRequestHeader "HOST", host
  .setRequestHeader "Connection", "Keep-Alive"
  .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
  .setRequestHeader "Content-Length", Len(post)
  .Send post
 End With
 SendPost = http.responseText
End Function
'
'
sid = ""
sep = ";"
quot = """"
name = "fonbook"
page = "http://" & host & "/cgi-bin/webcm"
auth = "login:command/password=" & pass
menu = "getpage=../html/de/menus/menu2.html&var:lang=de"
login = "getpage=../html/login_sid.xml"
config = "/cgi-bin/firmwarecfg"
getbook = menu & "&var:pagename=newfonbuch&var:menu=home"
selbook = "telcfg:settings/Phonebook/Books/Select="
fonbook = "&var:pagename=fonbuch&var:menu=fon"
pattern = "Phonebook/Books/\w+(\d+).*?value=""(.*?)"""
csvpatn = "(Name\(""([^""]*)"",\s""([^""]*)"",\s""([^""]*)""(?:,\s""([^""]*)"")?\)|Nr\(""([^""]*)"",\s""([^""]*)"",\s""([^""]*)"",\s""([^""]*)""\))"
csvpato = """([^""]*)"",\s*""(!?)([^""]*)"",\s*""([^""]*)"",\s*""([^""]*)"",\s*""([^""]*)"""
csvhead = "sep=" & sep & vbcrlf & quot & "nr" & quot & sep & quot & "name" & quot & sep & quot & "wichtig" & quot _
     & sep & quot & "bild" & quot & sep & quot & "typ" & quot & sep & quot & "nummer" & quot _
     & sep & quot & "kurzwahl" & quot & sep & quot & "vanity" & quot & vbcrlf
'
Set http = Nothing
Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
'
If http Is Nothing Then Set http = CreateObject("WinHttp.WinHttpRequest.5")
If http Is Nothing Then Set http = CreateObject("WinHttp.WinHttpRequest")
If http Is Nothing Then Set http = CreateObject("MSXML2.ServerXMLHTTP")
If http Is Nothing Then Set http = CreateObject("Microsoft.XMLHTTP")
'
If http Is Nothing Then
 MsgBox "Kein HTTP-Objekt verfügbar!", 16, "Fehler:"
Else
 On Error Goto 0
'
 http.Open "GET", page & "?" & login, false
 http.Send
'
 first = InStr(http.responseText, "<Challenge>") + Len("<Challenge>")
 last = InStr(http.responseText, "</Challenge>")
'
 If last > 0 Then
  auth = Mid(http.responseText, first, last - first)
  response = auth & "-" & getMd5Hash(auth & "-" & pass)
  auth = "login:command/response=" & response & "&" & login
 End If
'
 text = SendPost(http, page, host, auth)
 first = InStr(text, "<SID>") + Len("<SID>")
 last = InStr(text, "</SID>")
'
 If last > 0 Then
  If Mid(text, first, last - first) <> "0000000000000000" Then
   id = Mid(text, first, last - first)
   sid = "&sid=" & id
  End If
 End If
'
 a = 0
 b = 0
 c = 0
 max = 1
'
 http.Open "GET", page & "?" & getbook & sid, false
 http.Send post
'
 If Len(http.responseText) > 0 Then
  Set re = new regexp
  With re
   .Pattern = pattern
   .IgnoreCase = True
   .Global = True
   Set book = .Execute(http.responseText)
  End With
 End If
'
 While a < max
  If book.count > 0 Then
   max = book.count / 2
   Set row = book(a * 2)
   name = row.SubMatches(1)
   Set row = book(a * 2 + 1)
   b = row.SubMatches(1)
  End If
'
  post = selbook & b & "&" & menu & fonbook & sid
  text = SendPost(http, page, host, post)
'
  If Len(text) > 0 Then
   csv = ""
   row = ""
   Set re = new regexp
   trfon = Split(text, ">TrFon")
   For Each line In trfon
    With re
     .Pattern = csvpatn
     .IgnoreCase = True
     .Global = True
     Set Matches = .Execute(line)
    End With
    For Each Match in Matches
     If Match.SubMatches(1) <> "" Then
      row = quot & Match.SubMatches(1) & quot & sep & quot & Match.SubMatches(2) & quot & sep _
       & quot & Match.SubMatches(3) & quot & sep & quot & Match.SubMatches(4) & quot & sep
     Else
      If Match.SubMatches(6) <> "" or Match.SubMatches(7) <> "" or Match.SubMatches(8) <> "" Then
       csv = csv & row & quot & Match.SubMatches(5) & quot & sep & quot & Match.SubMatches(6) & quot & sep _
        & quot & Match.SubMatches(7) & quot & sep & quot & Match.SubMatches(8) & quot & vbcrlf
      End If
     End If
    Next
   Next
'
   If csv = "" Then
    trfon = Split(text, "(TrFon(")
    For Each line In trfon
     With re
      .Pattern = csvpato
      .IgnoreCase = True
      .Global = True
      Set Matches = .Execute(line)
     End With
     For Each Match in Matches
      csv = csv & quot & Match.SubMatches(0) & quot & sep & quot & Match.SubMatches(2) & quot & sep _
       & quot & Replace(Match.SubMatches(1),"!","1") & quot & sep & quot & quot & sep & quot & "home" & quot & sep & quot & Match.SubMatches(3) & quot & sep _
       & quot & Match.SubMatches(4) & quot & sep & quot & Match.SubMatches(5) & quot & vbcrlf
     Next
    Next
   End If
'
   If csv <> "" Then
'
    If nOutCiscoXmlFile = 1 Then ' Cisco Xml File
     FbTbCsvToCiscoXml csvhead & csv, sCiscoXmlFilePath & sCiscoXmlFile
    Else
     Set objFSO = CreateObject("Scripting.FileSystemObject")
     Set file = objFSO.OpenTextFile(name & ".csv", 2, true)
     file.WriteLine(csvhead & csv)
     file.Close
     Set file = Nothing
    End If
    c = c + 1
   End If
'
  End If
'
  If nOutCiscoXmlFile <> 1 Then
'
   row = "---" & 12345 + Rnd * 16777216
   post = row & vbcrlf & "Content-Disposition: form-data; name=""sid""" & vbcrlf & vbcrlf & id & vbcrlf _
    & row & vbcrlf & "Content-Disposition: form-data; name=""PhonebookId""" & vbcrlf & vbcrlf & b & vbcrlf _
    & row & vbcrlf & "Content-Disposition: form-data; name=""PhonebookExportName""" & vbcrlf & vbcrlf & name & vbcrlf _
    & row & vbcrlf & "Content-Disposition: form-data; name=""PhonebookExport""" & vbcrlf & vbcrlf & vbcrlf & row & "--" & vbcrlf
   With http
    .Open "POST", "http://" & host & config, false
    .setRequestHeader "HOST", host
    .setRequestHeader "Connection", "Keep-Alive"
    .setRequestHeader "Content-Type", "multipart/form-data; boundary=" & row
    .setRequestHeader "Content-Length", Len(post)
    .Send post
   End With
   If Len(http.responseText) > 0 Then
    row = http.getAllResponseHeaders
    first = InStr(row, "filename=""") + Len("filename=""")
    last = InStr(row, ".xml""")
    If last > 0 Then
     Set objFSO = CreateObject("Scripting.FileSystemObject")
     Set file = objFSO.OpenTextFile(Mid(row, first, last - first + 4), 2, true)
     file.WriteLine(http.responseText)
     file.Close
     Set file = Nothing
    End If
   End If
'
  End If
'
  a = a + 1
'
 Wend
'
 If sid <> "" Then
  text = SendPost(http, page, host, "security:command/logout=1" & sid)
 End If
'
 If c = 0 Then
  MsgBox "Routerangaben falsch oder keine Telefonbucheinträge verfügbar!", 48, "Fehler:"
 End If
'
End If
'

Das VB Script erstellt die Cisco Xml Datei jetzt ohne Umwege über die FB Csv Datei

Es gibt keine Garantie dass es geht.

Gruß Erwin

zaphi1 · 24 Nov 2010

Morgen,

bin grad noch im Büro aber ich kann mit sicherheit sagen, dass das script aus post 1 funktioniert. Ich glaube mich zu erinnern irgendwo gelesen zu haben das es irgendwie mit den UPnP Statusinfos arbeitet.
Bei mir wird seit letzten Samstag Stündlich die Cisco XML erstellt.

werde dein geändertes script heute nachmittag testen.

mipo · 24 Nov 2010

Hallo zusammen,

ich habe das Telefonbuch der Asterisk Distribution "Gemeinschaft 3.0" über ein PHP Script
in das Cisco 7940 eingespielt bzw. bei jedem reboot einspielen lassen. Funktioniert eigent-
lich prima. Doch habe ich das Problem, dass nur max. 32 Einträge ins Telefonbuch passen.

Wie kann man das blättern bzw. nachladen in den Griff bekommen? Habt ihr hier Erfahrungen?

vG Michael

Schetti · 24 Mrz 2011

Hallo zusammen,
ich habe mir das "Cisco Phonebook vb-script geladen um das Telefonbuch auf meinem SIP-based-Cisco zu nutzen. Leider versteht mein 7940 mit aktueller Firmware das so erstellte Telefonbuch nicht. Dieses Beispiel funktioniert bei mir problemlos:

Code:

<CiscoIPPhoneDirectory>       
 <Title>VoIP Telefonbuch</Title>
 <Prompt>Fusszeile</Prompt>                    
 <DirectoryEntry>                                              
   <Name>Hein Bloed</Name>         
   <Telephone>0471112345</Telephone>
 </DirectoryEntry>                                      
 <DirectoryEntry>             
   <Name>Gaense Klein</Name>       
   <Telephone>09999678912</Telephone>                                            
 </DirectoryEntry>            
 <DirectoryEntry>
   <Name>Sipgate Testnummer</Name>
   <Telephone>10000</Telephone>
 </DirectoryEntry>
</CiscoIPPhoneDirectory>

Das vb-script erstellte Telefonbuch sieht allerdings ganz anders aus.
Habe ich da etwas falsch verstanden, oder was mache ich falsch? Ich habe eine FB 7390 mit Labor-Version 84.05.01-19469

Christian.

Pikachu · 24 Mrz 2011

Hallo,

Hier:

Code:

' fb_get_book.vbs (c) 2010 by Michael Engelke <http://www.mengelke.de>
' fb_get_book_to_cisco_xml.vbs -> geändert 24.11.2010 by StSn
' 24.03.2011 -> geändert
' es erstellt eine Cisco Xml Datei
'
 On Error Resume Next
'
 Dim host, pass
 Dim nOutCiscoXmlFile
 Dim sCiscoXmlFilePath, sCiscoXmlFile
'
 host = "fritz.box" ' 169.254.1.1
 pass = "passwort"
'
'
 nOutCiscoXmlFile = 1 ' 1 = Cisco Xml File, 0 = FB Csv and FB Xml File
 sCiscoXmlFilePath = "" ' Cisco Xml File Path -> "C:\Inetpub\home\"
 sCiscoXmlFile = "Telefonbuch.xml" ' Cisco Xml File
'
'
Public Function FbTbCsvToCiscoXml(sInCSV, sCiscoXmlFile)
'
 Dim objFSO, dataArray, clippedArray(), newFile
 Dim CutColumn, intCount, x, intCountData
 Dim sep, newLine, sTmp, EndChar
 Dim strLine, Element
'
 If sInCSV <> "" Then
'
  Set objFSO = CreateObject("Scripting.FileSystemObject")
'
' Create an array out of the CSV
'
' make an array from the data string
  dataArray = Split(sInCSV, vbNewLine)
'
'  Create Cisco XML File
  Set newFile = objFSO.CreateTextFile(sCiscoXmlFile, True)
'
   newFile.WriteLine("<?xml version=" & chr(34) & "1.0" & chr(34) & "?>")
'
   newFile.WriteLine("<CiscoIPPhoneDirectory>")
'
' 24.03.2011 -->
   newFile.WriteLine("<Title>VoIP Telefonbuch</Title>")
'
   newFile.WriteLine("<Prompt>Fusszeile</Prompt>")
' 24.03.2011 <--
'
   sep = ";"
   x = 0
   intCountData = 0
'
   For Each strLine In dataArray
'
    'Now make an array from each line
    ReDim Preserve clippedArray(x)
    clippedArray(x) =  Split(strLine, sep)
'
    CutColumn = 8
    intCount = 0
    newLine = ""
    sTmp = ""
'
    For Each Element In clippedArray(x)
'
     If intCount = UBound(clippedArray(x)) Then
      EndChar = vbCrLf
     Else
      EndChar = sep
     End If
'
     If intCountData >= 2 Then
'
      If intCount <> CutColumn Then
'
       If intCount = 1 Then
'
        sTmp = Element
'
        If Left(sTmp, 1) = chr(34) Then sTmp = Right(sTmp, Len(sTmp) -1)
        If Right(sTmp, 1) = chr(34) Then sTmp = Left(sTmp, Len(sTmp) -1)
'
        sTmp = Replace(sTmp, "&", "&amp;")
        sTmp = Replace(sTmp, "<", "&lt;")
        sTmp = Replace(sTmp, ">", "&gt;")
'
        newLine = newLine & "<Name>"
        newLine = newLine & sTmp
        newLine = newLine & "</Name>"
'
        newLine = newLine & vbCrLf
'
       ElseIf intCount = 5 Then
'
        sTmp = Element
'
        If Left(sTmp, 1) = chr(34) Then sTmp = Right(sTmp, Len(sTmp) -1)
        If Right(sTmp, 1) = chr(34) Then sTmp = Left(sTmp, Len(sTmp) -1)
'
        newLine = newLine & "<Telephone>"
        newLine = newLine & sTmp
        newLine = newLine & "</Telephone>"
'
        newLine = newLine & vbCrLf
'
       End If
'
      End If
'
     Else
'
      If intCount <> CutColumn Then
       newLine = newLine & Element & EndChar
      End If
'
     End If
'
     intCount = intCount + 1
'
     If intCount = UBound(clippedArray(x)) + 1 Then
'
      If instr(newLine, "sep=") or instr(newLine, "vanity") Then
       intCountData = intCountData + 1
      Else
'
       newFile.WriteLine("<DirectoryEntry>")
       newFile.Write newLine
       newFile.WriteLine("</DirectoryEntry>")
'
      End If
'
     End If
'
    Next
'
   Next
'
   newFile.WriteLine("</CiscoIPPhoneDirectory>")
'
  newFile.Close
'
  Set objFSO = Nothing
'
 End If
'
End Function
'
'
Public Function makeDots(sInStr)
' Unicode Zeichen die >255 (8364 = ¤) sind mit 46(.) zu ersetzen
' 22.11.2010 -> VB Script by StSn
' Anpassung bezüglich der Zeichen deren Unicode Codepoint > 255 ist
' Diese werden durch "." ersetzt
'
 Dim sUstr
 Dim nTmp
'
 sUstr = ""
'
 For nTmp = 1 To Len(sInStr)
  If AscW(Mid(sInStr, nTmp, 1)) > 255 Then
   sUstr = sUstr + "."
  Else
   sUstr = sUstr + Mid(sInStr, nTmp, 1)
  End If
 Next
'
 makeDots = sUstr
'
End Function
'
'
Public Function UCode(sInStr)
' Ansi zu Unicode Zeichen
' 23.11.2010 -> VB Script by StSn
'
 Dim sUstr, sTmp
 Dim nTmp
'
 sUstr = ""
'
 If sInStr <> "" Then
'
  For nTmp = 1 To Len(sInStr)
   sTmp = Mid(sInStr, nTmp, 1)
   If AscW(sTmp) > 255 Then
    sUstr = sUstr & Chr("&H" & Right(Hex(AscW(sTmp)), 2)) & Chr("&H" & Left(Hex(AscW(sTmp)), 2))
   Else
    sUstr = sUstr & sTmp & Chr(0)
   End If
  Next
'
 End If
'
 UCode = sUstr
'
End Function
'
'
 Private Const BITS_TO_A_BYTE = 8
 Private Const BYTES_TO_A_WORD = 4
 Private Const BITS_TO_A_WORD = 32
'
 Private m_lOnBits(30)
 Private m_l2Power(30)
'
 m_lOnBits(0) = CLng(1)
 m_lOnBits(1) = CLng(3)
 m_lOnBits(2) = CLng(7)
 m_lOnBits(3) = CLng(15)
 m_lOnBits(4) = CLng(31)
 m_lOnBits(5) = CLng(63)
 m_lOnBits(6) = CLng(127)
 m_lOnBits(7) = CLng(255)
 m_lOnBits(8) = CLng(511)
 m_lOnBits(9) = CLng(1023)
 m_lOnBits(10) = CLng(2047)
 m_lOnBits(11) = CLng(4095)
 m_lOnBits(12) = CLng(8191)
 m_lOnBits(13) = CLng(16383)
 m_lOnBits(14) = CLng(32767)
 m_lOnBits(15) = CLng(65535)
 m_lOnBits(16) = CLng(131071)
 m_lOnBits(17) = CLng(262143)
 m_lOnBits(18) = CLng(524287)
 m_lOnBits(19) = CLng(1048575)
 m_lOnBits(20) = CLng(2097151)
 m_lOnBits(21) = CLng(4194303)
 m_lOnBits(22) = CLng(8388607)
 m_lOnBits(23) = CLng(16777215)
 m_lOnBits(24) = CLng(33554431)
 m_lOnBits(25) = CLng(67108863)
 m_lOnBits(26) = CLng(134217727)
 m_lOnBits(27) = CLng(268435455)
 m_lOnBits(28) = CLng(536870911)
 m_lOnBits(29) = CLng(1073741823)
 m_lOnBits(30) = CLng(2147483647)
'
 m_l2Power(0) = CLng(1)
 m_l2Power(1) = CLng(2)
 m_l2Power(2) = CLng(4)
 m_l2Power(3) = CLng(8)
 m_l2Power(4) = CLng(16)
 m_l2Power(5) = CLng(32)
 m_l2Power(6) = CLng(64)
 m_l2Power(7) = CLng(128)
 m_l2Power(8) = CLng(256)
 m_l2Power(9) = CLng(512)
 m_l2Power(10) = CLng(1024)
 m_l2Power(11) = CLng(2048)
 m_l2Power(12) = CLng(4096)
 m_l2Power(13) = CLng(8192)
 m_l2Power(14) = CLng(16384)
 m_l2Power(15) = CLng(32768)
 m_l2Power(16) = CLng(65536)
 m_l2Power(17) = CLng(131072)
 m_l2Power(18) = CLng(262144)
 m_l2Power(19) = CLng(524288)
 m_l2Power(20) = CLng(1048576)
 m_l2Power(21) = CLng(2097152)
 m_l2Power(22) = CLng(4194304)
 m_l2Power(23) = CLng(8388608)
 m_l2Power(24) = CLng(16777216)
 m_l2Power(25) = CLng(33554432)
 m_l2Power(26) = CLng(67108864)
 m_l2Power(27) = CLng(134217728)
 m_l2Power(28) = CLng(268435456)
 m_l2Power(29) = CLng(536870912)
 m_l2Power(30) = CLng(1073741824)
'
Private Function LShift(lValue, iShiftBits)
 If iShiftBits = 0 Then
  LShift = lValue
  Exit Function
 ElseIf iShiftBits = 31 Then
  If lValue And 1 Then
   LShift = &H80000000
  Else
   LShift = 0
  End If
  Exit Function
 ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
  Err.Raise 6
 End If
'
 If (lValue And m_l2Power(31 - iShiftBits)) Then
  LShift = ((lValue And m_lOnBits(31 - (iShiftBits + 1))) * m_l2Power(iShiftBits)) Or &H80000000
 Else
  LShift = ((lValue And m_lOnBits(31 - iShiftBits)) * m_l2Power(iShiftBits))
 End If
End Function
'
Private Function RShift(lValue, iShiftBits)
 If iShiftBits = 0 Then
  RShift = lValue
  Exit Function
 ElseIf iShiftBits = 31 Then
  If lValue And &H80000000 Then
   RShift = 1
  Else
   RShift = 0
  End If
  Exit Function
 ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
  Err.Raise 6
 End If
'
 RShift = (lValue And &H7FFFFFFE) \ m_l2Power(iShiftBits)
'
 If (lValue And &H80000000) Then
  RShift = (RShift Or (&H40000000 \ m_l2Power(iShiftBits - 1)))
 End If
End Function
'
Private Function RotateLeft(lValue, iShiftBits)
 RotateLeft = LShift(lValue, iShiftBits) Or RShift(lValue, (32 - iShiftBits))
End Function
'
Private Function AddUnsigned(lX, lY)
 Dim lX4
 Dim lY4
 Dim lX8
 Dim lY8
 Dim lResult
'
 lX8 = lX And &H80000000
 lY8 = lY And &H80000000
 lX4 = lX And &H40000000
 lY4 = lY And &H40000000
'
 lResult = (lX And &H3FFFFFFF) + (lY And &H3FFFFFFF)
'
 If lX4 And lY4 Then
  lResult = lResult Xor &H80000000 Xor lX8 Xor lY8
 ElseIf lX4 Or lY4 Then
  If lResult And &H40000000 Then
   lResult = lResult Xor &HC0000000 Xor lX8 Xor lY8
  Else
   lResult = lResult Xor &H40000000 Xor lX8 Xor lY8
  End If
 Else
  lResult = lResult Xor lX8 Xor lY8
 End If
'
 AddUnsigned = lResult
End Function
'
Private Function F(x, y, z)
 F = (x And y) Or ((Not x) And z)
End Function
'
Private Function G(x, y, z)
 G = (x And z) Or (y And (Not z))
End Function
'
Private Function H(x, y, z)
 H = (x Xor y Xor z)
End Function
'
Private Function I(x, y, z)
 I = (y Xor (x Or (Not z)))
End Function
'
Private Sub FF(a, b, c, d, x, s, ac)
 a = AddUnsigned(a, AddUnsigned(AddUnsigned(F(b, c, d), x), ac))
 a = RotateLeft(a, s)
 a = AddUnsigned(a, b)
End Sub
'
Private Sub GG(a, b, c, d, x, s, ac)
 a = AddUnsigned(a, AddUnsigned(AddUnsigned(G(b, c, d), x), ac))
 a = RotateLeft(a, s)
 a = AddUnsigned(a, b)
End Sub
'
Private Sub HH(a, b, c, d, x, s, ac)
 a = AddUnsigned(a, AddUnsigned(AddUnsigned(H(b, c, d), x), ac))
 a = RotateLeft(a, s)
 a = AddUnsigned(a, b)
End Sub
'
Private Sub II(a, b, c, d, x, s, ac)
 a = AddUnsigned(a, AddUnsigned(AddUnsigned(I(b, c, d), x), ac))
 a = RotateLeft(a, s)
 a = AddUnsigned(a, b)
End Sub
'
Private Function ConvertToWordArray(sMessage)
 Dim lMessageLength
 Dim lNumberOfWords
 Dim lWordArray()
 Dim lBytePosition
 Dim lByteCount
 Dim lWordCount
'
 Const MODULUS_BITS = 512
 Const CONGRUENT_BITS = 448
'
 lMessageLength = Len(sMessage)
'
 lNumberOfWords = (((lMessageLength + ((MODULUS_BITS - CONGRUENT_BITS) \ BITS_TO_A_BYTE)) \ (MODULUS_BITS \ BITS_TO_A_BYTE)) + 1) * (MODULUS_BITS \ BITS_TO_A_WORD)
 ReDim lWordArray(lNumberOfWords - 1)
'
 lBytePosition = 0
 lByteCount = 0
'
 Do Until lByteCount >= lMessageLength
  lWordCount = lByteCount \ BYTES_TO_A_WORD
  lBytePosition = (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE
  lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(Asc(Mid(sMessage, lByteCount + 1, 1)), lBytePosition)
  lByteCount = lByteCount + 1
 Loop
'
 lWordCount = lByteCount \ BYTES_TO_A_WORD
 lBytePosition = (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE
'
 lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(&H80, lBytePosition)
'
 lWordArray(lNumberOfWords - 2) = LShift(lMessageLength, 3)
 lWordArray(lNumberOfWords - 1) = RShift(lMessageLength, 29)
'
 ConvertToWordArray = lWordArray
End Function
'
Private Function WordToHex(lValue)
 Dim lByte
 Dim lCount
'
 For lCount = 0 To 3
  lByte = RShift(lValue, lCount * BITS_TO_A_BYTE) And m_lOnBits(BITS_TO_A_BYTE - 1)
  WordToHex = WordToHex & Right("0" & Hex(lByte), 2)
 Next
End Function
'
Public Function MD5(sMessage)
 Dim x
 Dim k
 Dim AA
 Dim BB
 Dim CC
 Dim DD
 Dim a
 Dim b
 Dim c
 Dim d
'
 Const S11 = 7
 Const S12 = 12
 Const S13 = 17
 Const S14 = 22
 Const S21 = 5
 Const S22 = 9
 Const S23 = 14
 Const S24 = 20
 Const S31 = 4
 Const S32 = 11
 Const S33 = 16
 Const S34 = 23
 Const S41 = 6
 Const S42 = 10
 Const S43 = 15
 Const S44 = 21
'
 x = ConvertToWordArray(sMessage) ' sMessage = Ansi
' x = ConvertToWordArray(UCode(sMessage)) ' sMessage = Ansi als UniCode übergeben
'
 a = &H67452301
 b = &HEFCDAB89
 c = &H98BADCFE
 d = &H10325476
'
 For k = 0 To UBound(x) Step 16
'
  AA = a
  BB = b
  CC = c
  DD = d
'
  FF a, b, c, d, x(k + 0), S11, &HD76AA478
  FF d, a, b, c, x(k + 1), S12, &HE8C7B756
  FF c, d, a, b, x(k + 2), S13, &H242070DB
  FF b, c, d, a, x(k + 3), S14, &HC1BDCEEE
  FF a, b, c, d, x(k + 4), S11, &HF57C0FAF
  FF d, a, b, c, x(k + 5), S12, &H4787C62A
  FF c, d, a, b, x(k + 6), S13, &HA8304613
  FF b, c, d, a, x(k + 7), S14, &HFD469501
  FF a, b, c, d, x(k + 8), S11, &H698098D8
  FF d, a, b, c, x(k + 9), S12, &H8B44F7AF
  FF c, d, a, b, x(k + 10), S13, &HFFFF5BB1
  FF b, c, d, a, x(k + 11), S14, &H895CD7BE
  FF a, b, c, d, x(k + 12), S11, &H6B901122
  FF d, a, b, c, x(k + 13), S12, &HFD987193
  FF c, d, a, b, x(k + 14), S13, &HA679438E
  FF b, c, d, a, x(k + 15), S14, &H49B40821
'
  GG a, b, c, d, x(k + 1), S21, &HF61E2562
  GG d, a, b, c, x(k + 6), S22, &HC040B340
  GG c, d, a, b, x(k + 11), S23, &H265E5A51
  GG b, c, d, a, x(k + 0), S24, &HE9B6C7AA
  GG a, b, c, d, x(k + 5), S21, &HD62F105D
  GG d, a, b, c, x(k + 10), S22, &H2441453
  GG c, d, a, b, x(k + 15), S23, &HD8A1E681
  GG b, c, d, a, x(k + 4), S24, &HE7D3FBC8
  GG a, b, c, d, x(k + 9), S21, &H21E1CDE6
  GG d, a, b, c, x(k + 14), S22, &HC33707D6
  GG c, d, a, b, x(k + 3), S23, &HF4D50D87
  GG b, c, d, a, x(k + 8), S24, &H455A14ED
  GG a, b, c, d, x(k + 13), S21, &HA9E3E905
  GG d, a, b, c, x(k + 2), S22, &HFCEFA3F8
  GG c, d, a, b, x(k + 7), S23, &H676F02D9
  GG b, c, d, a, x(k + 12), S24, &H8D2A4C8A
'
  HH a, b, c, d, x(k + 5), S31, &HFFFA3942
  HH d, a, b, c, x(k + 8), S32, &H8771F681
  HH c, d, a, b, x(k + 11), S33, &H6D9D6122
  HH b, c, d, a, x(k + 14), S34, &HFDE5380C
  HH a, b, c, d, x(k + 1), S31, &HA4BEEA44
  HH d, a, b, c, x(k + 4), S32, &H4BDECFA9
  HH c, d, a, b, x(k + 7), S33, &HF6BB4B60
  HH b, c, d, a, x(k + 10), S34, &HBEBFBC70
  HH a, b, c, d, x(k + 13), S31, &H289B7EC6
  HH d, a, b, c, x(k + 0), S32, &HEAA127FA
  HH c, d, a, b, x(k + 3), S33, &HD4EF3085
  HH b, c, d, a, x(k + 6), S34, &H4881D05
  HH a, b, c, d, x(k + 9), S31, &HD9D4D039
  HH d, a, b, c, x(k + 12), S32, &HE6DB99E5
  HH c, d, a, b, x(k + 15), S33, &H1FA27CF8
  HH b, c, d, a, x(k + 2), S34, &HC4AC5665
'
  II a, b, c, d, x(k + 0), S41, &HF4292244
  II d, a, b, c, x(k + 7), S42, &H432AFF97
  II c, d, a, b, x(k + 14), S43, &HAB9423A7
  II b, c, d, a, x(k + 5), S44, &HFC93A039
  II a, b, c, d, x(k + 12), S41, &H655B59C3
  II d, a, b, c, x(k + 3), S42, &H8F0CCC92
  II c, d, a, b, x(k + 10), S43, &HFFEFF47D
  II b, c, d, a, x(k + 1), S44, &H85845DD1
  II a, b, c, d, x(k + 8), S41, &H6FA87E4F
  II d, a, b, c, x(k + 15), S42, &HFE2CE6E0
  II c, d, a, b, x(k + 6), S43, &HA3014314
  II b, c, d, a, x(k + 13), S44, &H4E0811A1
  II a, b, c, d, x(k + 4), S41, &HF7537E82
  II d, a, b, c, x(k + 11), S42, &HBD3AF235
  II c, d, a, b, x(k + 2), S43, &H2AD7D2BB
  II b, c, d, a, x(k + 9), S44, &HEB86D391
'
  a = AddUnsigned(a, AA)
  b = AddUnsigned(b, BB)
  c = AddUnsigned(c, CC)
  d = AddUnsigned(d, DD)
'
 Next
'
' MD5 = UCase(WordToHex(a) & WordToHex(b) & WordToHex(c) & WordToHex(d)) ' Grossbuchstaben
 MD5 = LCase(WordToHex(a) & WordToHex(b) & WordToHex(c) & WordToHex(d)) ' Kleinbuchstaben
'
End Function
'
Public FUNCTION getMd5Hash(sInStr)
' Anpassung bezüglich der Zeichen deren Unicode Codepoint > 255 ist
' Diese werden durch "." ersetzt
' Ansi wird als Unicode an MD5 übergeben und die MD5 Zeichenkette
' wird kleingeschrieben zurückgeliefert
' 23.11.2010 -> VB Script by StSn
'
 getMd5Hash = LCase(MD5(UCode(makeDots(sInStr))))
'
END FUNCTION
'
'
Public Function SendPost(http, page, host, post)
 With http
  .Open "POST", page, false
  .setRequestHeader "HOST", host
  .setRequestHeader "Connection", "Keep-Alive"
  .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
  .setRequestHeader "Content-Length", Len(post)
  .Send post
 End With
 SendPost = http.responseText
End Function
'
'
sid = ""
sep = ";"
quot = """"
name = "fonbook"
page = "http://" & host & "/cgi-bin/webcm"
auth = "login:command/password=" & pass
menu = "getpage=../html/de/menus/menu2.html&var:lang=de"
login = "getpage=../html/login_sid.xml"
config = "/cgi-bin/firmwarecfg"
getbook = menu & "&var:pagename=newfonbuch&var:menu=home"
selbook = "telcfg:settings/Phonebook/Books/Select="
fonbook = "&var:pagename=fonbuch&var:menu=fon"
pattern = "Phonebook/Books/\w+(\d+).*?value=""(.*?)"""
csvpatn = "(Name\(""([^""]*)"",\s""([^""]*)"",\s""([^""]*)""(?:,\s""([^""]*)"")?\)|Nr\(""([^""]*)"",\s""([^""]*)"",\s""([^""]*)"",\s""([^""]*)""\))"
csvpato = """([^""]*)"",\s*""(!?)([^""]*)"",\s*""([^""]*)"",\s*""([^""]*)"",\s*""([^""]*)"""
csvhead = "sep=" & sep & vbcrlf & quot & "nr" & quot & sep & quot & "name" & quot & sep & quot & "wichtig" & quot _
     & sep & quot & "bild" & quot & sep & quot & "typ" & quot & sep & quot & "nummer" & quot _
     & sep & quot & "kurzwahl" & quot & sep & quot & "vanity" & quot & vbcrlf
'
Set http = Nothing
Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
'
If http Is Nothing Then Set http = CreateObject("WinHttp.WinHttpRequest.5")
If http Is Nothing Then Set http = CreateObject("WinHttp.WinHttpRequest")
If http Is Nothing Then Set http = CreateObject("MSXML2.ServerXMLHTTP")
If http Is Nothing Then Set http = CreateObject("Microsoft.XMLHTTP")
'
If http Is Nothing Then
 MsgBox "Kein HTTP-Objekt verfügbar!", 16, "Fehler:"
Else
 On Error Goto 0
'
 http.Open "GET", page & "?" & login, false
 http.Send
'
 first = InStr(http.responseText, "<Challenge>") + Len("<Challenge>")
 last = InStr(http.responseText, "</Challenge>")
'
 If last > 0 Then
  auth = Mid(http.responseText, first, last - first)
  response = auth & "-" & getMd5Hash(auth & "-" & pass)
  auth = "login:command/response=" & response & "&" & login
 End If
'
 text = SendPost(http, page, host, auth)
 first = InStr(text, "<SID>") + Len("<SID>")
 last = InStr(text, "</SID>")
'
 If last > 0 Then
  If Mid(text, first, last - first) <> "0000000000000000" Then
   id = Mid(text, first, last - first)
   sid = "&sid=" & id
  End If
 End If
'
 a = 0
 b = 0
 c = 0
 max = 1
'
 http.Open "GET", page & "?" & getbook & sid, false
 http.Send post
'
 If Len(http.responseText) > 0 Then
  Set re = new regexp
  With re
   .Pattern = pattern
   .IgnoreCase = True
   .Global = True
   Set book = .Execute(http.responseText)
  End With
 End If
'
 While a < max
  If book.count > 0 Then
   max = book.count / 2
   Set row = book(a * 2)
   name = row.SubMatches(1)
   Set row = book(a * 2 + 1)
   b = row.SubMatches(1)
  End If
'
  post = selbook & b & "&" & menu & fonbook & sid
  text = SendPost(http, page, host, post)
'
  If Len(text) > 0 Then
   csv = ""
   row = ""
   Set re = new regexp
   trfon = Split(text, ">TrFon")
   For Each line In trfon
    With re
     .Pattern = csvpatn
     .IgnoreCase = True
     .Global = True
     Set Matches = .Execute(line)
    End With
    For Each Match in Matches
     If Match.SubMatches(1) <> "" Then
      row = quot & Match.SubMatches(1) & quot & sep & quot & Match.SubMatches(2) & quot & sep _
       & quot & Match.SubMatches(3) & quot & sep & quot & Match.SubMatches(4) & quot & sep
     Else
      If Match.SubMatches(6) <> "" or Match.SubMatches(7) <> "" or Match.SubMatches(8) <> "" Then
       csv = csv & row & quot & Match.SubMatches(5) & quot & sep & quot & Match.SubMatches(6) & quot & sep _
        & quot & Match.SubMatches(7) & quot & sep & quot & Match.SubMatches(8) & quot & vbcrlf
      End If
     End If
    Next
   Next
'
   If csv = "" Then
    trfon = Split(text, "(TrFon(")
    For Each line In trfon
     With re
      .Pattern = csvpato
      .IgnoreCase = True
      .Global = True
      Set Matches = .Execute(line)
     End With
     For Each Match in Matches
      csv = csv & quot & Match.SubMatches(0) & quot & sep & quot & Match.SubMatches(2) & quot & sep _
       & quot & Replace(Match.SubMatches(1),"!","1") & quot & sep & quot & quot & sep & quot & "home" & quot & sep & quot & Match.SubMatches(3) & quot & sep _
       & quot & Match.SubMatches(4) & quot & sep & quot & Match.SubMatches(5) & quot & vbcrlf
     Next
    Next
   End If
'
   If csv <> "" Then
'
    If nOutCiscoXmlFile = 1 Then ' Cisco Xml File
     FbTbCsvToCiscoXml csvhead & csv, sCiscoXmlFilePath & sCiscoXmlFile
    Else
     Set objFSO = CreateObject("Scripting.FileSystemObject")
     Set file = objFSO.OpenTextFile(name & ".csv", 2, true)
     file.WriteLine(csvhead & csv)
     file.Close
     Set file = Nothing
    End If
    c = c + 1
   End If
'
  End If
'
  If nOutCiscoXmlFile <> 1 Then
'
   row = "---" & 12345 + Rnd * 16777216
   post = row & vbcrlf & "Content-Disposition: form-data; name=""sid""" & vbcrlf & vbcrlf & id & vbcrlf _
    & row & vbcrlf & "Content-Disposition: form-data; name=""PhonebookId""" & vbcrlf & vbcrlf & b & vbcrlf _
    & row & vbcrlf & "Content-Disposition: form-data; name=""PhonebookExportName""" & vbcrlf & vbcrlf & name & vbcrlf _
    & row & vbcrlf & "Content-Disposition: form-data; name=""PhonebookExport""" & vbcrlf & vbcrlf & vbcrlf & row & "--" & vbcrlf
   With http
    .Open "POST", "http://" & host & config, false
    .setRequestHeader "HOST", host
    .setRequestHeader "Connection", "Keep-Alive"
    .setRequestHeader "Content-Type", "multipart/form-data; boundary=" & row
    .setRequestHeader "Content-Length", Len(post)
    .Send post
   End With
   If Len(http.responseText) > 0 Then
    row = http.getAllResponseHeaders
    first = InStr(row, "filename=""") + Len("filename=""")
    last = InStr(row, ".xml""")
    If last > 0 Then
     Set objFSO = CreateObject("Scripting.FileSystemObject")
     Set file = objFSO.OpenTextFile(Mid(row, first, last - first + 4), 2, true)
     file.WriteLine(http.responseText)
     file.Close
     Set file = Nothing
    End If
   End If
'
  End If
'
  a = a + 1
'
 Wend
'
 If sid <> "" Then
  text = SendPost(http, page, host, "security:command/logout=1" & sid)
 End If
'
 If c = 0 Then
  MsgBox "Routerangaben falsch oder keine Telefonbucheinträge verfügbar!", 48, "Fehler:"
 End If
'
End If
'

Habe die zwei Zeilen hier:

Code:

 <Title>VoIP Telefonbuch</Title>
 <Prompt>Fusszeile</Prompt>

im Script mit dazu genommen, wenn es nur daran liegen sollte.

Gruß Erwin

Schetti · 25 Mrz 2011

Hallo Erwin,
das ist aber ein Superservice. Ganz herzlichen Dank dafür. Es funktioniert jetzt.

Ich bin aber noch nicht ganz fit in Sachen Cisco und hätte da noch ein paar Fragen, vielleicht kannst Du, oder auch gerne jemand anderes, das beantworten:

1. Ich habe einen apache2 installiert, wenn ich die Web-Seite aufrufe, wird das Telefonbuch aber nicht angezeigt. Welches Modul muss man auf dem apache installieren, damit das korrekt angezeigt wird, oder geht das gar nicht. (Fehler.png)

2. Ich verstehe den Zusammenhang zwischen der service-url und der directory-url in den cnf-Dateien nicht ganz.
a) Müssen die immer in der <MAC>.cnf sein, oder geht das auch in der SIPDefault.cnf (für alle Telefone gleich)?
b) hat vielleicht jemand ein Bsp., damit ich verstehe, wie die Dateien zusammen spielen?

3.Ich habe jetzt einen TFTP-Server und einen Webserver in einer VM unter Linux laufen. Um einfach nur zwei Telefone zu betreiben, ist das schon ein ziemlich großer Aufwand. Mit Freez kann man das zwar auf die Fritz-Box schrauben, aber irgendwie kann ich mich mit den Modifikationen nicht so richtig anfreuden. Wie habt ihr das gelöst?

Vielen Dank für die Hilfe,
Gruß,
Christian

Ramalama · 4 Okt 2011

Der thread ist nicht mehr so aktuell

Aber bei dem script kommt bei mir:
C:\Users\mw\Desktop\fbtelbuch.vbs (648, 2) WinHttp.WinHttpRequest: Für das Unicode-Zeichen ist kein zugeordnetes Zeichen in der Mehrbytecodepage vorhanden.

Ich muss irgendwie fritzbox telbuch mit dem cisco syncen^^

yogiflop · 21 Okt 2011

Also das Problem mit der Fehlermeldung hatte ich auch am Anfang, lag bei mir daran dass das XML anscheinend keine "ä,ö,ü" und ähnliches verarbeiten kann. Einfach im Telefonbuch der FRitz ändern, dann erzeugt er eine korrekte Liste ....

Ich habe aber immer noch das Problem wie ich die XML korrekt in die default.cnf eintrage. Webserver ist ein interner IIS.
Wenn mir da kurz einer die Zeilen posten könnte wie ich das korrekt eintragen muss.

Ich bekomme immer die Meldung "BTXML Error" und "404 Not found"

disorganizer · 8 Feb 2012

Thema ist zwar alt, aber dennoch:

Wäre es nicht möglich auf der Fritzbox ein script zu installieren welches das interne Telefonbuch im passenden Format als Applikation dem Phone zur Verfügung stellt?

Fritzbox Telefonbuch go´s Cisco IP Phone [DONE]

Neuer User

Neuer User

Neuer User

Aktives Mitglied

Neuer User

Aktives Mitglied

Neuer User

Anhänge

Aktives Mitglied

Neuer User

Aktives Mitglied

Neuer User

Aktives Mitglied

Neuer User

Anhänge

Neuer User

Neuer User

Neuer User

Statistik des Forums