System Profile Keys

[Inner]

Code Select Expand

I've been trying to work on this for some time, and it's not showing it on my RTB. Here's some of my code:

When i send it:      
Case &HA
           Dim spltn() As String, strss As String
               spltn() = Split(data, Chr(0), 5)
               ConnectionUptime = GetTickCount()
               MODstatstring.ParseStatString spltn(2), strss
               AddC "BNET: Logged to B.net as, " & spltn(1) & "" & ", " & strss & "" & vbNewLine, &HFFFFC0
               varUser = spltn(1)
           Erase spltn()
       Call RequestInfoStats(varUser, varProduct)

Public Sub RequestInfoStats(strUsername As String, strProduct As String)
   With pbuffer
       .InsertDWORD &H1
       .InsertDWORD &HA
       .InsertDWORD GetTickCount()
       .InsertNTString varUser
       .InsertNTString "record\" & UCase$(strProduct) & "\0\wins"
       .InsertNTString "record\" & UCase$(strProduct) & "\0\losses"
       .InsertNTString "record\" & UCase$(strProduct) & "\0\disconnects"
       .InsertNTString "record\" & UCase$(strProduct) & "\0\last GAME"
       .InsertNTString "record\" & UCase$(strProduct) & "\0\last GAME result"
       .InsertNTString "system\username"
       .InsertNTString "system\account created"
       .InsertNTString "system\last logon"
       .InsertNTString "system\last logoff"
       .InsertNTString "system\time logged"
       .sendPacket &H26
   End With
End Sub

Parsing it:
Case &H26
                  Dim x As Integer
                  Dim ProfileEnd As String
                  Dim splitprofile() As String
                  Dim splta() As String, splts() As String, spltl() As String, spltd() As String
                       ProfileEnd = Mid(data, 17, Len(data))
                       If ProfileEnd = "" Then Exit Sub
                       splitprofile = Split(ProfileEnd, Chr(0))
                       Profile.txtsex.Text = splitprofile(0)
                       Profile.txtlocation.Text = splitprofile(2)
                       Profile.txtdes.Text = splitprofile(3)
       ParseKeys data

Public Sub ParseKeys(strdata As String)
Dim strRest As String
Dim sysUsername As String
Dim sysAcctCreated As String
Dim sysLastLogon As String
Dim sysLastLogoff As String
Dim sysTimeLogged As String

Dim i As Integer
Dim splt() As String
Dim strTime As String

Dim FT As FILETIME
Dim ST As SYSTEMTIME

   strRest = Mid$(strdata, 17) ' Get the data past the header and other information '
   
   If Mid$(strdata, 9, 1) = Chr(10) Then ' Check to see if there is 10 keys '
       splt() = Split(strRest, Chr(0), 10) ' Split the data by delimiter Chr(0) '
       
       ' Check to see if there are the correct amount of elements/keys '
       If UBound(splt()) < 9 Then MsgBox "Error: Not enough profile keys??": Exit Sub
       
       
       ' Set all these strings (There in the order of how I requested them) '
       sysUsername = splt(0)
       sysAcctCreated = splt(1)
       sysLastLogon = splt(2)
       sysLastLogoff = splt(3)
       sysTimeLogged = splt(4)
       
       If sysAcctCreated = vbNullString Then sysAcctCreated = "Unavailable"
       If sysLastLogon = vbNullString Then sysLastLogon = "Never logged on"
       If sysLastLogoff = vbNullString Then sysLastLogoff = "Never logged on"
       If sysTimeLogged = vbNullString Then sysTimeLogged = "Never logged on"
       
       
       FT = StringToFileTime(sysAcctCreated)
       Call FileTimeToSystemTime(FT, ST)
       AddC ST.wMonth & "/" & ST.wDay & "/" & ST.wYear & " at " & Format(ST.wHour & ":" & ST.wMinute & ":" & ST.wSecond, "hh:mm:ss ampm") & vbNewLine, vbGreen
       
       FT = StringToFileTime(sysTimeLogged)
       Call FileTimeToSystemTime(FT, ST)
       AddC ST.wDay & " days, " & ST.wHour & " hours, " & ST.wMinute & " minutes, and " & ST.wSecond & " seconds" & vbNewLine, vbGreen
       
       FT = StringToFileTime(sysLastLogon)
       Call FileTimeToSystemTime(FT, ST)
       AddC ST.wMonth & "/" & ST.wDay & "/" & ST.wYear & " at " & Format(ST.wHour & ":" & ST.wMinute & ":" & ST.wSecond, "hh:mm:ss ampm") & vbNewLine, vbGreen
       
       
       FT = StringToFileTime(sysLastLogoff)
       Call FileTimeToSystemTime(FT, ST)
       AddC ST.wMonth & "/" & ST.wDay & "/" & ST.wYear & " at " & Format(ST.wHour & ":" & ST.wMinute & ":" & ST.wSecond, "hh:mm:ss ampm") & vbNewLine, vbGreen
   End If
   
