هل تريد أحتساب مدة الأتصال بالأنترنت

اذهب الى الأسفل

default هل تريد أحتساب مدة الأتصال بالأنترنت

مُساهمة من طرف iemad في الإثنين أكتوبر 23, 2006 11:38 pm

هل تريد أحتساب مدة الأتصال بالأنترنت
أولا كود API


الكود:
API Declarations
Private Declare Function RasEnumConnections Lib "rasapi32.dll" Alias "RasEnumConnectionsA" (lpRasConn As Any, lpcb As Long, lpcConnections As Long) As Long

Public Const RAS_MAXENTRYNAME As Integer = 256
Public Const RAS_MAXDEVICETYPE As Integer = 16
Public Const RAS_MAXDEVICENAME As Integer = 128
Public Const RAS_RASCONNSIZE As Integer = 412
Public Const ERROR_SUCCESS = 0

Public Type RasConn
    dwSize As Long
    hRasConn As Long
    szEntryName(RAS_MAXENTRYNAME) As Byte
    szDeviceType(RAS_MAXDEVICETYPE) As Byte
    szDeviceName(RAS_MAXDEVICENAME) As Byte
End Type
 

ضع الكود التالي في Modul

الكود:
Module

Public Function ByteToString(ByteArray() As Byte) As String
    Dim i As Integer

    ByteToString = ""
    i = 0
    Do While ByteArray(i) <> 0
        ByteToString = ByteToString & Chr(ByteArray(i))
        i = i + 1
    Loop
End Function


Private Function toTime(ByVal x As Single) As String
    toTime = Format(x Mod 60, "00")
    toTime = ":" & toTime
    x = x \ 60
    toTime = Format(x Mod 60, "00") & toTime
    toTime = ":" & toTime
    x = x \ 60
    toTime = x & toTime
End Function

'Check the RAS Connections
Sub CheckRASConnections()
    Dim i As Long
    Dim RasConn(255) As RasConn
    Dim structSize As Long
    Dim ConnectionsCount As Long
    Dim ret As Long
    Static LastTime As Single
    Dim ElapsedTime As Single

    If LastTime = 0 Then LastTime = Timer

    RasConn(0).dwSize = RAS_RASCONNSIZE
    structSize = RAS_MAXENTRYNAME * RasConn(0).dwSize
    ret = RasEnumConnections(RasConn(0), structSize, ConnectionsCount)
    ElapsedTime = Timer - LastTime
    If ElapsedTime < 0 Then ElapsedTime = 0
 
    If ret = ERROR_SUCCESS Then
        For i = 0 To ConnectionsCount - 1
            On Error GoTo NewConnection
                      Form1.ListView1.ListItems("K" & RasConn(i).hRasConn).Tag = Form1.ListView1.ListItems("K" & RasConn(i).hRasConn).Tag + ElapsedTime
            Form1.ListView1.ListItems("K" & RasConn(i).hRasConn).Text = ByteToString(RasConn(i).szEntryName) & "-" & toTime(Form1.ListView1.ListItems("K" & RasConn(i).hRasConn).Tag)
            GoTo NextConnection
NewConnection:
            'Create a new list item connection
            Form1.ListView1.ListItems.Add , "K" & RasConn(i).hRasConn, ByteToString(RasConn(i).szEntryName)
            Form1.ListView1.ListItems("K" & RasConn(i).hRasConn).Tag = 0
NextConnection:
        Next
    End If
    LastTime = Timer
End Sub


Function CheckConnections() As Integer
    Static ConnCount As Integer
    Dim RasConn(255) As RasConn
    Dim structSize As Long
    Dim ConnectionsCount As Long
    Dim ret As Long


    RasConn(0).dwSize = RAS_RASCONNSIZE
    structSize = RAS_MAXENTRYNAME * RasConn(0).dwSize
    ret = RasEnumConnections(RasConn(0), structSize, ConnectionsCount)
    CheckConnections = ConnectionsCount - ConnCount
    ConnCount = ConnectionsCount
End Function
 

أما طريقة الأستعمال فهي كالتالي
الكود:
Usage
أضف أداة وقت Timer و أداة ListView الى الفورم Form
عند بدء الأتصال الوظيفة CheckRASConnections سوف تكتشف الأتصال الجديد وتبدء بأحتساب الأتصال .
عند أنتهاء الأتصال سوف يتوقف أحتساب مجموع الأتصال .
أستعمل الوظيفة CheckRASConnections لتعرف الأتصال الجديد عند البدء أو الأنتهاء.
Sub Timer1_Timer()
    Dim x as integer

    x=CheckConnections
    If x>0 Then
        MsgBox x & " New Connection Started"
    ElseIf x<0 Then
        MsgBox Abs(x) & " Connection Terminated"
    End If
End Sub
 

iemad
مراقب عام
مراقب عام

عدد الرسائل : 20
تاريخ التسجيل : 23/10/2006

معاينة صفحة البيانات الشخصي للعضو

الرجوع الى أعلى الصفحة اذهب الى الأسفل

default رد: هل تريد أحتساب مدة الأتصال بالأنترنت

مُساهمة من طرف Admin في الإثنين أكتوبر 23, 2006 11:50 pm

بارك الله فيك


عدل سابقا من قبل في الخميس أغسطس 16, 2007 10:47 am عدل 1 مرات

_________________
إذا أعجبك موضوع من مواضيعي فلا تقل شكـراً ...
بل قل الآتـي ::
اللهم اغفر له ولوالديه ولزوجته وابنائه ولأخوانه واخواته ولسائر المسلمين ماتقدم من ذنبهم وما تأخر..
وقِهم عذاب القبر وعذاب النار..
و أدخلهم الفردوس الأعلى مع الأنبياء والشهداء والصالحين ..
واجعل دعاءهم مستجاب في الدنيا والآخرة ..
اللـهم آميـن..اللـهم آميـن..اللـهم آميـن..

اخوكم جاد القرعان
الأردن- الطفيلة
jadquraan@yahoo.com
jad_quraansoft@hotmail.com
00962777765709
avatar
Admin
jadquraan
jadquraan

عدد الرسائل : 125
العمر : 35
تاريخ التسجيل : 19/10/2006

معاينة صفحة البيانات الشخصي للعضو http://jad4vb.lightbb.com

الرجوع الى أعلى الصفحة اذهب الى الأسفل

default شكرأ

مُساهمة من طرف العـطوي في الخميس نوفمبر 09, 2006 2:11 am

شكرا لك iemad

العـطوي
عضو متميز
عضو متميز

عدد الرسائل : 43
تاريخ التسجيل : 06/11/2006

معاينة صفحة البيانات الشخصي للعضو

الرجوع الى أعلى الصفحة اذهب الى الأسفل

الرجوع الى أعلى الصفحة


 
صلاحيات هذا المنتدى:
لاتستطيع الرد على المواضيع في هذا المنتدى