Outlook Wählhilfe (Makro) ohne Box zu modifizieren

"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

«À
ÀÀÀ
ÀÀÀ
ÀÀÀ
ÀÀÀ
ÀÀÀ
ÀÀÀ
ÀÀÀ
ÀÀÀ
ÀÀÀ
ÀÀÀ
ÀÀÀ
ÀÀÀ
ÀÀÀ
ÀÀÀ
ÀÀÀ
ÕÀÀ
ÿÿê¶ÿÿÿÿÿÿÿÿÿÿÿÿÊàõÛÀÀÀ
ÀÀÀ
ÕÀÀ
ÿÿê¶ÿÿÿÿÿÿÿÿÿÿÿÿÀÕê¶ÀÀÀ
ÀÀÀ
ÕÀÀ
õÿê¶ÀÊàÀÀÀ
ÕÀÀ
ÿÿê¶ÕêÿÿÀÀÀ
ÕÀÀ
õÿê¶ÀÊàÀÀÀ
ÀÀÀ
ÀÀÀ
ÀÀÀ
ÀÀÀ
ÕÀÀ
õÿê¶ÀÊàÀÀÀ
ÀÀÀ
àÊÀ
êÿõÛÀÀÕ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.{$¾&brvbar;Í6?O8¾ªý6ïo “+6"#<Ïÿ%¯.a'ÿ….R*&cedil;‡?ûˆO›7ƒo/¯‹ÿM³†¾ÿ3¯^MÂ??ï’¾M&curren;&ï÷Ho,ß—77*¿K¿Z¾›ÿqOO^_¸ÛtÏRb?¢Ùþ867E&brvbar;Í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ˆ-‡¯…߉&curren;þ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°&brvbar;󕃔V&uml;ätàsÐnext£
s½PxÐmotªV°ixЛ°y廒 O@t°9Bn*ªây’S£¡£
¡`tÀÏ°vǽÐ
³°miht°’*Óo0
un®ñe¡yP&curren; D¾„ PO0a¦0–¤h Font’DÞt£°` ±ð`Àw&uml;¤¡°¦f±ðWt°thBh
w¡°–p®l” mг„r¹³øfl³f²Ðµgbµg~r³ay
› ya·d p‚e³ascell¸‘÷³0²Ñ·Ás®`xàÏ‘±á×ÇP&acute;¤º&lº5bº5¾ùºDdg»&&frac14;*&frac14;&£pºDþv–¯¸Ï¾ß*ï¡ÿ£&brvbar;Tÿ&curren;¥&brvbar;¾”ˆ&uml;O•+ª$²ÿ®¯˜ª&uml;¬äv¤ý@*GÆ®ÃüÃÁÆJÀpxfûi¤ªbÀ°yP±`*ÂË/̘¬$†°Þñ9&acute;
 Hß&cedil;Q»› Þs*ƒ6ÏÐ/ÿÑ;¬ÀÒ/Ó?ÔOÕR±P&cedil;àÿ²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://&cedil;°pÀæð²Ð.çq¦/úPfý0e/wxÐ|d/L ”0û3ó°x`\k–q¹Ðw†°2öAüshïlñqóá³à4i¤ýã&acute;·þVöþeb²ðÑgÁàý½Àr›AÂp°¿¤tà’¡ù›Àb7&acute;
¿Q²p¿¤»ñ²ÐnbjÀ*yÀ®âÀ“ã`&cedil;Phh½°z4|àû²¡òÐk½*®`à0TªÔ!°Çá’±`½±ñ
yPs&frac14;ysªÐ±p&frac34;ñ&cedil;Ðy±`¸vó°yp8›agd«zayrfaêÐõñ¹qvWñªPó°` `²pp÷ÇÀ&cedil;Ààl³ ªR›*ÉûxÐÚÁxyPx*±põñypüsa®`› 
3և
Q¿÷á¹Ð`ÀO@` ½0xÇÀ©ùoyyÀ\ªPp`xàa
½0Àq»ÀÀ¤d÷±py
øbä@½!ÀÁ&cedil;ÀߪÑÑ¡ªÒ` eã`xÐ&frac34;zb&frac14;*ýò› ñh3óqàñgvÉ› ÿÇ!BDóaÓ.j!`ðÉ@vF wkÿ·‘p`2&cedil;°W”Áý
’³&uml;&‹,’Y‹/‹?’x›jà±Ù
[›]гé±é#›_›o²·¨$«
¢&acute;ª*«[«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

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
'