Valhalla Legends Archive

Haha

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

Networks, he asked if anyone else has been having problems, and i just simply said no.
... No need to flame me for that.

No

[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?

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 =/

It isn't showing anything, lol.

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


Haha

Thankyou UserLoser, i got it working fully, and thanks to everyone else for the support.

I didn't mean to, i didn't know it was moved. =/

Private Sub MakeToolTip(Item As Integer)
   If Item > users.ListItems.Count Or Item = 0 Then Exit Sub
   Set ToolTip = New clsToolTip
   With ToolTip
       
       'Set the handle of the listview
       .HwndParentControl = users.hWnd
       
       'Set the tooltip text, which is stored in the tag of the listview
       .Text = users.ListItems.Item(Item).Tag
       
       'Set the title of the tooltip, leave blank if you don't want it
       .Title = users.ListItems.Item(Item).Text
       
       'Sets the style of the tooltip, Balloon is another option (TTSBalloon)
       .Style = TTSBalloon
       
       'Sets the background color of the tooltip
       .BackColor = &H80000018
       
       'Sets the forecolor of the tooltip
       .ForeColor = vbBlack
       
       'Makes the tooltip with the desired Settings
       Call .Create
   End With
End Sub

Private Sub users_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
   Call MakeToolTip(CInt(y / 220))
End Sub

Public Function Create() As Boolean
   
   On Error GoTo CreateError
   
   Dim lpRect As RECT
   Dim lWinStyle As Long
   
   If lngHwnd <> 0 Then DestroyWindow lngHwnd
   
   lWinStyle = TTS_ALWAYSTIP Or TTS_NOPREFIX
   
   'create baloon style if desired
   If Me.Style = TTBalloon Then lWinStyle = lWinStyle Or TTS_BALLOON
   
   'the parent control has to have been set first
   If Me.HwndParentControl <> 0 Then
       lngHwnd = CreateWindowEx(0&, TOOLTIPS_CLASSA, vbNullString, lWinStyle, _
       CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, _
       Me.HwndParentControl, 0&, App.hInstance, 0&)
       
       'make our tooltip window a "topmost" window
       SetWindowPos lngHwnd, HWND_TOPMOST, 0&, 0&, 0&, 0&, SWP_NOACTIVATE Or SWP_NOSIZE Or SWP_NOMOVE
       
       'get the rect of the parent control
       GetClientRect Me.HwndParentControl, lpRect
       
       'now set our tooltip info structure
       With mtypToolInfo
           'if we want it centered, then set that flag
           If Me.Centered = True Then
               .lFlags = TTF_SUBCLASS Or TTF_CENTERTIP
           Else
               .lFlags = TTF_SUBCLASS
           End If
           
           'set the hwnd prop to our parent control's hwnd
           .lHwnd = Me.HwndParentControl
           .lId = 0
           .hInstance = App.hInstance
           .lpStr = Me.Text
           .lpRect = lpRect
       End With
       
       'add the tooltip structure
       SendMessage lngHwnd, TTM_ADDTOOLA, 0&, mtypToolInfo
       
       'if we want a title or we want an icon
       If Title <> vbNullString Then
           SendMessage lngHwnd, TTM_SETTITLE, 0, ByVal Title
       End If
       
       'Goes all black if you set it to the standard colours
       If ForeColor <> FORE_COLOUR Then
           SendMessage lngHwnd, TTM_SETTIPTEXTCOLOR, ForeColor, 0&     'Set the ForeColor
       End If
       If BackColor <> BACK_COLOUR Then
           SendMessage lngHwnd, TTM_SETTIPBKCOLOR, BackColor, 0&       'Set the BackColor
       End If
       If MultiLine = True Then
           SendMessage lngHwnd, TTM_SETMAXTIPWIDTH, 0&, 0              'Set to multiline
       End If
   End If
   
   Create = True  'All went well!
CreateExit:
   On Error Resume Next
   Exit Function
CreateError:
   Create = False 'Failed!
   Resume CreateExit
End Function

Edit (Grok): added code tags.

Ok, the multiline and everything works until i scroll down. It just likes goes backwards or someting, would anyone know the problem?

I got it working properly, thanks to all of you, especially Binary, thanks alot.

Bleh, i really need this, does anyone know what is wrong with that damn code!!?! I've tried so many things and it just does NOT want to work.

FuZZ, i did your dataarrival and it keeps saying that my proxie is not connecting like it was before =/