Portal:AOL-Files/Articles/Billing Summary: Difference between revisions
(Created page with "{{AOL-Files}} (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 y...") |
No edit summary |
||
Line 13: | Line 13: | ||
<pre> | <pre> | ||
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 | |||
</pre> | </pre> | ||
Revision as of 08:57, 2 October 2020
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