Народ ! Привет всем ! Вопр по отправке пакетов чрез API

Программирование на Visual Basic, главный форум. Обсуждение тем программирования на VB 1—6.
Даже если вы плохо разбираетесь в VB и программировании вообще — тут вам помогут. В разумных пределах, конечно.
Правила форума
Темы, в которых будет сначала написано «что нужно сделать», а затем просьба «помогите», будут закрыты.
Читайте требования к создаваемым темам.
ALX_2002
Мега гуру
Мега гуру
 
Сообщения: 2054
Зарегистрирован: 25.11.2002 (Пн) 20:03

Народ ! Привет всем ! Вопр по отправке пакетов чрез API

Сообщение ALX_2002 » 03.04.2003 (Чт) 18:13

Люди ! Хай всем вам. Рад был снова побывать в этом священном месте.
Значит так... Дело такое - Мне нужно каким то образом отправить по локалке пакет заданного размера на указанный ip. Я конечно понимаю, что большинство сразу решит, что я собираюсь делать ньюк или что то подобное, но
1) Сейчас в локалке на всех компах 2000 и AVP
2) Админы секут это дело
3) Мне это нужно, чтобы не пинговать чужой комп через PING, а именно через api тестить его наличие.
Если у кого есть инфа и он готов со мной поделиться, буду ОООЧЕНЬ благодарен. Нужно по зарез.
'--------------------------------------------------------------------------------
З.Ы - Нужно просто отправить пакет заданного размера по сетке на нужный ip
:D

Sebas
Неуловимый Джо
Неуловимый Джо
Аватара пользователя
 
Сообщения: 3626
Зарегистрирован: 12.02.2002 (Вт) 17:25
Откуда: столько наглости такие вопросы задавать

Сообщение Sebas » 03.04.2003 (Чт) 18:25

А чем Winsock & UDP Не подходит?
- Я никогда не понимал, почему они приходят ко мне чтобы умирать?

sebas<-@->mail.ru

ALX_2002
Мега гуру
Мега гуру
 
Сообщения: 2054
Зарегистрирован: 25.11.2002 (Пн) 20:03

Сообщение ALX_2002 » 04.04.2003 (Пт) 13:17

2 Sebas: Хм... Дело в том, что я то и хочу пользовать Winsock, но не через контрол, а через Api. Ну не люблю я эти контролы... Ну не радуют они меня... Может это глупо.. Готов согласиться, но всё таки Api я уважаю больше.. :roll: .... Вообщем - хотелось бы именно через api это сделать. :wink: ...

ALX_2002
Мега гуру
Мега гуру
 
Сообщения: 2054
Зарегистрирован: 25.11.2002 (Пн) 20:03

Сообщение ALX_2002 » 18.04.2003 (Пт) 15:10

Ну так чё пиплы ? Есть ещё варианты ? :?:

alibek
Большой Человек
Большой Человек
 
Сообщения: 14205
Зарегистрирован: 19.04.2002 (Пт) 11:40
Откуда: Russia

Сообщение alibek » 18.04.2003 (Пт) 16:16

Ну делай через API
Декларации будут вида Declare Function ... Lib "wsock32.dll" ...
Если нужен пример, то вот пример из API-Guide (скачивение файла, тут все, и подключение и прием/передача данных)
Код: Выделить всё
'This project needs a TextBox
'-> (Name)=Text1
'-> MultiLine=True
'in a form
Private Sub Form_Load()
    'KPD-Team 2000
    'URL: http://www.allapi.net/
    'E-Mail: KPDTeam@Allapi.net
    Dim sSave As String
    Me.AutoRedraw = True
    Set Obj = Me.Text1
    'Start subclassing
    HookForm Me
    'create a new winsock session
    StartWinsock sSave
    'show the winsock version on this form
    If InStr(1, sSave, Chr$(0)) > 0 Then sSave = Left$(sSave, InStr(1, sSave, Chr$(0)) - 1)
    Me.Print sSave
    'connect to Microsoft.com
    lSocket = ConnectSock("www.microsoft.com", 80, 0, Me.hwnd, False)
End Sub
Private Sub Form_Unload(Cancel As Integer)
    'close our connection to microsoft.com
    closesocket lSocket
    'end winsock session
    EndWinsock
    'stop subclassing
    UnHookForm Me
