Outlook Wählhilfe (Makro) ohne Box zu modifizieren

[zirkon]

Bei Sessions wird das mit command/password auch nicht funktionieren

 

[Ford Prefect]

Genau das ist meine Frage. Ich versteh nicht wie Bin Wech mit dem aktuellem Makro und der neuen Firmware arbeiten kann.

 

[mats58]

Hab auch das Problem seit der neuen FW bzw. bei den Laborversionen
=> Login geht wohl nicht ohne Session-ID
Kann man das irgendwie anpassen??

__________________
Fritz!Box Fon WLAN 7270 / 54.04.76
DSL: (noch) 1&1~4DSL(6.000) - VoIP
Notebook: WinXP-SP3
Outlook 2003

 

[Kruemelino]

Hallo zusammen,

ich geb euch mal fix einen Fahrplan:

1. Alle Interaktionen mit der Fritz!Box über UTF-8 durchführen
2. http://fritz.box/cgi-bin/webcm?getpage=../html/login_sid.xml herunterladen
3. Die xml Auswerten. IsWriteAccess gibt Ausgunft inwiewieweit ein Login mit passwort erforderlich ist. Wenn nicht (1), dann steht die sid bereits in der xml (man wäre schon fertig)
4. Wenn da eine 0 steht beginnt jetzt der Spaß:
5. Die Challenge aus der xml auslesen
6. Einen MD5-Hash generieren. Das wird den größten Aufwand machen. Ich hab noch nicht gesucht wie es im vba funktioniert. (google)
   Ein String muss in diesen MD5-Hash umgewandelt werden. Er setzt sich zusammen aus dem Challenge, einem Bindestrich und dem Klartextpasswort.
7. Zu guterletzt erstellen wir uns den Response. Der besteht aus demr Challenge, einem Bindestrich und dem gerade generiertem MD5-Hash
8. Jetzt schauen wir nach der SessionID (Ziel des ganzen)
   Die finden wir Login etwas abwandeln:
   formdata = "getpage=../html/de/menus/menu2.html&login:command/response=" & Response
   Der Login funktioniert wie Ford Prefect um 15:38 beschrieben hat. (Nur halt formdata ändern)
9. die SessionID finden wir in der Rückgabe Text

Jetzt haben wir den Gral.

Jeder Aufruf in der Fritz!box wird die SessionID angehangen:

z.b:

"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

das Rote klein schreiben! Sonnst war es für die katz

Ein Blick wert!

Es gibt diverse Anpassungen zu Treffen. Jede Funktion die auf die FB zugreift benötigt eine SID. Also muss sie übergeben werden. Desweiteren wäre ein Logout prima...

Gruß Kruemel

 

[bin-wech]

Oh jee was soll ich sagen. Von der ganzen Programmierung habe ich keinen Schimmer.
Bei mir läuft die Version 3.00 rc3.
Unter Einstellungen zeigt er mir keine Firmwareversion der FritzBox Warum auch immer.
Ich habe lediglich in der ini-Datei die ganzen Telefone eingetragen.
Als Passwort steht in der ini lauter verwirrendes

TBPasswort=DvuTg00uPgsy0bLq/SLSOA==

In der Mitte der ini habe ich noch mal so einen Salat:

«À
ÀÀÀ
ÀÀÀ
ÀÀÀ
ÀÀÀ
ÀÀÀ
ÀÀÀ
ÀÀÀ
ÀÀÀ
ÀÀÀ
ÀÀÀ
ÀÀÀ
ÀÀÀ
ÀÀÀ
ÀÀÀ
ÀÀÀ
ÕÀÀ
ÿÿê¶ÿÿÿÿÿÿÿÿÿÿÿÿÊàõÛÀÀÀ
ÀÀÀ
ÕÀÀ
ÿÿê¶ÿÿÿÿÿÿÿÿÿÿÿÿÀÕê¶ÀÀÀ
ÀÀÀ
ÕÀÀ
õÿê¶ÀÊàÀÀÀ
ÕÀÀ
ÿÿê¶ÕêÿÿÀÀÀ
ÕÀÀ
õÿê¶ÀÊàÀÀÀ
ÀÀÀ
ÀÀÀ
ÀÀÀ
ÀÀÀ
ÕÀÀ
õÿê¶ÀÊàÀÀÀ
ÀÀÀ
àÊÀ
êÿõÛÀÀÕ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«>³ú ±ú!±ú"


Bei Bedarf kann ich dir ja mal die ini zukommen lassen oder dich über ein Prog. in meinen PC schaun lassen.
Vielleicht kommst du da mit dem ganzen etwas besser klar als ich.

 

[Kruemelino]

der käse kann gelöscht werden

 

[McShark]

MD5 in VBA (Geschwindigkeit ist etwas zweitrangig, da das ja nicht ständig gemacht werden muss, oder?), als "eigene Implementation" (von DrSoong auf tuturials.de) und schneller über die Windows eigene advapi.dll (ob die vor WinXP bereits da ist - keine Ahnung).

Hast du auch schon einen zeitlichen Fahrplan?

McShark

 

[Kruemelino]

Ich geh mit großen Schritten auf die Prüfungszeit zu. Dieste ist am 14. August vorbei. Vorher wird sicher nicht sehr viel passieren.

 

