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

استعرض الموضوع السابق استعرض الموضوع التالي اذهب الى الأسفل

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

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

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

استعرض الموضوع السابق استعرض الموضوع التالي الرجوع الى أعلى الصفحة


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