End Sub

Public Function StringToFileTime(strTime As String) As FILETIME
   Dim splt() As String, FT As FILETIME
   splt() = Split(strTime, " ")
   
   If Val(splt(0)) < 2 ^ 31 Then
       FT.dwHighDateTime = Val(splt(0))
   Else
       FT.dwHighDateTime = Val(splt(0)) - 2 ^ 32
   End If
   
   If UBound(splt()) > 0 Then
       If Val(splt(1)) < 2 ^ 31 Then
           FT.dwLowDateTime = Val(splt(1))
       Else
           FT.dwLowDateTime = Val(splt(1)) - 2 ^ 32
       End If
   End If
   StringToFileTime = FT
End Function


[SNiFFeR]

Use the code tags  . [ code ] [ /code ] (without the spaces.)

What exactly isn't working?

[Inner]

It isn't showing anything, lol.

[UserLoser.]

Try setting some breakpoints to see exactly what's happening

[Inner]

Ok, now, it's putting information on it, it now says:

[5:40:01 PM] BNET: Establishing a connection [asia.battle.net:6112]
[5:40:02 PM] BNET: Connected!
[5:40:02 PM] BNET: Check Revision call passed!
[5:40:03 PM] BNET: Version and CDKeys Passed.
[5:40:03 PM] BNET: Logon Passed!
[5:40:03 PM] BNET: Logged to B.net as, 1nnert443, Starcraft Brood War: (0 wins)
[5:40:03 PM] Joined the private channel op ekingdom.
[5:40:03 PM] 1nnert443 [0ms] [0 Flags] is in the channel using the Product: Starcraft Brood War: (0 wins)
[5:40:04 PM] Account Created: 1/1/1601 at 12:00:00 AM
[5:40:04 PM] Time Logged: 1 days, 0 hours, 0 minutes, and 0 seconds
[5:40:04 PM] Last Logon: 1/1/1601 at 12:00:00 AM
[5:40:04 PM] Last Log Off: 1/1/1601 at 12:00:00 AM

I have no idea why =/

[Inner]

[6:42:44 PM] Account Created: 4/17/2004 @ 09:54:49 PM
[6:42:44 PM] Time Logged: 22 days, 23 hours, 48 minutes, and 19 seconds
[6:42:44 PM] Last Logon: 5/27/2004 @ 10:42:55 PM
[6:42:44 PM] Last Log Off: 5/25/2004 @ 09:29:01 PM

YAY!
But 1 more thing, when i create a account, it puts for days 1, know how i can fix this?

[hismajesty]

You should probably put what the error was in your first problem so people (hopefully) won't ask the same question again.

[BinaryzL]

Code Select Expand

Public Sub RequestInfoStats(strUsername As String, strProduct As String)
   With pbuffer
       .InsertDWORD &H1
       .InsertDWORD &HA
       .InsertDWORD GetTickCount()
       .InsertNTString varUser
       .InsertNTString "record\" & UCase$(strProduct) & "\0\wins"
       .InsertNTString "record\" & UCase$(strProduct) & "\0\losses"
       .InsertNTString "record\" & UCase$(strProduct) & "\0\disconnects"
       .InsertNTString "record\" & UCase$(strProduct) & "\0\last GAME"
       .InsertNTString "record\" & UCase$(strProduct) & "\0\last GAME result"
       .InsertNTString "system\username"
       .InsertNTString "system\account created"
       .InsertNTString "system\last logon"
       .InsertNTString "system\last logoff"
       .InsertNTString "system\time logged"
       .sendPacket &H26
   End With
End Sub


Code Select Expand

       .InsertNTString varUser
Why have strUsername as an argument and not use it in the function, but it doesn't really matter since you can only view yourself I think  .

Also your requesting to many profile keys and not parsing them right for what you want to do. Since you recieve the stat keys then the system keys and your doing the system keys first.

[warz]

You should probably put what the error was in your first problem so people (hopefully) won't ask the same question again.

I agree.

[Inner]

I didn't know i had the problem until i got it working sort of.

[warz]

I didn't know i had the problem until i got it working sort of.

Well, in mine the creation date looks alright and so does the last log on and log off, except my time logged says only 32 days. i know its more than that. also, its said 32 days and like 1 hour for the past few months. and sometimes it even says 31 days, and right now it says 29 days. so i put two and two together and figured something is wrong with what im calculating.