[funpager]

ohja, warte auch schon sehnsüchtig auf das update...

 

[rkltbg]

Box will Passwort nicht akzeptieren

Hallo Leute,

ich habe eine 7270 mit aktueller Firmware mit SessionID. Ich habe eine eigene Anwendung auf Basis des FBDial-Makros und nun das Problem, dass die Box sicher weigert mein Passwort mit dem modifizierten Verfahren zu akzeptieren (Meldung: Passwort fehlerhaft im HTML-Response).

Hat einer ne Idee woran es liegen könnte?

 

[Deltafox]

Wird doch weiter oben erklärt, warum.

 

[rkltbg]

ich schrieb "modifiziertes Verfahren" also sprich nach "Fahrplan" für die neue Anmeldung mit Session-ID und Challenge und MD5.

Ich habe alles mehrfach überprüft und ich bewege die Box einfach nicht dazu mich zu autorisieren. Habe mir auch die Unterlagen von AVM zu dem Thema mehrfach durchgelesen und gerade das Challenge-Passwort-MD5-Konstrukt mehrfach überprüft. Es geht alles so zur Box wie es hier und auch in der Anleitung von AVM geschrieben steht, trotzdem meldet die Box "falsches Passwort".

Nun nochmals die Frage ... hat einer eine Idee an welcher Stelle ich den Fehler suchen könnte? Hat es jemand mit dem "Fahrplan" geschafft?

 

[SagHalt]

Hmm, poste vielleicht doch einfach mal deinen Code. Ist etwas einfacher zur Analyse ;-)

 

[Kruemelino]

ja ich habs geschaft

das einfachste ist wirklich, wenn du mal den code rüberschiebst. Ich weiß wirklich nicht was dein Programm macht und was nicht.

mfg Kruemel

edit: Juhu mein 300. Beitrag

 

[rkltbg]

Da würde mich ja mal interessieren wie du es hinbekommen hast. Mein Code sieht so aus ...

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

Irgendwelche Ideen, wo das Problem liegen könnte? Oder kannst du deinen Code mal posten oder mailen, dann kann ich selbst auch nochmal nach dem feinen Unterschied suchen.

 

[Kruemelino]

ich vermute dein MD5 wird falsch generiert. Wenn du "1234567z-äbc" reingibst, sollte nicht f2e389d88b47eb020d46b647dc1d72dd rauskommen, sondern 9e224a41eeefa284df7bb0f26c2913e2.

Ich hab mich heute mal länger drangesetzt und probiert.

Also der MD5 Hash generiere ich folgendermaßen:
McShark hat die "eigene Implementation" (von DrSoong auf tuturials.de) vorgeschlagen (vgl Beitrag 967). Allerdings muss die angepasst werden (Änderungen farbig):

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

Die Rote Änderung bearbeitet den String, damit da die richtige MD5 Hash rauskommt.
Die Grüne hingegen wandelt alle Großbuchstaben des HASH-Wertes in Kleinbuchstaben um. (AVM will das so, und warum DrSoong-Rechnung Großbuchstaben rausschmeißt, weiß ich nicht)
Die Routine

Sub Test()
Dim pw As String
pw = "1234567z-äbc"
Debug.Print MD5_string(pw)
End Sub

gibt 9e224a41eeefa284df7bb0f26c2913e2 aus, was dem Beispiel aus dem Technical Note entspricht.

btw: Die Version 3. verwendet die .Net Klassen, daher mache ich das da ganz anders. Deshalb hat es auch eine Weile gedauert, bis ich es raus hatte.

ich hoffe ich konnte Helfen

 

[Deltafox]

MD5 Hash für FritzBox 7270 mit VB.NET 2008

Das funktioniert auch, hab ein bischen gefummelt.

'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

 

[rkltbg]

Danke an Kruemelino ...

Das war die Lösung ... der MD5-Hash war falsch generiert. Jetzt erkennt mich meine FB tatsächlich auch via VB.

Klasse Forum.

 

[Kruemelino]

Das funktioniert auch, hab ein bischen gefummelt.

'VB.NET  Visual Studio 2008
[...]

Ja aber nicht mit VBA, oder? Hast du das Visual Studio 2008? Und hättest du Lust auch an Version 3.0 mitzuwirken?

 

[Pikachu]

Hallo,

Ich befasse mich nicht mit Outlook auch nicht mit VBA oder (Dot.Net müll )

Der Link oben zu VBA für MD5 habe ich mal getestet
aber in einer anderen Programmiersprache, dabei habe
ich festgestellt dass hier:

result = CryptHashData(HashHandle, ByteText(0), Len(Text), 0)

ein Fehler ist, denn Len(Text) hat die Länge der Eingabe und
nicht die Länge nach dem es zu Unicode konvertiert wurde,
wenn du hier das (Len(Text) * 2) einsetzt dann sollte es klappen.

Hier ein Beispiel Code zu VBA aber nicht getestest:

'
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
'

Geändert 27.07.2009 in VBA unter Word getestet
11.08.2009 @Kruemelino habe den Leichtsinnsfehler korrrigiert

:-Ö

Gruß Erwin