Portal:AOL-Files/Articles/Billing Summary

From NINA Wiki
Jump to navigation Jump to search
 
AOL-Files Articles Downloads FDO91

(Originally by AOL-Files staff member Tau)

Purpose: This will analyze your billing summary and determine how many hours and minutes each screen name on your account has been online since the last billing date. I wrote this code a while ago, so its not written as well as it could be written. It works though. To make this work the Billing Summary window needs to be open. That is the window that has all the screen names on your account and the different amounts of time each have been on.

Requirements: This code requires a ListBoxs named lstFinal, lstNames, lastNumber, a textbox called txtInfo, command buttons: cmdCalculate and cmdCopy.

System: This code will function on Visual Basic versions 5.0 and 6.0, is to be used with no BAS file, and on America Online versions 4.0 and 5.0

Option Explicit

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function SendMessageByString Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Const WM_GETTEXT = &HD
Private Const WM_GETTEXTLENGTH = &HE

Private Function GetText(hwnd As Long) As String
    Dim GetLen As Long, StringText As String, GetString As Long
    GetLen& = SendMessage(hwnd&, WM_GETTEXTLENGTH, 0&, 0&)
    If hwnd& = 0 Then GetText$ = 0: Exit Function
    StringText$ = String$(GetLen& + 1, Chr$(0))
    Call SendMessageByString(hwnd&, WM_GETTEXT, GetLen& + 1, StringText$)
        Do: DoEvents
            If Right(StringText$, 1) = Chr(0) Then StringText$ = Left(StringText$, Len(StringText$) - 1)
        Loop Until Right(StringText$, 1) <> Chr(0)
        GetText = StringText$
End Function

Private Sub cmdCalculate_Click()
        Dim TopParent&, Parent1&, Parent2&, Handle&
        Dim Start%, Pos%, rLine$, Spot1%, Spot2%, Spot3%, Spot4%
        Dim rTime%, rName$, i%, o%, Numb%, hr%, min%
        Dim Divided$, Hours%, Minutes$, Dec%, TotalMins%
Screen.MousePointer = vbArrowHourglass
        txtInfo.Text = ""
        lstNames.Clear
        lstNumber.Clear
        lstFinal.Clear
        TopParent& = FindWindow("AOL Frame25", vbNullString)
        Parent2& = FindWindowEx(TopParent&, 0&, "MDIClient", vbNullString)
        Parent1& = FindWindowEx(Parent2&, 0&, "AOL Child", "Monthly Billing Detail")
        Handle& = FindWindowEx(Parent1&, 0&, "_AOL_View", vbNullString)
        If Handle& = 0 Then MsgBox "Cannot locate billing information window!" & vbCrLf & "Please follow the instructions below.", vbOKOnly + vbExclamation, "Error": Screen.MousePointer = 0: Exit Sub
        txtInfo.Text = GetText(Handle&)
        txtInfo.Text = Mid(txtInfo.Text, InStr(txtInfo.Text, Chr(13)) + 2)
        Start = 1
        Do: DoEvents
            Pos = InStr(Start, txtInfo.Text, Chr(13))
            If Pos = 0 Then GoTo Done
            rLine = Mid(txtInfo.Text, Start, Pos - Start)
            Start = Pos + 2
            Spot1 = InStr(rLine, Chr(9))
            If Spot1 = 0 Then GoTo Done
            Spot2 = InStr(Spot1 + 1, rLine, Chr(9))
            Spot3 = InStr(Spot2 + 1, rLine, Chr(9))
            Spot4 = InStr(Spot3 + 1, rLine, Chr(9))
            
            rTime = Val(Mid(rLine, Spot3 + 1, Spot4 - Spot3 - 1))
            rName = Trim(Mid(rLine, Spot1 + 1, Spot2 - Spot1 - 1))
            For i = 0 To lstNames.ListCount - 1
                If lstNames.List(i) = rName Then
                 lstNumber.List(i) = Val(lstNumber.List(i)) + rTime
                 GoTo sNext
                End If
            Next i
            lstNames.AddItem rName
            lstNumber.AddItem rTime
sNext:
        Loop Until Pos = Len(txtInfo.Text)
Done:
        For o = 0 To lstNames.ListCount - 1
            TotalMins = lstNumber.List(o)
            If TotalMins <> 0 And InStr(lstNames.List(o), "<") = 0 Then
                    lstNames.List(o) = lstNames.List(o) & ":" & String(30 - Len(lstNames.List(o)), Chr(32))
                    Divided = Val(lstNumber.List(o) / 60)
                    If Divided = Int(Divided) Then
                        Hours = Divided
                        Minutes$ = "0"
                    Else
                        Dec = InStr(Divided, ".")
                        Hours = Left(Divided, Dec - 1)
                        Minutes = Str("." & Mid(Divided, Dec + 1))
                        Minutes = Format((Val(Minutes) * 60), "##")
                    End If
                    Minutes = String(2 - Len(Minutes), "0") & Minutes
                    lstFinal.AddItem lstNames.List(o) & Chr(9) & Hours & ":" & Minutes & " min"
            End If
        Next o
Screen.MousePointer = 0
End Sub

Private Sub cmdPrint_Click()
    Dim doPrint%, p$, i%
    If lstFinal.ListCount = 0 Then MsgBox "Nothing to copy!", vbCritical + vbOKOnly, "Error": Exit Sub
    doPrint = MsgBox("Do you want to copy the billing information?", vbYesNo + vbQuestion, "Print?")
    If doPrint = vbYes Then
     p = "Billing Status as of " & Now & "." & vbCrLf
     For i = 0 To lstFinal.ListCount - 1
        p = p & lstFinal.List(i) & vbCrLf
     Next i
     Clipboard.SetText p
    End If
End Sub