End Sub
'in a module
Public Const AF_INET = 2
Public Const INVALID_SOCKET = -1
Public Const SOCKET_ERROR = -1
Public Const FD_READ = &H1&
Public Const FD_WRITE = &H2&
Public Const FD_CONNECT = &H10&
Public Const FD_CLOSE = &H20&
Public Const PF_INET = 2
Public Const SOCK_STREAM = 1
Public Const IPPROTO_TCP = 6
Public Const GWL_WNDPROC = (-4)
Public Const WINSOCKMSG = 1025
Public Const WSA_DESCRIPTIONLEN = 256
Public Const WSA_DescriptionSize = WSA_DESCRIPTIONLEN + 1
Public Const WSA_SYS_STATUS_LEN = 128
Public Const WSA_SysStatusSize = WSA_SYS_STATUS_LEN + 1
Public Const INADDR_NONE = &HFFFF
Public Const SOL_SOCKET = &HFFFF&
Public Const SO_LINGER = &H80&
Public Const hostent_size = 16
Public Const sockaddr_size = 16
Type WSADataType
    wVersion As Integer
    wHighVersion As Integer
    szDescription As String * WSA_DescriptionSize
    szSystemStatus As String * WSA_SysStatusSize
    iMaxSockets As Integer
    iMaxUdpDg As Integer
    lpVendorInfo As Long
End Type
Type HostEnt
    h_name As Long
    h_aliases As Long
    h_addrtype As Integer
    h_length As Integer
    h_addr_list As Long
End Type
Type sockaddr
    sin_family As Integer
    sin_port As Integer
    sin_addr As Long
    sin_zero As String * 8
End Type
Type LingerType
    l_onoff As Integer
    l_linger As Integer
