| Вопрос: Проблема работы кода в Windows Vista | Добавлено: 14.06.08 07:53 |
Автор вопроса:  Антон
|
|
Увожаемые программисты помогите новичку.
Имеиться код программы которая отображает данные входящего трафика и другие данные из интернета была написанна программа под WinXP но с переходом на висту исходный код отказывается работать. модуль был написан не мной и в языке программирования я не селен, поэтому прошу помощи. Код модуля: ttribute VB_Name = "mConnections" Option Explicit ' Модуль написан '******************************************************************** '* Написано 10.08.2003 году (Team HomeWork) * '* e-mail: sne_pro@mail.ru * '******************************************************************** ' Пример написан '******************************************************************** '* Написано 20.06.2004 году (Team HomeWork) * '* e-mail: sne_pro@mail.ru * '******************************************************************** Private Declare Function RasGetConnectionStatistics Lib "rasapi32.dll" (ByVal hRasConn As Long, lpStatistics As RASSTATS2000) As Long Private Declare Function RasEnumConnections Lib "rasapi32.dll" Alias "RasEnumConnectionsA" (lpRasconn As Any, lpcb As Long, lpcConnections As Long) As Long Private 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 Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long Private 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 Long) As Long Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) Private Declare Function GetIfTable Lib "iphlpapi" (ByRef pIfRowTable As Any, ByRef pdwSize As Long, ByVal bOrder As Long) As Long Private Type OSVERSIONINFO ' Версия виндовоськи dwOSVersionInfoSize As Long dwMajorVersion As Long dwMinorVersion As Long dwBuildNumber As Long dwPlatformId As Long szCSDVersion As String * 128 End Type Public Type RASSTATS2000 dwSize As Long dwBytesXmited As Long ' The number of bytes transmitted through this connection or link. dwBytesRcved As Long ' The number of bytes received through this connection or link. dwFramesXmited As Long ' The number frames transmitted through this connection or link. dwFramesRcved As Long ' The number of frames received through this connection or link. dwCrcErr As Long ' The number of cyclic redundancy check (CRC) errors on this connection or link. dwTimeoutErr As Long ' The number of timeout errors on this connection or link. dwAlignmentErr As Long ' The number of alignment errors on this connection or link. dwHardwareOverrunErr As Long ' The number of hardware overrun errors on this connection or link. dwFramingErr As Long ' The number of framing errors on this connection or link. dwBufferOverrunErr As Long ' The number of buffer overrun errors on this connection or link. dwCompressionRatioIn As Long ' The compression ratio for the data being received on this connection or link. dwCompressionRatioOut As Long ' The compression ratio for the data being transmitted on this connection or link. dwBps As Long ' The speed of the connection or link, in bits per second. dwConnectDuration As Long ' The amount of time, in milliseconds, that the connection or link has been connected. End Type 'Public Type VBRasStats95 ' для 95/98/Me, если понадобится... ' BytesXmited As Long ' BytesRcved As Long ' FramesXmited As Long ' FramesRcved As Long ' CrcErr As Long ' TimeoutErr As Long ' AlignmentErr As Long ' HardwareOverrunErr As Long ' FramingErr As Long ' BufferOverrunErr As Long ' Runts As Long ' TotalBytesXmited As Long ' TotalBytesRcved As Long ' ConnectSpeed As Long 'End Type Private Const HKEY_DYN_DATA As Long = &H80000006 Private Function VBRasGetStat2000(ByVal hRasConn As Long, _ Optional ByRef dwError As Long) As RASSTATS2000 VBRasGetStat2000.dwSize = Len(VBRasGetStat2000) dwError = RasGetConnectionStatistics(hRasConn, VBRasGetStat2000) End Function Private Function VBRasGetStat9x(Optional ByRef dwError As Long) As RASSTATS2000 Dim hKey As Long Const dUp As String = "Dial-Up Adapter\" Call RegOpenKeyEx(HKEY_DYN_DATA, "PerfStats\StatData", 0&, &H7, hKey) dwError = IIf(hKey = 0&, False, True) With VBRasGetStat9x Call RegQueryValueEx(hKey, dUp & "BytesRecvd", 0&, ByVal 0&, .dwBytesXmited, &H4) Call RegQueryValueEx(hKey, dUp & "BytesXmit", 0&, ByVal 0&, .dwBytesRcved, &H4) Call RegQueryValueEx(hKey, dUp & "FramesXmit", 0&, ByVal 0&, .dwFramesXmited, &H4) Call RegQueryValueEx(hKey, dUp & "FramesRecvd", 0&, ByVal 0&, .dwFramesRcved, &H4) Call RegQueryValueEx(hKey, dUp & "CRC", 0&, ByVal 0&, .dwCrcErr, &H4) Call RegQueryValueEx(hKey, dUp & "Timeout", 0&, ByVal 0&, .dwTimeoutErr, &H4) Call RegQueryValueEx(hKey, dUp & "Alignment", 0&, ByVal 0&, .dwAlignmentErr, &H4) Call RegQueryValueEx(hKey, dUp & "Overrun", 0&, ByVal 0&, .dwHardwareOverrunErr, &H4) Call RegQueryValueEx(hKey, dUp & "Framing", 0&, ByVal 0&, .dwFramingErr, &H4) Call RegQueryValueEx(hKey, dUp & "Buffer", 0&, ByVal 0&, .dwBufferOverrunErr, &H4) Call RegQueryValueEx(hKey, dUp & "ConnectSpeed", 0&, ByVal 0&, .dwBps, &H4) ' Call RegQueryValueEx(hKey, dUp & "TotalBytesXmit", 0&, ByVal 0&, .BytesRcved, &H4) ' Не поддерживается 2000/XP... ' Call RegQueryValueEx(hKey, dUp & "TotalBytesRecvd", 0&, ByVal 0&, .BytesXmited, &H4) ' Если понадобится, можно использовать ' Call RegQueryValueEx(hKey, dUp & "Runts", 0&, ByVal 0&, .Runts, &H4) ' два разных UDT (VBRasStats95), я предпочел - одну (RASSTATS2000) .dwCompressionRatioIn = &HFFFF ' Не поддерживается 95/98/Me .dwCompressionRatioOut = &HFFFF ' Не поддерживается 95/98/Me .dwConnectDuration = &HFFFF ' connection duration can be calculated if you use a connection notification event or enumerate connections on a regular basis, providing your app starts before the connection starts. End With End Function Private Function OS_Version() As OSVERSIONINFO ' dwPlatformId 0-Unknown; 1-9x; 2-NT OS_Version.dwOSVersionInfoSize = Len(OS_Version) Call GetVersionEx(OS_Version) End Function Public Function VBGetDUPStat(Optional ByRef dwIsError As Long) As RASSTATS2000 Dim btRasConn() As Byte, lng As Long, dwConnNum As Long lng = 32& ReDim btRasConn(lng - vbNull) ' Массив с будующими данными Call CopyMemory(btRasConn(0), lng, 4&) ' Ставим у структуры dwSize = lng Call RasEnumConnections(btRasConn(0), lng, dwConnNum) ' Вызов функции Call CopyMemory(lng, btRasConn(4), 4&) ' Берем хэндл соединения If OS_Version.dwPlatformId = &H2 Then ' В зависимости от типа OS берем данные VBGetDUPStat = VBRasGetStat2000(lng, dwIsError) ' Из реестра или RAS ElseIf OS_Version.dwPlatformId = &H1 Then VBGetDUPStat = VBRasGetStat9x(dwIsError) End If End Function Код формы: Option Explicit Dim prevStat As RASSTATS2000 Private Sub Form_Load() Dim st As RASSTATS2000 st = mConnections.VBGetDUPStat() Me.ForeColor = vbGreen Print "dwAlignmentErr ", , st.dwAlignmentErr Print "dwBps", , , st.dwBps Print "dwBufferOverrunErr", , st.dwBufferOverrunErr Print "dwBytesRcved", , st.dwBytesRcved Print "dwBytesXmited", , st.dwBytesXmited Print "dwCompressionRatioIn", , st.dwCompressionRatioIn Print "dwCompressionRatioOut", , st.dwCompressionRatioOut Print "dwConnectDuration", , st.dwConnectDuration Print "dwCrcErr", , , st.dwCrcErr Print "dwFramesRcved", , st.dwFramesRcved Print "dwFramesXmited", , st.dwFramesXmited Print "dwFramingErr", , , st.dwFramingErr Print "dwHardwareOverrunErr", , st.dwHardwareOverrunErr Print "dwTimeoutErr", , , st.dwTimeoutErr Me.ForeColor = vbCyan Print "Скорость закачки (download) :", st.dwBytesRcved - prevStat.dwBytesRcved Print "Скорость выгрузки (upload) :", st.dwBytesXmited - prevStat.dwBytesXmited Me.ForeColor = vbYellow Print "На 9x именно этот пример не проверял, но,"; vbCrLf; "по идее, код рабочий!" prevStat = st End Sub Private Sub Timer1_Timer() Call Me.Cls Call Form_Load End Sub |
| Ответы | Всего ответов: 33 |
|
Номер ответа: 1 Автор ответа:    Администратор ICQ: 278109632 Вопросов: 42 Ответов: 3949 |
Web-сайт: Профиль | Цитата | #1 | Добавлено: 14.06.08 11:24 |
|
(Team HomeWork)
респект Стасу 
If OS_Version.dwPlatformId = &H2 Then ' В зависимости от типа OS берем данные VBGetDUPStat = VBRasGetStat2000(lng, dwIsError) ' Из реестра или RAS ElseIf OS_Version.dwPlatformId = &H1 Then VBGetDUPStat = VBRasGetStat9x(dwIsError) End If вот тут собака порылась, имхо dwPlatformId другое у висты. Да и не известно, есть ли у висты апишка RasGetConnectionStatistics. Проверьте, у кого виста есть.
|
||
|
Номер ответа: 2 Автор ответа: Holsten Вопросов: 5 Ответов: 100 |
Профиль | Цитата | #2 | Добавлено: 14.06.08 16:56 |
|
http://msdn.microsoft.com/en-us/library/aa377499(VS.85).aspx
Client Requires Windows Vista, Windows XP, or Windows 2000 Professional.
Server Requires Windows Server 2008, Windows Server 2003, or Windows 2000 Server. Header Declared in Ras.h. Library Use Rasapi32.lib. DLL Requires Rasapi32.dll. сижу на хп, не проверить, вдруг билл соврал
|
||
|
Номер ответа: 3 Автор ответа: WinandВопросов: 87 Ответов: 2795 |
Web-сайт: Профиль | Цитата | #3 | Добавлено: 14.06.08 19:56 |
| Ваша проблема заключается не в неправильном коде, а в неправильной ОС. | ||
|
Номер ответа: 4 Автор ответа: s12Вопросов: 24 Ответов: 363 |
Профиль | Цитата | #4 | Добавлено: 15.06.08 00:07 |
|
И жутко недоделаной.
|
||
|
Номер ответа: 5 Автор ответа: Администратор ICQ: 278109632 Вопросов: 42 Ответов: 3949 |
Web-сайт: Профиль | Цитата | #5 | Добавлено: 15.06.08 01:17 |
|
Пля, сцукофлудеры Топик видите? Вот по теме и говорим...
|
||
|
Номер ответа: 6 Автор ответа: gvozdРазработчик Offline Client Вопросов: 164 Ответов: 1317 
|
Web-сайт: Профиль | Цитата | #6 | Добавлено: 15.06.08 09:19 |
| С чего это вдруг, Vista недоделанная? | ||
|
Номер ответа: 7 Автор ответа: AleXProg Вопросов: 10 Ответов: 29 |
Профиль | Цитата | #7 | Добавлено: 15.06.08 10:27 |
|
С того, что Vista - тупость Мелкософта!
Не пользуйтесь Вистой - это то, что лежит в туалете! |
||
|
Номер ответа: 8 Автор ответа: gvozdРазработчик Offline Client Вопросов: 164 Ответов: 1317
|
Web-сайт: Профиль | Цитата | #8 | Добавлено: 15.06.08 15:00 |
| Кто это сказал? | ||
|
Номер ответа: 9 Автор ответа: WinandВопросов: 87 Ответов: 2795 |
Web-сайт: Профиль | Цитата | #9 | Добавлено: 15.06.08 17:30 |
|
gvozd, а что ники не отображаются?))
З.Ы. Вот жеж блин! Хуже только лоровцы, которые тему про несуществование линукса восприняли очень серьезно, и бросились доказывать обратное. з.з.ы. у висты есть преимущества (перевешивающие недостатки) перед другими ОС (хотя бы XP) из-за которых стоит к ней присмотреться? |
||
|
Номер ответа: 10 Автор ответа:  User UnknownВечный Юзер! ICQ: uu@jabber.cz Вопросов: 120 Ответов: 3302 |
Профиль | Цитата | #10 | Добавлено: 15.06.08 19:21 |
|
Хуже только лоровцы
Но но! Попрошу тут без этого ацетона. Иначе не видать тебе Небесной Дискеты и Патрег тебя покарает. |
||
|
Номер ответа: 11 Автор ответа: gvozdРазработчик Offline Client Вопросов: 164 Ответов: 1317
|
Web-сайт: Профиль | Цитата | #11 | Добавлено: 15.06.08 19:49 |
|
з.з.ы. у висты есть преимущества (перевешивающие недостатки) перед другими ОС (хотя бы XP) из-за которых стоит к ней присмотреться?
Конечно есть.
|
||
|
Номер ответа: 12 Автор ответа: WinandВопросов: 87 Ответов: 2795 |
Web-сайт: Профиль | Цитата | #12 | Добавлено: 15.06.08 22:11 |
| User Unknown, я имел в виду не то что лоровцы хуже как человеки, а то что они всё воспринимают еще более серьезно. | ||
|
Номер ответа: 13 Автор ответа: WinandВопросов: 87 Ответов: 2795 |
Web-сайт: Профиль | Цитата | #13 | Добавлено: 15.06.08 22:12 |
|
gvozd, а вот и не угодал - нету
|
||
|
Номер ответа: 14 Автор ответа: Администратор ICQ: 278109632 Вопросов: 42 Ответов: 3949 |
Web-сайт: Профиль | Цитата | #14 | Добавлено: 16.06.08 01:19 |
|
Есть Но я даже из-за них на нее, как на основную систему, не перейду в ближайший год.
|
||
|
Номер ответа: 15 Автор ответа: gvozdРазработчик Offline Client Вопросов: 164 Ответов: 1317
|
Web-сайт: Профиль | Цитата | #15 | Добавлено: 16.06.08 09:18 |
|
Я на висте уже больше года сижу, и ничего, жив-здоров, чего и вам желаю.
|
||