"http://" & FBOX_ADR & "/cgi-bin/webcm?getpage=../html/de/menus/menu2.html&var:lang=de&var:menu=fon&var:pagename=fondevices&[COLOR="Red"]sid[/COLOR]=" & SID
TBPasswort=DvuTg00uPgsy0bLq/SLSOA==
«À
ÀÀÀ
ÀÀÀ
ÀÀÀ
ÀÀÀ
ÀÀÀ
ÀÀÀ
ÀÀÀ
ÀÀÀ
ÀÀÀ
ÀÀÀ
ÀÀÀ
ÀÀÀ
ÀÀÀ
ÀÀÀ
ÀÀÀ
ÕÀÀ
ÿÿê¶ÿÿÿÿÿÿÿÿÿÿÿÿÊàõÛÀÀÀ
ÀÀÀ
ÕÀÀ
ÿÿê¶ÿÿÿÿÿÿÿÿÿÿÿÿÀÕê¶ÀÀÀ
ÀÀÀ
ÕÀÀ
õÿê¶ÀÊàÀÀÀ
ÕÀÀ
ÿÿê¶ÕêÿÿÀÀÀ
ÕÀÀ
õÿê¶ÀÊàÀÀÀ
ÀÀÀ
ÀÀÀ
ÀÀÀ
ÀÀÀ
ÕÀÀ
õÿê¶ÀÊàÀÀÀ
ÀÀÀ
àÊÀ
êÿõÛÀÀÕfÕÀÀ
õÿê¶ÀÊàÀÀÀ
ÀÀÀ
ÀÀÀ
ÀÀÀ
ÀÀÀ
ÕÀÀ
õÿê¶ÀÊàÀÀÀ
ÀÀÀ
ÊÀÀ
ÿõàÀÕê¶ÕÀÀ
õÿê¶ÀÊàÀÀÀ
ÀÀÀ
ÀÀÀ
ÀÀÀ
ÀÀÀ
ÕÀÀ
õÿê¶ÀÊàÀÀÀ
ÀÀÀ
ÊÀÀ
ÿõàÀÕê¶ÕÀÀ
ÿÿê¶ÿÿÿÿÿÿÿÿêÿÿÿÀÀÕfÀÀÀ
ÀÀÀ
ÕÀÀ
õÿê¶ÀÊàÀÀÀ
ÀÀÀ
ÊÀÀ
õõàÀÊàÕÀÀ
õÿê¶ÀÊàÀÀÀ
ÀÀÀ
ÀÀÀ
ÀÀÀ
ÀÀÀ
ÕÀÀ
õÿê¶ÀÊàÀÀÀ
ÀÀÀ
àÊÀ
êÿõÛÀÀÕfÕÀÀ
õÿê¶ÀÊàÀÀÀ
ÀÀÀ
ÀÀÀ
ÀÀÀ
ÀÀ
&j¨J¨Z¢¦¹&¡¹'¨l°£éI¨N²¢¦!¡¦"¦¦'¡¨ Zªi¤ª :ªjªz¢¦Ê ¡Ê!jª|ª
¢¦ê!¡ê"jªª¢¦‹"¡‹#º)°£«IºÒ¢Ë'¡Û ¦
Z¿s{\ÈSà]^s{¿`–Sài/j?s{lJ1qXÿHÌrÚ'#Ugðƒuÿ…–ýY&1xhHÌyê…¤\Éàÿ‰ï}?…•`—j*O¤Ï…•ÿlIÒ¯„XtUámÿ‡¯–/wÖàƒYy™\nÿ›rtß´O_¾›7ßb?ÿo/dZ›rxof?¥¿hZ›rÿ|‘kO“+0¬n/o?¿pN›”•™ÿ—71—ß÷˜ï¶¾›2›¿½Ï߸êþ2¾¿*ϡߢèµðÀ?¤¿û¥Ï¦Ü2§Ï¨ßÆ/ªýïÈ_*/®?“I2°±Ê_¿³?»ñ´µ!ö—(2¸Oÿ¹_×›Ø_‹"¸ÛÞ3À/Á?!ö¢Ù3ÌoÍÿ!ö“¶â¯µ¿¶ÏÛ%Ø?ÿÙOè/›ROܾëï¸ÛUï÷àïÏ¢Ù4ÄÅÒ¾¦ÍÿY¾É?÷¯ªî]oãûß“ÿaÑ
Ó¾íræçëÿÿ—7lÿêߨù›
_îßÿïï¸ù¼
?òßóï
ˆõ¾ÿö¯/¦Ííúïûÿ«ß
Oÿ
/“:5_?
ño—75ÿ
O_)›²*ïoÿ¾².Ïo.{$¾¦Í6?O8¾ªý6ïo “+6"#<Ïÿ%¯.a'ÿ….R*¸‡?ûˆO›7ƒo/¯‹ÿM³†¾ÿ3¯^MÂ??ï’¾M¤&ï÷Ho,ß—77*¿K¿Z¾›ÿqOO^_¸ÛtÏRb?¢Ùþ867E¦Íx_;¯jÿªî|UïnO“qòp¾D/E?³h“color tbl;\¸àd04\g¸ánypy
ueê0y/eÌP5zZ{q{/ÿ|9zD|bzÏ~¾~]}ß|õz_e¾*8„*…A„ÿ† ÿzD†2„¾ˆoˆ-‡¯…߉¤þ9d ¼ô´Q†s´P„/|ׇˆ†Ð“*\dea!®ptá—’tqsÀl`ðØg10Û“âf†*”0Sh
”tnp”Ò ’Vpòa’ñqltàW ypápCypN°dctl–prK—p«
p’¡au¯0\<as–p—ÐO ˜ÒnuJm›Pa˜to˜Ðdjustápgh˜ÀOápyÑW yÑit–¤0a•à\noqV¡o
o˜te ¾@¨yln¤úh¸ðt¾@–ϗߘï™ÿ¾›¸Ða0as1tàþa“#i*£ð“¢W“óÌPñ¡°£d£“/”;` c¦0t°¦ó•ƒ”V¨ätàsÐnext£s½PxÐmotªV°ixЛ°y廒 O@t°9Bn*ªây’S£¡£¡`tÀÏ°vǽÐ
³°miht°’*Óo0
un®ñe¡yP¤ D¾„ PO0a¦0–¤h Font’DÞt£°` ±ð`Àw¨¤¡°¦f±ðWt°thBh
w¡°–p®l” mг„r¹³øfl³f²Ðµgbµg~r³ay
› ya·d p‚e³ascell¸‘÷³0²Ñ·Ás®`xàÏ‘±á×ÇP´¤º&lº5bº5¾ùºDdg»&¼*¼&£pºDþv–¯¸Ï¾ß*ï¡ÿ£¦Tÿ¤¥¦¾”ˆ¨O•+ª$²ÿ®¯˜ª¨¬äv¤ý@*GÆ®ÃüÃÁÆJÀpxfûi¤ªbÀ°yP±`*ÂË/̘¬$†°Þñ9´
H߸Q»› Þs*ƒ6ÏÐ/ÿÑ;¬ÀÒ/Ó?ÔOÕR±P¸àÿ²pyPÕ¾ÑòÖVàÆ<÷Ç‚ÑЛAoßâÇÚðßáùĶdbã—ÆÙïÚ÷Õ±s±`Íñ
x*mpo°Ü/ E-Mai¶l±PªòvxÐÇÀg†*n7xS’¤ðàvxñ½àUóÖ
½0wnêV¬Qêòìÿ¬ƒìBÐHàMàtp¬CHà/|àýáÔÊñ1m«hPW¿ÐïñR3l0møàkFB›"ñSubñqs÷*éPý
cñqtÀÀÀ°1I` mlé rgñSr³ó×’¡Jcó‘¿òI·*¾yÀOpù°ñq› tLn`Sñqpryö±1’Sx}ó°nÂ`ë÷Ô£À°tpp://¸°pÀæð²Ð.çq¦/úPfý0e/wxÐ|d/L ”0û3ó°x`\k–q¹Ðw†°2öAüshïlñqóá³à4i¤ýã´·þVöþeb²ðÑgÁàý½Àr›AÂp°¿¤tà’¡ù›Àb7´¿Q²p¿¤»ñ²ÐnbjÀ*yÀ®âÀ“ã`¸Phh½°z4|àû²¡òÐk½*®`à0TªÔ!°Çá’±`½±ñ
yPs¼ysªÐ±p¾ñ¸Ðy±`¸vó°yp8›agd«zayrfaêÐõñ¹qvWñªPó°` `²pp÷ÇÀ¸Ààl³ ªR›*ÉûxÐÚÁxyPx*±põñypüsa®`›
3և
Q¿÷á¹Ð`ÀO@` ½0xÇÀ©ùoyyÀ\ªPp`xàa
½0Àq»ÀÀ¤d÷±py
øbä@½!ÀÁ¸ÀߪÑÑ¡ªÒ` eã`xоzb¼*ýò› ñh3óqàñgvÉ› ÿÇ!BDóaÓ.j!`ðÉ@vF wkÿ·‘p`2¸°W”Áý
’³¨&‹,’Y‹/‹?’x›jà±Ù
[›]гé±é#›_›o²·¨$«
¢´ª*«[«k2««¢±Ú±Ú$±Ú%J«>³ú ±ú!±ú"
Function sendRequestToBox(dialCode As String, fonanschluss As Integer) As String
Dim http As New WinHttpRequest
Dim FormData
Dim WinHTTPPostRequest
Dim ResponseInfo As String
Dim login_sid
Dim BeginC
Dim LenC
Dim Challenge
Dim BeginS
Dim LenS
Dim SID
Dim Response
'Open URL As POST request
http.Open "POST", "http://fritz.box/cgi-bin/webcm", False
'Challenge-Code auslesen
http.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
http.Send URLEncoder("getpage") & "=" & URLEncoder("../html/login_sid.xml")
login_sid = http.ResponseText
BeginC = InStr(1, login_sid, "<Challenge>") + 11
LenC = InStr(11, login_sid, "</Challenge>") - BeginC
Challenge = Mid(login_sid, BeginC, LenC)
BeginS = InStr(1, login_sid, "<SID>") + 11
LenS = InStr(11, login_sid, "</SID>") - BeginS
SID = Mid(login_sid, BeginS, LenS)
If Val(SID) = 0 Then
'Anmelden erforderlich
'MD5 aus Challenge & Kennwort generieren
Response = Challenge & "-" & CalculateMD5(Challenge & "-" & FBOX_PASSWORD)
'http.Open "POST", "http://fritz.box/cgi-bin/webcm", False
'http.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
[B]Variante1[/B] FormData = URLEncoder("getpage") & "=" & URLEncoder("../html/de/menus/menu2.html") & _
"&" & URLEncoder("login:command/response") & "=" & Response
[B]Variante2[/B] FormData = "getpage=../html/de/menus/menu2.html&login:command/response=" & Response
'Send the form data To URL
On Error GoTo catch ' Fehler abfangen
http.Send FormData
On Error GoTo 0 ' Fehler nicht mehr abfangen
' http.Send URLEncoder("getpage") & "=" & URLEncoder("../html/login_sid.xml")
login_sid = http.ResponseText
[B][COLOR="Red"]Hier kommt dann immer der Response mit "Kennwort falsch" zurück.[/COLOR][/B]
If InStr(1, login_sid, "FEHLER:") <> 0 Then
'Fehler
MsgBox "Fehler !"
End If
Else
'Daten direkt senden
End If
[B][I][COLOR="Red"] ...
[/COLOR][/I][/B]
End Function
Public Function MD5_string(strMessage As String) As String
Dim abMessage() As Byte
Dim mLen As Long
If Len(strMessage) > 0 Then
[COLOR="Red"]'[/COLOR]abMessage = StrConv(strMessage, vbFromUnicode)
[COLOR="Red"]abMessage = strMessage[/COLOR]
mLen = UBound(abMessage) - LBound(abMessage) + 1
End If
MD5_string = [COLOR="Green"]StrConv([/COLOR]MD5_bytes(abMessage, mLen)[COLOR="Green"], vbLowerCase)[/COLOR]
End Function
Sub Test()
Dim pw As String
pw = "1234567z-äbc"
Debug.Print MD5_string(pw)
End Sub
'VB.NET Visual Studio 2008
'MD5 Hashwert für FritzBox 7270 Passwort ermitteln.
'Achtung, zum Testen Button in Form1 anlegen!
'9e224a41eeefa284df7bb0f26c2913e2 richtig bei Passwort: 1234567z-äbc
'f2e389d88b47eb020d46b647dc1d72dd falsch bei Passwort: 1234567z-äbc
'd41d8cd98f00b204e9800998ecf8427e bei Leerstring ist dies immer der Hashwert
Public Class Form1
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
MsgBox(MD5HashFB("1234567z-äbc"))
'MsgBox(MD5HashFB(""))
End Sub
Public Function MD5HashFB(ByVal outStr As String) As String
Dim data() As Byte = System.Text.Encoding.Unicode.GetBytes(outStr)
Dim md5 As New System.Security.Cryptography.MD5CryptoServiceProvider()
outStr = Nothing
Dim tempStr As String = Nothing
Dim result As Byte() = md5.ComputeHash(data)
For i As Byte = 0 To 15
tempStr = LCase(Hex(result(i)))
outStr = outStr & tempStr
Next i
Return outStr
End Function
End Class
Ja aber nicht mit VBA, oder? Hast du das Visual Studio 2008? Und hättest du Lust auch an Version 3.0 mitzuwirken?Das funktioniert auch, hab ein bischen gefummelt.
Code:'VB.NET Visual Studio 2008 [...]
result = CryptHashData(HashHandle, ByteText(0), Len(Text), 0)
'
PRIVATE DECLARE FUNCTION CryptAcquireContext LIB "advapi32.dll" _
ALIAS "CryptAcquireContextA" ( _
BYREF phProv AS LONG, _
BYVAL pszContainer AS STRING, _
BYVAL pszProvider AS STRING, _
BYVAL dwProvType AS LONG, _
BYVAL dwFlags AS LONG) AS LONG
'
PRIVATE DECLARE FUNCTION CryptReleaseContext LIB "advapi32.dll" ( _
BYVAL hProv AS LONG, _
BYVAL dwFlags AS LONG) AS LONG
'
PRIVATE DECLARE FUNCTION CryptCreateHash LIB "advapi32.dll" ( _
BYVAL hProv AS LONG, _
BYVAL Algid AS LONG, _
BYVAL hKey AS LONG, _
BYVAL dwFlags AS LONG, _
BYREF phHash AS LONG) AS LONG
'
PRIVATE DECLARE FUNCTION CryptDestroyHash LIB "advapi32.dll" ( _
BYVAL hHash AS LONG) AS LONG
'
PRIVATE DECLARE FUNCTION CryptHashData LIB "advapi32.dll" ( _
BYVAL hHash AS LONG, _
pbData AS BYTE, _
BYVAL dwDataLen AS LONG, _
BYVAL dwFlags AS LONG) AS LONG
'
PRIVATE DECLARE FUNCTION CryptGetHashParam LIB "advapi32.dll" ( _
BYVAL hHash AS LONG, _
BYVAL dwParam AS LONG, _
pbData AS ANY, _
pdwDataLen AS LONG, _
BYVAL dwFlags AS LONG) AS LONG
'
' PwdMd5_VBA.bas 27.07.2009
'
Public FUNCTION makeDots(sInStr AS STRING) AS STRING
' Unicode Zeichen die >255 (8364 = ¤) sind mit 46(.) ersetzen
'
DIM nTmp AS LONG
DIM sUstr AS STRING
'
sUstr = sInStr
'
FOR nTmp = 1 TO LEN(sUstr)
IF AscW(MID$(sUstr, nTmp, 1)) > 255 THEN
MID$(sUstr, nTmp) = "."
END IF
NEXT nTmp
'
makeDots = sUstr
'
END FUNCTION
'
'
Public FUNCTION InMD5(sTEXT AS STRING) AS STRING
'
DIM AcquireContext AS LONG
DIM HashHandle AS LONG
DIM result AS LONG
DIM LaengeResult AS LONG
DIM Zaehler AS INTEGER
'
DIM sTmp AS STRING
DIM nTmp1 AS LONG
DIM nTmpLen AS LONG
'
' sTEXT = "1234567z-äbc" ' eingabe
'
sTmp = StrConv(sTEXT, vbUnicode)
'
REDIM ByteText(0 TO LEN(sTmp)) AS BYTE
'
FOR nTmp1 = 0 TO (LEN(sTmp) - 1)
ByteText(nTmp1) = AscB(MID$(sTmp, (1 + nTmp1), 1))
NEXT nTmp1
'
nTmpLen = LEN(sTmp)
'
'Ermittle Context Handle
result = CryptAcquireContext(AcquireContext, vbNullString, vbNullString, 1, 0)
'
IF result = 0 AND Err.LastDllError = &H80090016 THEN
result = CryptAcquireContext(AcquireContext, vbNullString, _
vbNullString, 1, &H8)
END IF
'
result = CryptCreateHash(AcquireContext, 32771, 0, 0, HashHandle)
'
result = CryptHashData(HashHandle, ByteText(0), nTmpLen, 0)
'
result = CryptGetHashParam(HashHandle, 4, LaengeResult, 4, 0)
'
REDIM ByteResult(0 TO LaengeResult - 1) AS BYTE
'
result = CryptGetHashParam(HashHandle, 2, ByteResult(0), LaengeResult, 0)
'
FOR Zaehler = 0 TO UBOUND(ByteResult)
InMD5 = InMD5 & RIGHT$("0" & HEX$(ByteResult(Zaehler)), 2)
NEXT Zaehler
'
CryptDestroyHash HashHandle
CryptReleaseContext AcquireContext, 0
'
END FUNCTION
'