Страница: 1 | 2 |
|
Вопрос: Перевести из С++
|
Добавлено: 22.10.04 13:37
|
|
Номер ответа: 20 Автор ответа: LamerOnLine
ICQ: 334781088
Вопросов: 108 Ответов: 2822
|
Профиль | | #20
|
Добавлено: 28.10.04 11:11
|
Получилось!!! Сделал все на АПИ, хоть и через задницу. Теперь все ништяк,
шлет пакеты. Вот такой пирог:
[CODE]
Option Explicit
Option Base 1
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As
Any, pSrc As Any, ByVal ByteLen As Long)
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As
Long) As Long
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA"
(ByVal lpLibFileName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As
Long, ByVal lpProcName As String) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA"
(ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Any, ByVal
wParam As Any, ByVal lParam As Any) As Long
Dim mHandle As Long
Dim fAddr As Long
Dim AdapterName As String
Dim lpAdapter As Long
Private Type NetType
LinkType As Long
LinkSpeed As Long
End Type
Private Type packet
Buffer As Long
Length As Long
Next As Long
ulBytesReceived As Long
End Type
Dim fAllocPacket As Long
Dim fInitPacket As Long
Dim fSendPacket As Long
Dim fFreePacket As Long
Private Sub Command1_Click()
Dim Buffer(1024) As Byte
PacketSendPacket Buffer()
End Sub
Private Sub Form_Load()
Dim NT As NetType
Dim sPtr As String
Dim Size As Long
Dim pSize As Long
Dim aPtr As Long
sPtr = Space(1024)
Dim psPtr As Long
psPtr = StrPtr(sPtr)
Size = Len(sPtr)
pSize = VarPtr(Size)
mHandle = LoadLibrary("Packet.dll")
'ULONG PacketGetAdapterNames(PTSTR pStr, PULONG BufferSize)
fAddr = GetProcAddress(mHandle, "PacketGetAdapterNames")
CallWindowProc fAddr, psPtr, pSize, ByVal 0&, ByVal 0&
AdapterName = Split(sPtr, vbNullChar)(0)
Text1.Text = AdapterName
'LPADAPTER PacketOpenAdapter(LPTSTR AdapterName)
fAddr = GetProcAddress(mHandle, "PacketOpenAdapter")
psPtr = StrPtr(AdapterName)
lpAdapter = CallWindowProc(fAddr, psPtr, ByVal 0&, ByVal 0&, ByVal 0&)
'LPPACKET PacketAllocatePacket(void)
fAllocPacket = GetProcAddress(mHandle, "PacketAllocatePacket")
'VOID PacketInitPacket(LPPACKET lpPacket, PVOID Buffer, UINT Length)
fInitPacket = GetProcAddress(mHandle, "PacketInitPacket")
'BOOLEAN PacketSendPacket(LPADAPTER AdapterObject, LPPACKET pPacket, BOOLEAN
Sync)
fSendPacket = GetProcAddress(mHandle, "PacketSendPacket")
'VOID PacketFreePacket(LPPACKET lpPacket)
fFreePacket = GetProcAddress(mHandle, "PacketFreePacket")
End Sub
Private Sub Form_Unload(Cancel As Integer)
FreeLibrary mHandle
End Sub
Private Sub PacketGetNetInfo(ByRef AdapterName As String, ByRef NetIP As
String, ByRef NetMask As String)
Dim aPtr As Long
fAddr = GetProcAddress(mHandle, "PacketGetNetInfo")
Dim netp As Long
Dim maskp As Long
aPtr = CallWindowProc(fAddr, StrPtr(AdapterName), VarPtr(netp),
VarPtr(maskp), ByVal 0&)
Dim ip(4) As Byte
CopyMemory ByVal VarPtr(ip(1)), ByVal VarPtr(netp), 4
NetIP = ip(4) & "." & ip(3) & "." & ip(2) & "." & ip(1)
CopyMemory ByVal VarPtr(ip(1)), ByVal VarPtr(maskp), 4
NetMask = ip(4) & "." & ip(3) & "." & ip(2) & "." & ip(1)
End Sub
Private Sub PacketSendPacket(ByRef Buffer() As Byte)
Dim aPtr As Long
Dim i As Long
For i = 1 To 12
Buffer(i) = 255 'Set MAC
Next i
aPtr = CallWindowProc(fAllocPacket, ByVal 0&, ByVal 0&, ByVal 0&, ByVal 0&)
CallWindowProc fInitPacket, ByVal aPtr, ByVal VarPtr(Buffer(1)), ByVal
1024&, ByVal 0&
CallWindowProc fSendPacket, ByVal lpAdapter, ByVal aPtr, ByVal 1&, ByVal 0&
CallWindowProc fFreePacket, ByVal aPtr, ByVal 0&, ByVal 0&, ByVal 0&
End Sub
[/CODE]
Ответить
|
Страница: 1 | 2 |
Поиск по форуму