 |
Das deutsche QBasic- und FreeBASIC-Forum
Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
|
| Vorheriges Thema anzeigen :: Nächstes Thema anzeigen |
| Autor |
Nachricht |
oldirty
Anmeldungsdatum: 04.08.2005
Beiträge: 65
|
 Verfasst am: 24.11.2005, 01:40 Titel: DFÜ-Netzwerk Datenverkehr Volumen ermitteln, wie? |
 |
|
Hallo,
kann mir jemand einen Tipp (oder Beispielcode) geben, wie ich mit Hilfe von FreeBasic und Api's das Up- und Download-Volumen ermitteln kann.
So wie beim Netzwerkmonitor unten in der Taskleiste:
Verbindung
Geschwindigkeit
Gesendet xxx Bytes
Empfangen xxx Bytes
Schon mal Danke im Voraus.
OlDirty |
|
| Nach oben |
|
 |
Sebastian
Administrator
Anmeldungsdatum: 10.09.2004
Beiträge: 5969
Wohnort: Deutschland
|
|
| Nach oben |
|
|
Sebastian
Administrator
Anmeldungsdatum: 10.09.2004
Beiträge: 5969
Wohnort: Deutschland
|
| Verfasst am: 24.11.2005, 17:14 Titel: |
|
|
Bewusster Doppelpost! Probiert den folgenden Code mal bei euch aus und schreibt dann, unter welcher Windowsversion er funktioniert hat oder nicht... 
Übrigens: Für die, die den Code nicht compilieren wollen, gibt es hier ein Komplettpaket mit fertiger EXE-Datei: Link, 12KB 
| Code: | '
' Beispiel-Source zum Ermitteln der DFÜ-Statistiken unter allen
' Windows-Versionen für FreeBASIC!
'
' Das benötigte Verfahren variiert zwischen Windows 9x Systemen
' und NT-basierten Systemen. Daher wird am Anfang die Windowsversion
' Quick'n'Dirty ermittelt. Schöner ist das Ermitteln der Version mit
' der WinAPI, aber dadurch würde der Source nur noch komplizierter
' werden. Der Source wurde bereits unter Windows 2000 getestet und
' funktioniert dort prima. Die Methoden basieren auf 2 Artikeln von
' www.ActiveVb.de.
'
' Viel Spaß mit dem Code!
' Sebastian Steiner, 24.11.2005
' sebastian_steiner@gmx.de, www.sebastian-steiner.de
'
option explicit
SHELL "VER.EXE>"+CURDIR$+"\~vertemp.tmp"
DIM zeit#, t$, Interval%
DIM inhalt AS STRING
DIM SHARED WinVer AS STRING*2
OPEN CURDIR$+"\~vertemp.tmp" FOR BINARY AS #1
inhalt=SPACE$(LOF(1))
GET #1,,inhalt
CLOSE #1
KILL CURDIR$+"\~vertemp.tmp"
IF INSTR(UCASE$(inhalt), "NT") OR INSTR(UCASE$(inhalt), "2000") _
OR INSTR(UCASE$(inhalt), "XP") THEN
WinVer="NT"
ELSE
WinVer="9X"
END IF
'Windows 95/98/ME Deklarationen
Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias _
"RegOpenKeyExA" (ByVal hKey As Long, ByVal _
lpSubKey As String, ByVal ulOptions As Long, ByVal _
samDesired As Long, phkResult As Long) As Long
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal _
hKey As Long) As Long
Declare Function RegQueryValueEx Lib "advapi32.dll" Alias _
"RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName _
As String, ByVal lpReserved As Long, lpType As Long, _
lpData As Any, lpcbData As Any) As Long
DECLARE Sub VReset()
DECLARE Function ReadBytes(Entry AS STRING) As Long
Const HKEY_DYN_DATA = &H80000006
Const KEY_READ = &H19
Const ERROR_SUCCESS = 0&
DIM SHARED s1 AS LONG, e1 AS LONG, LBytes AS LONG, CNT as long
DIM SHARED Q AS LONG, QQ AS LONG, SUM AS LONG, EBytes AS LONG
DIM SHARED SBytes AS LONG, CSpeed AS LONG
'Windows NT/2000/XP Deklarationen
DECLARE FUNCTION LenB(ausdruck as any) AS LONG
Dim library As Integer
library = DyLibLoad("rasapi32.dll")
if(library = 0) Then
COLOR 12: Print "Fehler: rasapi32.dll nicht gefunden."
Sleep: End 1
end If
type RASSTATS2000
dwSize As Long
dwBytesXmited As Long
dwBytesRcved As Long
dwFramesXmited As Long
dwFramesRcved As Long
dwCrcErr As Long
dwTimeoutErr As Long
dwAlignmentErr As Long
dwHardwareOverrunErr As Long
dwFramingErr As Long
dwBufferOverrunErr As Long
dwCompressionRatioIn As Long
dwCompressionRatioOut As Long
dwBps As Long
dwConnectDuration As Long
End Type
Const RAS_MaxEntryName As Long = 256&
Const RAS_MaxDeviceType As Long = 16&
Const RAS_MaxDeviceName As Long = 32&
Type RASType
dwSize As Long
hRasCon As Long
szEntryName(RAS_MaxEntryName) As Byte
szDeviceType(RAS_MaxDeviceType) As Byte
szDeviceName(RAS_MaxDeviceName) As Byte
End Type
Type RASStatusType
dwSize As Long
RasConnState As Long
dwError As Long
szDeviceType(RAS_MaxDeviceType) As Byte
szDeviceName(RAS_MaxDeviceName) As Byte
szInBytes As Double
syOutbytes As Double
End Type
Dim RasGetConnectionStatistics as Function (ByVal hRasConn As Long, _
lpStatistics as RASSTATS2000) As Long
Dim RasGetLinkStatistics As Function (ByVal hRasConn As Long, ByVal _
dwSubEntry As Long, lpStatistics As RASSTATS2000) As Long
Dim RasEnumConnections AS FUNCTION (lpRasCon As Any, lpcb As Long, _
lpcConnections As Long) As Long
Dim RasGetConnectStatus AS FUNCTION (ByVal hRasCon As Long, _
lpStatus As Any) As Long
RasGetConnectionStatistics = DyLibSymbol(library, "RasGetConnectionStatistics")
RasGetLinkStatistics = DyLibSymbol(library, "RasGetLinkStatistics")
RasEnumConnections = DyLibSymbol(library, "RasEnumConnectionsA")
RasGetConnectStatus = DyLibSymbol(library, "RasGetConnectStatusA")
Dim RAS(255) As RASType, RASStatus As RASStatusType
Dim lg As Long, lpcon As Long, Result As Long
Dim myStats As RASSTATS2000
Dim rtn As Long
'#### Jetzt das eigentliche Programm
Interval%=100
PRINT ""
COLOR 11
PRINT " DF"+CHR$(154)+"-Verbindung"
COLOR 7
PRINT ""
IF WinVer="NT" THEN
DO
zeit#=TIMER
DO
SLEEP 5
t$=INKEY$
IF t$<>"" THEN
DyLibFree library
end
end if
LOOP UNTIL CDBL(TIMER-zeit#)>CDBL(Interval%/1000)
RAS(0).dwSize = 412
lg = 256 * RAS(0).dwSize
Result = RasEnumConnections(RAS(0), lg, lpcon)
myStats.dwSize = LenB(myStats)
rtn = RasGetConnectionStatistics(RAS(0).hRasCon, myStats)
If lpcon = 0 Then
CLS
PRINT ""
COLOR 11
PRINT " DF"+CHR$(154)+"-Verbindung"
COLOR 7
PRINT ""
PRINT " OFFLINE"
Else
RASStatus.dwSize = 160
Result = RasGetConnectStatus(RAS(0).hRasCon, RASStatus)
If RASStatus.RasConnState = &H2000 Then
CLS
PRINT ""
COLOR 11
PRINT " DF"+CHR$(154)+"-Verbindung"
COLOR 7
PRINT ""
PRINT " ONLINE!"
PRINT ""
PRINT " Bytes empfangen: "; LTRIM$(STR$(myStats.dwBytesRcved))
PRINT " Bytes gesendet: "; LTRIM$(STR$(myStats.dwBytesXmited))
PRINT " Geschwindigkeit: "; LTRIM$(STR$(FIX(myStats.dwBps/1000))); " kbps"
Else
CLS
PRINT ""
COLOR 11
PRINT " DF"+CHR$(154)+"-Verbindung"
COLOR 7
PRINT ""
PRINT " Verbindung wird gerade getrennt oder aufgebaut."
End If
End If
LOOP
DyLibFree library
end
End if
If WinVer="9X" THEN
VReset
LBytes=e1
DO
zeit#=TIMER
DO
SLEEP 5
t$=INKEY$
IF t$<>"" THEN end
LOOP UNTIL CDBL(TIMER-zeit#)>CDBL(Interval%/1000)
EBytes = ReadBytes("Dial-Up Adapter\BytesRecvd")
SBytes = ReadBytes("Dial-Up Adapter\BytesXmit")
CSpeed = ReadBytes("Dial-Up Adapter\ConnectSpeed")
CLS
PRINT ""
COLOR 11
PRINT " DF"+CHR$(154)+"-Verbindung"
COLOR 7
PRINT ""
PRINT " Bytes empfangen: "; LTRIM$(STR$(EBytes-e1))
PRINT " Bytes gesendet: "; LTRIM$(STR$(SBytes-s1))
PRINT " Geschwindigkeit: "; LTRIM$(STR$(CSpeed))
If LBytes < EBytes Then
Q = (EBytes - LBytes) / (Interval% / 1000)
CNT = CNT + 1
Else
Q = 0
End If
SUM = SUM + Q
QQ = SUM / CNT
PRINT " [ " + LTRIM$(STR$(QQ))+ " ] " + LTRIM$(STR$(Q))
LBytes = EBytes
LOOP
END
END IF
Function ReadBytes(Entry AS STRING) As Long
Dim hKey AS LONG, L AS LONG, X AS LONG, DW AS LONG, longval as long
X = RegOpenKeyEx(HKEY_DYN_DATA, "PerfStats\StatData", 0, _
KEY_READ, hKey)
If X <> ERROR_SUCCESS Then Exit Function
X = RegQueryValueEx(hKey, Entry, 0, DW, 0, L)
If X <> ERROR_SUCCESS Then Exit Function
X = RegQueryValueEx(hKey, Entry, 0, DW, longval, L)
ReadBytes=longval
If X <> ERROR_SUCCESS Then Exit Function
RegCloseKey hKey
End Function
Sub VReset()
e1 = ReadBytes("Dial-Up Adapter\BytesRecvd")
s1 = ReadBytes("Dial-Up Adapter\BytesXmit")
SUM = 0
CNT = 1
End Sub
FUNCTION LenB(ausdruck as RASSTATS2000) AS LONG
dim temp as long
temp=LEN(ausdruck)
LenB=temp
end function |
_________________
Die gefährlichsten Familienclans | Opas Leistung muss sich wieder lohnen - für 6 bis 10 Generationen! |
|
| Nach oben |
|
|
oldirty
Anmeldungsdatum: 04.08.2005
Beiträge: 65
|
| Verfasst am: 24.11.2005, 17:33 Titel: |
|
|
Hallo,
habe bei mir den Code
| Code: |
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal _
hKey As Long) As Long
|
in
| Code: |
Declare Function RegCloseKey Lib "advapi32.dll" Alias "RegCloseKey" (ByVal _
hKey As Long) As Long
|
umändern müssen unter Windows XP Pro mit Freebasic 0.15 vom 12.11.2005.
Habe mittlerweile in Anlehnung an deinen Code "DFÜ-Verb. beenden" aus der fb_dfue.zip ein Programm wie folgt entwickelt, dass ohne die Shell auskommt. (Noch keine Schleife drin, aber erste Anzeigen laufen schon:
| Code: |
'
' Beispiel zum Anzeigen und Trennen aller DFÜ-Verbindungen für FreeBasic
' von Volta (wadepohl@t-online.de) und Sebastian Steiner (sebastian_steiner@gmx.de)
'
' Funktioniert natürlich nur, wenn das DFÜ-Netzwerk überhaupt installiert ist.
'
Screen 16
'Deklarationen
Dim library As Integer
Dim RasEnumConnections as Function (lpRasCon As Any, lpcb As Long,_
lpcConnections As Long) As Long
Dim RasHangUp As Function (ByVal hRasConn As Long) As Long
Dim RasGetConnectionStatistics As Function (ByVal hRasConn As Long, _
ByVal lpStatistics As Long) As Long
'DLL laden
library = DyLibLoad("rasapi32.dll")
'Fehlerbehandlung
if(library = 0) Then
COLOR 12
Print "Fehler: rasapi32.dll nicht gefunden."
Sleep
End 1
end If
'Inhalt von derdll deklarieren
RasEnumConnections = DyLibSymbol(library, "RasEnumConnectionsA")
RasHangUp = DyLibSymbol(library, "RasHangUpA")
RasGetConnectionStatistics = DyLibSymbol(library, "RasGetConnectionStatistics")
Declare Function GetStr(Feld() As Byte) As String
Type RASType
dwSize As Long
hRasCon As Long
szEntryName(0 To 256) As Byte
szDeviceType(0 To 16) As Byte
szDeviceName(0 To 128) As Byte
pad As Byte
End Type
Type RAS_STATS
dwSize As Long
dwBytesXmited As Long
dwBytesRcved As Long
dwFramesXmited As Long
dwFramesRcved As Long
dwCrcErr As Long
dwTimeoutErr As Long
dwAlignmentErr As Long
dwHardwareOverrunErr As Long
dwFramingErr As Long
dwBufferOverrunErr As Long
dwCompressionRatioIn As Long
dwCompressionRatioOut As Long
dwBps As Long
dwConnectDuration As Long
End Type
Dim conn As RASType
Dim stat As RAS_STATS
Dim yy As Long, z As Long
conn.dwSize = Len(conn)
stat.dwSize = Len(stat)
'Main
Dim x%, y%, RAS(255) As RASType
Dim lg&, lpcon&, Result&
RAS(0).dwSize = 412
lg = 256 * RAS(0).dwSize
Result = RasEnumConnections(RAS(0), lg, lpcon)
If lpcon <> 0 Then
PRINT ""
COLOR 10
PRINT " Aktive Verbindungen: "
PRINT ""
For x = 0 To lpcon - 1
COLOR 13
PRINT " => "; GetStr(RAS(x).szEntryName())
COLOR 7
PRINT ""
PRINT " ID: "; LTRIM$(STR$(RAS(x).hRasCon))
result2= RasGetConnectionStatistics(RAS(x).hRasCon, varptr(stat))
PRINT " Eintrag: "; GetStr(RAS(x).szEntryName())
PRINT " Ger"+chr$(132)+"t: "; GetStr(RAS(x).szDeviceName())
PRINT " Ger"+chr$(132)+"tetyp: "; GetStr(RAS(x).szDeviceType())
' Print stat.dwAlignmentErr
Print " kbs: ";stat.dwBps
'Print stat.dwBufferOverrunErr
print " Gesendet: ";stat.dwBytesXmited
Print " Empfangen: ";stat.dwBytesRcved
'Print stat.dwCompressionRatioIn
'Print stat.dwCompressionRatioOut
Print "Verb.Dauer in Sek.:";stat.dwConnectDuration/1000
'Print stat.dwCrcErr
'Print stat.dwFramesRcved
'Print stat.dwFramesXmited
'Print stat.dwFramingErr
'Print stat.dwTimeoutErr
PRINT ""
Next x
Else
PRINT ""
COLOR 14
PRINT " Keine DF";CHR$(154)+"-Verbindungen aktiv!"
PRINT ""
End If
Dim hRasConn&
FOR x%=LBOUND(RAS) TO UBOUND(RAS)
hRasConn = RAS(x%).hRasCon
' Result = RasHangUp(ByVal hRasConn) 'Trennen der Verbindung
NEXT x%
COLOR 11
PRINT " Fertig."
'gibt den Speicherbereich frei.
DyLibFree library
SLEEP: END
Function GetStr(Feld() As Byte) As String
Dim x%, y%, aa$, bb$
For x% = 0 To UBound(Feld)
bb$ = Chr$(Feld(x%))
If bb$ <> Chr$(0) Then
aa$ = aa$ + bb$
Else
Exit For
End If
Next x%
GetStr = aa$
End Function
|
Kann ja mal ausprobiert werden. |
|
| Nach oben |
|
|
Sebastian
Administrator
Anmeldungsdatum: 10.09.2004
Beiträge: 5969
Wohnort: Deutschland
|
|
| Nach oben |
|
|
|
|
Du kannst keine Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum nicht antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
|
|
FAQ
Suchen
Mitgliederliste
Benutzergruppen
Registrieren
Profil
Einloggen, um private Nachrichten zu lesen
Login
Wäre toll, wenn ein Windows 98 Benutzer den Code mal probieren könnte.