[Monkey]

Hey,
in the bèta versions of msn6 there was an xml file in the directory "C:\Documents and Settings\Monkey\Application Data\Microsoft\MSN Messenger\3551294161" (integer and Monkey are other on other comps) this was easy to read, harder to change, but I only want to read it, but now it's an map.dat file with only weird characters. :blink:
Somebody how I can read this with Visual Basic?
I need it to backup your emoticons with shortcuts and names, so another solution with same effect would be fine too. :rolleyes:

[Monkey]

http://www.mvps.org/...o/protect.shtml
Is that what I need, if so, CrypyProtectPromptFlags does not exsists and google gives only one founded result when searching on that, which is that page itself. ;)

[Daniel]

http://www.msnfanati...t=0&#entry70291

[Monkey]

daniel, on Aug 1 2004, 01:19 PM, said:

http://www.msnfanati...t=0&#entry70291

:huh: I don't understand much about that :(
Like: What's an "DATA_BLOB"
Searching gave:
Private Structure DATA_BLOB
Public cbData As Integer
Public pbData As IntPtr
End Structure
Which gives another error that End of Statement is expected.
Then CryptUnprotectData is an function from that other file which has an "CrypyProtectPromptFlags" Which gives errors too. :(
Where can I find all those declarethings? :unsure:

[Daniel]

http://www.activevb....iviewereng.html

[Monkey]

daniel, on Aug 1 2004, 02:16 PM, said:

http://www.activevb....iviewereng.html

Euh, I've downloaded that thing but I still can't find the DATA_BLOB or that other thing in any of the files Win16api.apv Win32api.apv or WinCEapi.apv :unsure:
I guess I never get this to work. :( Thnx 4 helping anyway.:thanx:
Maybe another idea to get emoticon keys with the images:
Use SendMessages to open Custom Emoticons, make it Edit an emoticon, read the textboxes... but then I need to get the content of the image, is there an way to do that? like WM_GETTEXT but then as WM_GETIMAGE? :unsure:

[Daniel]

Ohhh you're right data blog isn't in there :S

Private Declare Function CryptUnprotectData Lib "crypt32.dll" (ByRef r_udtDataIn As DATA_BLOBType, ByVal v_sDataDescr As String, ByRef r_udtOptionalEntropy As DATA_BLOBType, ByRef r_sReserved As String, ByRef r_sPromptStruct As String, ByVal v_lFlags As Long, ByRef r_udtDataOut As DATA_BLOBType) As Long
Private Declare Function CryptProtectData Lib "crypt32.dll" (ByRef r_udtDataIn As DATA_BLOBType, ByVal v_sDataDescr As String, ByRef r_udtOptionalEntropy As DATA_BLOBType, ByRef r_sReserved As String, ByRef r_sPromptStruct As String, ByVal v_lFlags As Long, ByRef r_udtDataOut As DATA_BLOBType) As Long

Private Type DATA_BLOBType
   lDataLen As Long
   lData As Long
End Type

I've renamed a few things to my standards though so make sure you match them.

[Monkey]

daniel, on Aug 1 2004, 03:00 PM, said:

Ohhh you're right data blog isn't in there :S

Private Declare Function CryptUnprotectData Lib "crypt32.dll" (ByRef r_udtDataIn As DATA_BLOBType, ByVal v_sDataDescr As String, ByRef r_udtOptionalEntropy As DATA_BLOBType, ByRef r_sReserved As String, ByRef r_sPromptStruct As String, ByVal v_lFlags As Long, ByRef r_udtDataOut As DATA_BLOBType) As Long
Private Declare Function CryptProtectData Lib "crypt32.dll" (ByRef r_udtDataIn As DATA_BLOBType, ByVal v_sDataDescr As String, ByRef r_udtOptionalEntropy As DATA_BLOBType, ByRef r_sReserved As String, ByRef r_sPromptStruct As String, ByVal v_lFlags As Long, ByRef r_udtDataOut As DATA_BLOBType) As Long

Private Type DATA_BLOBType
   lDataLen As Long
   lData As Long
End Type

I've renamed a few things to my standards though so make sure you match them.

those lDataLen and lData are in that other code cbData or cpData or something. :huh:
udtPw.cbData = UBound(abytPassword) + 1
udtPw.pbData = VarPtr(abytPassword(0))
and "sPassword"... do I need their password to open it? :blink:

[Daniel]

check out this topic: http://www.msnfanati...?showtopic=6910

password for map files is the email address

Private Type DATA_BLOB
   cbData As Long
   pbData As Long
End Type

[Monkey]

daniel, on Aug 1 2004, 03:30 PM, said:

check out this topic: http://www.msnfanati...?showtopic=6910

password for map files is the email address

Private Type DATA_BLOB
   cbData As Long
   pbData As Long
End Type

It now opens an dialog that says something like: "There is an application that asks access to an protected file."
줧⬂筎耄Ⴀㄔᝣ垙ど풍㼴思矍Ǡ￁⽪㡗饱뤇梿邩ﻬ炊㸱桷馒߀잢⾨ᘱ쵮㵠킾宂ά䲍䒏修垈ᏹ雁変懫傠蚺䖯�뭓专쵔嬭㤻ᤈೕ忐쪾变퍧苮蘻⢐��ℷ咒핇癆㮝愰疘ø瓗# Ā浨‴
and then my own project says "Base64Decode", "Bad Base64 string." :unsure:

[Daniel]

change

abytDataIn = StrConv(sData, vbFromUnicode)

to

abytFileData = StrConv(Mid$(r_sData, 3), vbFromUnicode)

and scream in pleasure.

[Monkey]

daniel, on Aug 1 2004, 03:51 PM, said:

change

abytDataIn = StrConv(sData, vbFromUnicode)

to

[b]abytFileData[/b] = StrConv(Mid$([b]r_sData[/b], 3), vbFromUnicode)

and scream in pleasure.

those new variables arent used anywhere else so I think those need to be same as previous? That only change is Mid$(sData, 3)? If so, still doesn't work. :(
Maybe there is something wrong with how I read the file?

   Dim MapDat As String, Tmp1 As String
    Open "C:\map.dat" For Input As #1
     Line Input #1, Tmp1
     If MapDat = "" Then
      MapDat = Tmp1
     Else
      MapDat = MapDat & vbCrLf & Tmp1
     End If
    Close #1
    sData = MapDat

That it's not good if you do the data as string or something? :unsure:

[Daniel]

Sorry didnt look hard enough at what I was posting.

change

abytDataIn = StrConv(sData, vbFromUnicode)

to

abytDataIn = StrConv(Mid$(sData, 3), vbFromUnicode)

This is a bit like what I use:

Dim abytFileData()  As Byte

    Open g_sStoreDir & "\UserTile\Map.dat" For Binary As #1
        ReDim abytFileData(0 To LOF(1) - 1)
        Get #1, , abytFileData()
    Close #1

    sData = StrConv(abytFileData(), vbUnicode)

[Monkey]

daniel, on Aug 1 2004, 04:22 PM, said:

abytDataIn = StrConv(Mid$(sData, 3), vbFromUnicode)

Weird, when I replace that sData with Mid$(sData, 3) and try to run it Visual Basic just crashes. :blink:
It asks about sending error report and shuts Visual Basic down. :(

It crashes when executing line:

Call CopyMemory(abytDataOut(0), ByVal udtDataOut.pbData, udtDataOut.cbData)

I've declared that function as

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

:unsure:

This post has been edited by Monkey: 01 August 2004 - 04:21 PM

[SmallCoder]

why dont you just post the code you have this far ?

[Monkey]

SmallCoder, on Aug 1 2004, 05:25 PM, said:

why dont you just post the code you have this far ?

It's still some copied things in an test project to see how it works...

Form1:

Private Type DATA_BLOB
  cbData As Long
  pbData As Long
End Type
Private Declare Function CryptUnprotectData Lib "crypt32.dll" (ByRef r_udtDataIn As DATA_BLOB, ByVal v_sDataDescr As String, ByRef r_udtOptionalEntropy As DATA_BLOB, ByRef r_sReserved As String, ByRef r_sPromptStruct As String, ByVal v_lFlags As Long, ByRef r_udtDataOut As DATA_BLOB) As Long
Private Declare Function CryptProtectData Lib "crypt32.dll" (ByRef r_udtDataIn As DATA_BLOB, ByVal v_sDataDescr As String, ByRef r_udtOptionalEntropy As DATA_BLOB, ByRef r_sReserved As String, ByRef r_sPromptStruct As String, ByVal v_lFlags As Long, ByRef r_udtDataOut As DATA_BLOB) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Private Sub Command1_Click()
    
    Dim abytPassword() As Byte
    Dim abytDataIn() As Byte
    Dim abytDataOut() As Byte
    Dim udtDataOut As DATA_BLOB
    Dim udtDataIn As DATA_BLOB
    Dim udtPw As DATA_BLOB
    Dim abytFileData()  As Byte
    Open "C:\map.dat" For Binary As #1
       ReDim abytFileData(0 To LOF(1) - 1)
       Get #1, , abytFileData()
    Close #1
    sPassword = LongString(Calculate(LCase$("myemail@hotmail.com")))
    sData = StrConv(abytFileData(), vbUnicode)

    abytPassword = StrConv(sPassword, vbFromUnicode)
    udtPw.cbData = UBound(abytPassword) + 1
    udtPw.pbData = VarPtr(abytPassword(0))
   
    abytDataIn = StrConv(Mid$(sData, 3), vbFromUnicode)
    udtDataIn.cbData = UBound(abytDataIn) + 1
    udtDataIn.pbData = VarPtr(abytDataIn(0))
   
    Call CryptUnprotectData(udtDataIn, vbNullString, udtPw, ByVal vbNullString, ByVal vbNullString, 0, udtDataOut)
    
    ReDim abytDataOut(udtDataOut.cbData) As Byte
    Call CopyMemory(abytDataOut(0), ByVal udtDataOut.pbData, udtDataOut.cbData)'Crashes here
    Debug.Print StrConv(Base64Decode(StrConv(abytDataOut, vbUnicode)), vbFromUnicode)
End Sub

Public Function LongString(i As Variant) As String
LongString = i & ""
End Function

Public Function Calculate(id As String) As Variant
Calculate = CDec(0)
Dim i As Integer
For i = 1 To Len(id)
   Calculate = AddWrap(MulWrap(Calculate, CDec(101)), CDec(Asc(Mid$(id, i, 1))))
Next
End Function

Private Function ToLong(a As Variant) As Variant
Dim MaxVal As Variant: MaxVal = CDec(4294967296#)
ToLong = a
Do While ToLong > MaxVal
   ToLong = ToLong - MaxVal
Loop
End Function

Private Function MulWrap(a As Variant, b As Variant) As Variant
MulWrap = ToLong(a * b)
End Function

Private Function AddWrap(a As Variant, b As Variant) As Variant
AddWrap = ToLong(a + b)
End Function

Module1:

Public Function Base64Decode(ByVal base64String)
  'rfc1521
  '1999 Antonin Foller, PSTRUH Software, http://pstruh.cz
  Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
  Dim dataLength, sOut, groupBegin
  
  'remove white spaces, If any
  base64String = Replace(base64String, vbCrLf, "")
  base64String = Replace(base64String, vbTab, "")
  base64String = Replace(base64String, " ", "")
  
  'The source must consists from groups with Len of 4 chars
  dataLength = Len(base64String)
  If dataLength Mod 4 <> 0 Then
    Err.Raise 1, "Base64Decode", "Bad Base64 string."
    Exit Function
  End If

  
  ' Now decode each group:
  For groupBegin = 1 To dataLength Step 4
    Dim numDataBytes, CharCounter, thisChar, thisData, nGroup, pOut
    ' Each data group encodes up To 3 actual bytes.
    numDataBytes = 3
    nGroup = 0

    For CharCounter = 0 To 3
      ' Convert each character into 6 bits of data, And add it To
      ' an integer For temporary storage.  If a character is a '=', there
      ' is one fewer data byte.  (There can only be a maximum of 2 '=' In
      ' the whole string.)

      thisChar = Mid(base64String, groupBegin + CharCounter, 1)

      If thisChar = "=" Then
        numDataBytes = numDataBytes - 1
        thisData = 0
      Else
        thisData = InStr(1, Base64, thisChar, vbBinaryCompare) - 1
      End If
      If thisData = -1 Then
        Err.Raise 2, "Base64Decode", "Bad character In Base64 string."
        Exit Function
      End If

      nGroup = 64 * nGroup + thisData
    Next
    
    'Hex splits the long To 6 groups with 4 bits
    nGroup = Hex(nGroup)
    
    'Add leading zeros
    nGroup = String(6 - Len(nGroup), "0") & nGroup
    
    'Convert the 3 byte hex integer (6 chars) To 3 characters
    pOut = Chr(CByte("&H" & Mid(nGroup, 1, 2))) + _
      Chr(CByte("&H" & Mid(nGroup, 3, 2))) + _
      Chr(CByte("&H" & Mid(nGroup, 5, 2)))
    
    'add numDataBytes characters To out string
    sOut = sOut & Left(pOut, numDataBytes)
  Next

  Base64Decode = sOut
End Function

[Daniel]

Eh. sPassword just needs to be the email, not the id.

sPassword = LCase$("myemail@hotmail.com")

[Monkey]

daniel, on Aug 2 2004, 06:35 AM, said:

Eh. sPassword just needs to be the email, not the id.

sPassword = LCase$("myemail@hotmail.com")

W00t thnx, it works :w00t:
That was the problem why it crashed and after that I replaced the base64decode function that keeps saying the string was bad or something with http://www.vyomworld...asp?ScriptID=86 that one.
:thanx:

[unruledboy]

unruledboy, on Nov 14 2005, 12:19 PM, said:

not working here! :(

after the follow code:

Call CryptUnprotectData(udtDataIn, vbNullString, udtPw, ByVal vbNullString, ByVal vbNullString, 0, udtDataOut)

the udtDataOut.cbData=0 and udtDataOut.pbData=0

<_<

sorry, not seeing the last post, now it works! you guys are genius!

This post has been edited by unruledboy: 14 November 2005 - 06:23 AM

[unruledboy]

there is always only one record in each map.dat, even though there are many TFR*.dat.

any one has any idea?