home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD14473232001.psc / ModCheck.bas < prev    next >
Encoding:
BASIC Source File  |  2001-02-03  |  7.9 KB  |  209 lines
  1. Attribute VB_Name = "ModCheck"
  2. Option Explicit
  3. Public Type POINT
  4.     x As Long
  5.     y As Long
  6. End Type
  7.  
  8. Public a As POINT
  9. Public l As Long
  10.  
  11. Public Declare Function GetCursorPos Lib "user32" (ByRef lpPoint As POINT) As Long
  12. Public Declare Sub SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long)
  13. Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
  14. Public Declare Function GetTickCount Lib "kernel32" () As Long
  15. Public Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
  16.  
  17. 'DWORD APIENTRY RasEnumConnectionsA( LPRASCONNA, LPDWORD, LPDWORD );
  18. '#define LPRASCONNA RASCONNA*
  19. 'RASCONNA
  20. '{
  21. '    DWORD    dwSize;
  22. '    HRASCONN hrasconn;
  23. '    CHAR     szEntryName[ RAS_MaxEntryName + 1 ];
  24. '
  25. '#if (WINVER >= 0x400)
  26. '    CHAR     szDeviceType[ RAS_MaxDeviceType + 1 ];
  27. '    CHAR     szDeviceName[ RAS_MaxDeviceName + 1 ];
  28. '#End If
  29. '#if (WINVER >= 0x401)
  30. '    CHAR     szPhonebook [ MAX_PATH ];
  31. '    DWORD    dwSubEntry;
  32. '#End If
  33. '};
  34.  
  35. 'DWORD APIENTRY RasGetConnectStatusA( HRASCONN, LPRASCONNSTATUSA );
  36. 'O brother/sister! no time here. Refer ras.h in VC++ dirs for details and
  37. 'make it work for NT too
  38. Declare Function RasEnumConnections Lib "RasApi32.dll" Alias "RasEnumConnectionsA" (lpRasCon As Any, lpcb As Long, lpcConnections As Long) As Long
  39. Declare Function RasGetConnectStatus Lib "RasApi32.dll" Alias "RasGetConnectStatusA" (ByVal hRasCon As Long, lpStatus As Any) As Long
  40.  
  41. Public start As Double      'To store the start time(Here we use GetTickCount)
  42. Public total As Double      'Other things you need
  43. Public TtlSeconds As Double
  44. Public totalsec As String
  45. Public Session As Integer
  46. Public Connected As Boolean
  47. Public LogStarted As Boolean
  48. Public actual As String
  49. Public sessioncost As Double
  50. Public TimeConnected As Date
  51.  
  52. Public Const HWND_TOPMOST = -1
  53. Public Const HWND_NOTOPMOST = -2
  54. Public Const SWP_NOSIZE = &H1
  55. Public Const SWP_NOMOVE = &H2
  56. Public Const SWP_NOACTIVATE = &H10
  57. Public Const SWP_SHOWWINDOW = &H40
  58.  
  59. '#define RAS_MaxEntryName      256
  60. '#define RAS_MaxDeviceType     16
  61. '#define RAS_MaxDeviceName     32
  62. Public Const RAS_MaxEntryName = 256
  63. Public Const RAS_MaxDeviceType = 16
  64. Public Const RAS_MaxDeviceName = 32
  65.  
  66. Public Type RASCONN
  67.    dwSize As Long
  68.    hRasCon As Long
  69.    szEntryName(1 To RAS_MaxEntryName) As Byte ' ANSI entry point .'. use Bytes
  70.    szDeviceType(1 To RAS_MaxDeviceType) As Byte
  71.    szDeviceName(1 To RAS_MaxDeviceName) As Byte
  72. End Type
  73.  
  74. Public Type RASCONNSTATUS
  75.    dwSize As Long
  76.    RasConnState As Long
  77.    dwError As Long
  78.    szDeviceType(1 To RAS_MaxDeviceType) As Byte
  79.    szDeviceName(1 To RAS_MaxDeviceName) As Byte
  80. End Type
  81.  
  82.  
  83.  
  84. Public Function IsConnected() As Boolean
  85. 'This is the part where we check for live connection
  86.    Dim TRasCon(255) As RASCONN
  87.    Dim lg As Long
  88.    Dim lpcon As Long
  89.    Dim RetCDec As Long
  90.    Dim Tstatus As RASCONNSTATUS
  91.  
  92.    TRasCon(0).dwSize = 412
  93.    lg = 256 * TRasCon(0).dwSize
  94.  
  95.    RetCDec = RasEnumConnections(TRasCon(0), lg, lpcon)
  96.    Tstatus.dwSize = 160
  97.    RetCDec = RasGetConnectStatus(TRasCon(0).hRasCon, Tstatus)
  98.  
  99.    If Tstatus.RasConnState = &H2000 Then
  100.       IsConnected = True
  101.    Else
  102.       IsConnected = False
  103.    End If
  104.  
  105. End Function
  106.  
  107. Public Sub LogStarttime()   'Open and write the log start details
  108.  
  109. frmNet.txtTc = Time         'The connected time is to be displayed
  110. totalsec = 0                'Initialise totalsec and get Session detail
  111. Session = GetSettingString(HKEY_LOCAL_MACHINE, "Software\AjSoft\NetUsage\Data\Session", "No", 0)
  112. start = GetTickCount&       'Note the value
  113. Session = Session + 1       'This is the next session
  114. Open "c:\IULog.txt" For Append As #1    'Write all details in the file
  115. 'A little art makink it easier to see details in log ;-)
  116. Print #1, "___________________________________"
  117. Print #1, "^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^"
  118. Print #1, "Session     : " & Session
  119. Print #1, "Date        : "; Format$(Now, "ddd, mmm d, yyyy")
  120. Print #1, "Connected   : " & Time
  121. Close #1
  122. 'Save to be sure;actually not needed
  123. SaveSettingString HKEY_LOCAL_MACHINE, "Software\AjSoft\NetUsage\Data\Time", "Start", CStr(start)
  124.  
  125. End Sub
  126.  
  127. Public Sub LogStopTime()    'Open and write the log stop details
  128.  
  129. Dim finish As Double        'For all that local calculations
  130. Dim tempSec As Double
  131. Dim temp As Integer
  132. Dim todaytime As Double
  133. Dim totalcost As Double
  134.  
  135. frmNet.txtTd = Time         'The connected time is to be displayed
  136. 'Get the save value of ticks
  137. start = GetSettingString(HKEY_LOCAL_MACHINE, "Software\AjSoft\NetUsage\Data\Time", "Start", 1)
  138. finish = GetTickCount&      'Hey Window, What is the tic now ?
  139. total = (finish - start)    'This is what we need
  140. totalsec = Round(total / 1000, 0) 'We dont need any decimal
  141. actual = totalsec           'We need the actual value to write in log file
  142.                             'We are going to find total time as per pulse
  143.                             'Get the total time till previous session
  144. TtlSeconds = GetSettingString(HKEY_LOCAL_MACHINE, "Software\AjSoft\NetUsage\Data\Time", "TotalTime", 0)
  145. temp = totalsec Mod CInt(frmNet.txtPd.Text) 'Find the extra time after previous
  146.                             'pulse.If its is 0 proceed else make it as per pulse
  147. If temp <> 0 Then todaytime = totalsec: totalsec = totalsec + CInt(frmNet.txtPd.Text) - temp
  148.  
  149. tempSec = totalsec + TtlSeconds
  150.                             'Finally the total usage time is here
  151.  
  152. TtlSeconds = tempSec        'These are not needed if the pulse is constant
  153.                             'But in any case we changed pulse this will update
  154.                             'our change.Same procedure as above
  155. temp = TtlSeconds Mod CInt(frmNet.txtPd.Text)
  156. If temp <> 0 Then TtlSeconds = TtlSeconds + CInt(frmNet.txtPd.Text) - temp
  157.                             'Calculate the session cost
  158. sessioncost = totalsec * CDbl(frmNet.txtPr.Text) / CDbl(frmNet.txtPd.Text)
  159. Open "c:\IULog.txt" For Append As #1
  160. Print #1, "Disconnected: " & Time
  161. Print #1, "___________________________________"
  162. Print #1, "^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^" & vbCrLf & _
  163.         "Actual Time this session: " & vbCrLf & _
  164.         "hr:min: sec" & vbCrLf & _
  165.         ConvertTime(todaytime) & _
  166.         vbCrLf & _
  167.         "Pulse time this session: " & vbCrLf & _
  168.         "hr:min:sec" & vbCrLf & _
  169.         ConvertTime(totalsec) & _
  170.         vbCrLf & _
  171.         "Session Cost: " & sessioncost & vbCrLf
  172. Close #1
  173. 'This calculates the total cost and prints it
  174. totalcost = TtlSeconds * CDbl(frmNet.txtPr.Text) / CDbl(frmNet.txtPd.Text)
  175. Open "c:\IULog.txt" For Append As #1
  176. Print #1, "Total Pulse time connected " & vbCrLf & _
  177.         "since log started:" & vbCrLf & _
  178.         "hr : min : sec" & vbCrLf & ConvertTime(TtlSeconds) & vbCrLf & _
  179.         "Total Cost :" & totalcost & vbCrLf & _
  180.         "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"
  181. Close #1
  182. frmNet.txtC.Text = totalcost 'Display the total cost
  183. SaveSettingString HKEY_LOCAL_MACHINE, "Software\AjSoft\NetUsage\Data\Time", "Amount", CStr(totalcost)
  184. SaveSettingString HKEY_LOCAL_MACHINE, "Software\AjSoft\NetUsage\Data\Session", "No", CStr(Session)
  185. SaveSettingString HKEY_LOCAL_MACHINE, "Software\AjSoft\NetUsage\Data\Time", "TotalTime", CStr(TtlSeconds)
  186. frmNet.txtTt = ConvertTime(TtlSeconds)
  187. DrawingText
  188. End Sub
  189. Public Function ConvertTime(ByVal tempSec As Single) As String
  190. 'This converts the time to hr:min:sec format
  191. Dim h As String
  192. Dim m As String
  193. Dim s As String
  194. On Error GoTo ErrHandle
  195. h = CStr(Int(tempSec / 3600))
  196. tempSec = tempSec - h * 3600
  197. m = CStr(Int(tempSec / 60))
  198. tempSec = tempSec - m * 60
  199. s = CStr(Int(tempSec))
  200. If Len(h) = 1 Then h = "0" & h  'So that a time 0:0:0 will be converted to
  201. If Len(m) = 1 Then m = "0" & m  '00:00:00 the actual intended way
  202. If Len(s) = 1 Then s = "0" & s
  203. ConvertTime = h & ":" & m & ":" & s
  204. ErrHandle: 'May we not reach here.Actually no need. Remove it
  205. End Function
  206.  
  207.  
  208.  
  209.