End Type
Public Declare Function setsockopt Lib "wsock32.dll" (ByVal s As Long, ByVal Level As Long, ByVal optname As Long, optval As Any, ByVal optlen As Long) As Long
Public Declare Function getsockopt Lib "wsock32.dll" (ByVal s As Long, ByVal Level As Long, ByVal optname As Long, optval As Any, optlen As Long) As Long
Public Declare Function WSAGetLastError Lib "wsock32.dll" () As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function WSAIsBlocking Lib "wsock32.dll" () As Long
Public Declare Function WSACleanup Lib "wsock32.dll" () As Long
Public Declare Function Send Lib "wsock32.dll" Alias "send" (ByVal s As Long, buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long
Public Declare Function recv Lib "wsock32.dll" (ByVal s As Long, buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long
Public Declare Function WSAStartup Lib "wsock32.dll" (ByVal wVR As Long, lpWSAD As WSADataType) As Long
Public Declare Function htons Lib "wsock32.dll" (ByVal hostshort As Long) As Integer
Public Declare Function ntohs Lib "wsock32.dll" (ByVal netshort As Long) As Integer
Public Declare Function socket Lib "wsock32.dll" (ByVal af As Long, ByVal s_type As Long, ByVal protocol As Long) As Long
Public Declare Function closesocket Lib "wsock32.dll" (ByVal s As Long) As Long
Public Declare Function Connect Lib "wsock32.dll" Alias "connect" (ByVal s As Long, addr As sockaddr, ByVal namelen As Long) As Long
Public Declare Function WSAAsyncSelect Lib "wsock32.dll" (ByVal s As Long, ByVal hwnd As Long, ByVal wMsg As Long, ByVal lEvent As Long) As Long
Public Declare Function inet_addr Lib "wsock32.dll" (ByVal cp As String) As Long
Public Declare Function gethostbyname Lib "wsock32.dll" (ByVal host_name As String) As Long
Public Declare Sub MemCopy Lib "kernel32" Alias "RtlMoveMemory" (Dest As Any, Src As Any, ByVal cb&)
Public Declare Function inet_ntoa Lib "wsock32.dll" (ByVal inn As Long) As Long
Public Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Any) As Long
Public Declare Function WSACancelBlockingCall Lib "wsock32.dll" () As Long
Public saZero As sockaddr
Public WSAStartedUp As Boolean, Obj As TextBox
Public PrevProc As Long, lSocket As Long
'subclassing functions
'for more information about subclassing,
'check out the subclassing tutorial at http://www.allapi.net/
Public Sub HookForm(F As Form)
    PrevProc = SetWindowLong(F.hwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
Public Sub UnHookForm(F As Form)
    If PrevProc <> 0 Then
        SetWindowLong F.hwnd, GWL_WNDPROC, PrevProc
        PrevProc = 0
    End If
End Sub
Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If uMsg = WINSOCKMSG Then
        ProcessMessage wParam, lParam
    Else
        WindowProc = CallWindowProc(PrevProc, hwnd, uMsg, wParam, lParam)
    End If
End Function
'our Winsock-message handler
Public Sub ProcessMessage(ByVal lFromSocket As Long, ByVal lParam As Long)
    Dim X As Long, ReadBuffer(1 To 1024) As Byte, strCommand As String
    Select Case lParam
        Case FD_CONNECT 'we are connected to microsoft.com
        Case FD_WRITE 'we can write to our connection
            'this is a part of the HTTP protocol
            'for more information about this protocol, visit http://www.w3c.org/
            strCommand = "GET http://www.microsoft.com/ HTTP/1.0" + vbCrLf
            strcomand = strCommand + "Pragma: no-cache" + vbCrLf
            strCommand = strCommand + "Accept: */*" + vbCrLf
            strCommand = strCommand + "Accept: text/html" + vbCrLf + vbCrLf
            'send the data to our microsoft.com-connection
            SendData lFromSocket, strCommand
        Case FD_READ 'we have data waiting to be processed
            'start reading the data
            Do
                X = recv(lFromSocket, ReadBuffer(1), 1024, 0)
                If X > 0 Then
                    Obj.Text = Obj.Text + Left$(StrConv(ReadBuffer, vbUnicode), X)
                End If
                If X <> 1024 Then Exit Do
            Loop
        Case FD_CLOSE 'the connection with microsoft.com is closed
    End Select
End Sub
'the following functions are standard WinSock functions
'from the wsksock.bas-file
Public Function StartWinsock(sDescription As String) As Boolean
    Dim StartupData As WSADataType
    If Not WSAStartedUp Then
        If Not WSAStartup(&H101, StartupData) Then
            WSAStartedUp = True
            sDescription = StartupData.szDescription
        Else
            WSAStartedUp = False
        End If
    End If
    StartWinsock = WSAStartedUp
End Function
Sub EndWinsock()
    Dim Ret&
    If WSAIsBlocking() Then
        Ret = WSACancelBlockingCall()
    End If
    Ret = WSACleanup()
    WSAStartedUp = False
End Sub
Public Function SendData(ByVal s&, vMessage As Variant) As Long
    Dim TheMsg() As Byte, sTemp$
    TheMsg = ""
    Select Case VarType(vMessage)
        Case 8209   'byte array
            sTemp = vMessage
            TheMsg = sTemp
        Case 8      'string, if we recieve a string, its assumed we are linemode
            sTemp = StrConv(vMessage, vbFromUnicode)
        Case Else
            sTemp = CStr(vMessage)
            sTemp = StrConv(vMessage, vbFromUnicode)
    End Select
    TheMsg = sTemp
    If UBound(TheMsg) > -1 Then
        SendData = Send(s, TheMsg(0), (UBound(TheMsg) - LBound(TheMsg) + 1), 0)
    End If
End Function
Function ConnectSock(ByVal Host$, ByVal Port&, retIpPort$, ByVal HWndToMsg&, ByVal Async%) As Long
    Dim s&, SelectOps&, Dummy&
    Dim sockin As sockaddr
    SockReadBuffer$ = ""
    sockin = saZero
    sockin.sin_family = AF_INET
    sockin.sin_port = htons(Port)
    If sockin.sin_port = INVALID_SOCKET Then
        ConnectSock = INVALID_SOCKET
        Exit Function
    End If

    sockin.sin_addr = GetHostByNameAlias(Host$)

    If sockin.sin_addr = INADDR_NONE Then
        ConnectSock = INVALID_SOCKET
        Exit Function
    End If
    retIpPort$ = getascip$(sockin.sin_addr) & ":" & ntohs(sockin.sin_port)

    s = socket(PF_INET, SOCK_STREAM, IPPROTO_TCP)
    If s < 0 Then
        ConnectSock = INVALID_SOCKET
        Exit Function
    End If
    If SetSockLinger(s, 1, 0) = SOCKET_ERROR Then
        If s > 0 Then
            Dummy = closesocket(s)
        End If
        ConnectSock = INVALID_SOCKET
        Exit Function
    End If
    If Not Async Then
        If Connect(s, sockin, sockaddr_size) <> 0 Then
            If s > 0 Then
                Dummy = closesocket(s)
            End If
            ConnectSock = INVALID_SOCKET
            Exit Function
        End If
        SelectOps = FD_READ Or FD_WRITE Or FD_CONNECT Or FD_CLOSE
        If WSAAsyncSelect(s, HWndToMsg, ByVal 1025, ByVal SelectOps) Then
            If s > 0 Then
                Dummy = closesocket(s)
            End If
            ConnectSock = INVALID_SOCKET
            Exit Function
        End If
    Else
        SelectOps = FD_READ Or FD_WRITE Or FD_CONNECT Or FD_CLOSE
        If WSAAsyncSelect(s, HWndToMsg, ByVal 1025, ByVal SelectOps) Then
            If s > 0 Then
                Dummy = closesocket(s)
            End If
            ConnectSock = INVALID_SOCKET
            Exit Function
        End If
        If Connect(s, sockin, sockaddr_size) <> -1 Then
            If s > 0 Then
                Dummy = closesocket(s)
            End If
            ConnectSock = INVALID_SOCKET
            Exit Function
        End If
    End If
    ConnectSock = s
End Function
Function GetHostByNameAlias(ByVal hostname$) As Long
    On Error Resume Next
    Dim phe&
    Dim heDestHost As HostEnt
    Dim addrList&
    Dim retIP&
    retIP = inet_addr(hostname)
    If retIP = INADDR_NONE Then
        phe = gethostbyname(hostname)
        If phe <> 0 Then
            MemCopy heDestHost, ByVal phe, hostent_size
            MemCopy addrList, ByVal heDestHost.h_addr_list, 4
            MemCopy retIP, ByVal addrList, heDestHost.h_length
        Else
            retIP = INADDR_NONE
        End If
    End If
    GetHostByNameAlias = retIP
    If Err Then GetHostByNameAlias = INADDR_NONE
End Function
Function getascip(ByVal inn As Long) As String
    On Error Resume Next
    Dim lpStr&
    Dim nStr&
    Dim retString$
    retString = String(32, 0)
    lpStr = inet_ntoa(inn)
    If lpStr = 0 Then
        getascip = "255.255.255.255"
        Exit Function
    End If
    nStr = lstrlen(lpStr)
    If nStr > 32 Then nStr = 32
    MemCopy ByVal retString, ByVal lpStr, nStr
    retString = Left(retString, nStr)
    getascip = retString
    If Err Then getascip = "255.255.255.255"
End Function
Public Function SetSockLinger(ByVal SockNum&, ByVal OnOff%, ByVal LingerTime%) As Long
    Dim Linger As LingerType
    Linger.l_onoff = OnOff
    Linger.l_linger = LingerTime
    If setsockopt(SockNum, SOL_SOCKET, SO_LINGER, Linger, 4) Then
        Debug.Print "Error setting linger info: " & WSAGetLastError()
        SetSockLinger = SOCKET_ERROR
    Else
        If getsockopt(SockNum, SOL_SOCKET, SO_LINGER, Linger, 4) Then
            Debug.Print "Error getting linger info: " & WSAGetLastError()
            SetSockLinger = SOCKET_ERROR
        End If
    End If
End Function
Lasciate ogni speranza, voi ch'entrate.

gaidar
System Debugger
System Debugger
 
Сообщения: 3152
Зарегистрирован: 23.12.2001 (Вс) 13:22

Re: Народ ! Привет всем ! Вопр по отправке пакетов чрез API

Сообщение gaidar » 18.04.2003 (Пт) 19:30

ALX_2002 писал(а):Хай всем вам. :D


От таких слов лучше воздержаться. Тут мне дамы жалуются :)
The difficult I’ll do right now. The impossible will take a little while. (c) US engineers in WWII
I don't always know what I'm talking about, but I know I'm right. (c) Muhammad Ali

FaKk2
El rebelde gur&#250;
El rebelde gur&#250;
Аватара пользователя
 
Сообщения: 2031
Зарегистрирован: 09.03.2003 (Вс) 22:10
Откуда: Los Angeles

Сообщение FaKk2 » 18.04.2003 (Пт) 23:20

Кстати о дамах. Не пора ли ввести графу Пол в анкету?
А то можно сильно перепутать.... :D
Для получения ответа надо продемонстрировать качества, позволяющие стать компетентным — внимательность, вдумчивость, наблюдательность, желание активно участвовать в выработке решения.

ALX_2002
Мега гуру
Мега гуру
 
Сообщения: 2054
Зарегистрирован: 25.11.2002 (Пн) 20:03

Re: Народ ! Привет всем ! Вопр по отправке пакетов чрез API

Сообщение ALX_2002 » 19.04.2003 (Сб) 16:17

gaidar писал(а):
ALX_2002 писал(а):Хай всем вам. :D


От таких слов лучше воздержаться. Тут мне дамы жалуются :)


Не пнял ! ? А чем эта фраза оскорбляет дам ???? :(

2 alibek: Дядька ! Благодарю тя безмерно ! :D :!:
Ща буду разбираться. !

FaKk2
El rebelde gur&#250;
El rebelde gur&#250;
Аватара пользователя
 
Сообщения: 2031
Зарегистрирован: 09.03.2003 (Вс) 22:10
Откуда: Los Angeles

Сообщение FaKk2 » 19.04.2003 (Сб) 20:19

Не пнял ! ? А чем эта фраза оскорбляет дам ????


Потому что слово "Хай", у людей с развитым воображением ассоциируется со словом "Х%й", которое естественно очень неприличное. :lol: :lol:
Для получения ответа надо продемонстрировать качества, позволяющие стать компетентным — внимательность, вдумчивость, наблюдательность, желание активно участвовать в выработке решения.


Вернуться в Visual Basic 1–6

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 52

    TopList