Ping из Clarion

Народ кто нибудь уже реализовывал ping , net use средствами Clarion буду очень признателен
AlexBoot@Agroimport.com.ua

Сообщение **Admin** » 09 Июнь 2008, 13:07

Опять же смотрим гугль...
К примеру: http://www.delphimaster.ru/articles/icmp.html
Там все довольно таки просто

WadimZapara

  PROGRAM
! ТИПЫ
DWORD     EQUATE(ULONG)
SOCKET    EQUATE(UNSIGNED)

! КОНСТАНТЫ
WSADESCRIPTION_LEN  Equate(256)
WSASYS_STATUS_LEN   Equate(128)
FD_SETSIZE          EQUATE(64)

! СТРУКТУРЫ
FD_SET     GROUP,TYPE
FD_COUNT      ULong
FD_ARRAY      SOCKET,DIM(FD_SETSIZE)
           END !group

PHostEnt  Group, Type        ! ТИП СТРУКТУРЫ, ССЫЛКУ НА КОТОРУЮ ВОЗВРАЩАЕТ GetHostByName
h_name         ULong        ! PChar
h_aliases      ULong        ! ^PChar           - указатель на массив
h_addrtype     UShort       ! Smallint (2b)
h_length       UShort       ! Smallint (2b)
h_addr_list    ULong        ! ^PChar           - указатель на массив
          End

TIMEVAL    GRoup,Type
tv_sec      Long       ! число секунд
tv_usec     Long       ! число микросекунд (1с = 1'000'000мкс)
           End

   MAP
      MODULE('Windows.DLL')
         GetLastError(),DWORD,PASCAL,Dll(TRUE)
         WSAStartup    (Short, *Group), Signed,PASCAL,RAW,Dll(TRUE)      ! Подключение к NET API
         WSACleanup    (), Signed,PASCAL,Dll(TRUE),Proc                  ! Отключение от NET API
         CreateSocket(Short af, Short type, Short protocol),SOCKET, raw,pascal,dll(TRUE),Name('Socket')
         SetSockOpt(SOCKET Socket, Long Level, Long OptName, ULong Addr_OptVal, Long OptValLen=4),Signed,RAW,PASCAL,DLL(TRUE)
         CloseSocket(SOCKET Socket),SHORT, RAW,PASCAL,DLL(TRUE), Proc
         RecvFrom(SOCKET socket, ULong AddrBuf, Short len, Short flags, ULong Addr_SOCKADDR, *Short FromLen),SHORT,RAW,PASCAL,DLL(TRUE)
         SendTo(SOCKET Socket, ULong AddrBuffer, Short len, Short flags, ULong Addr_SOCKADDR_to, Short len_to),SHORT,RAW,PASCAL,DLL(TRUE)
         GetHostByName (*CString), *ULong,PASCAL,RAW,Dll(TRUE)           ! Получение сетевой информации КОМПА
         GetTickCount(),ULong,PASCAL,DLL(TRUE)
         GetCurrentProcessId(),ULong,PASCAL,DLL(TRUE)
         Select(Short nfds,<*FD_SET readfds>,<*FD_SET writefds>,<*FD_SET exceptfds>,*TIMEVAL timeout),SHORT,RAW,PASCAL,DLL(TRUE)
         ! Unicode CString --> CString
         WideCharToMultiByte(Unsigned CodePage, ULong dwFlags,                |
                             *CString lpWideCharStr,  Signed cchWideChar=-1,  |
                             *CString lpMultiByteStr, Signed cbMultiByte,     |
                             ULong Addr_lpCStr_DefaultChar=0, ULong lpBool_UsedDefaultChar=0), Signed, RAW, Pascal, Dll, Name('WideCharToMultiByte')
      END

      GetValFromAddr(String Type_WCS124L6R8, ULong addr, Long Leng=-1), ?, Name('GetValFromAddr@ZWM_Function')
      WideCStr_To_Str(*CString cstr, Long Leng=-1), String, Name('WideCStr_To_Str@ZWM_Function')

      PING(String IpAddr, ULong TimeOut_sec=1, ULong TimeOut_mks=0, <*ULong Elapsed_ms>, <*Byte TTL>),Byte,Name('PING@ZWM_Function')
   END

  CODE
!----------------------------

PING    Function(String IpAddr, ULong TimeOut_sec=1, ULong TimeOut_ms=0, <*ULong Elapsed_ms>, <*Byte TTL>) !,Byte

wsd              Group                                      !Like(TWSAData)
wVersion           Short                                    !
wHighVersion       Short                                    !
szDescription      CString(WSADESCRIPTION_LEN+1)            !
szSystemStatus     CString(WSASYS_STATUS_LEN+1)             !
iMaxSockets        UShort                                   !UnSigned
iMaxUdpDg          UShort                                   !UnSigned
lpVendorInfo       CString(30)                              !Long
                 End

AF_INET        EQUATE(2)
SOCK_RAW       EQUATE(3)
IPPROTO_ICMP   EQUATE(1)

SOL_SOCKET     Equate(0FFFFh)
SO_REUSEADDR        Equate(000000004h)
SO_EXCLUSIVEADDRUSE Equate(0FFFFFFFBh)   ! SO_EXCLUSIVEADDRUSE = NOT(SO_REUSEADDR)

IPPROTO_IP     Equate(0)
IP_OPTIONS     Equate(1)
IP_HDRINCL     Equate(2)

SOCKET_ERROR   EQUATE(-1)

rawSocket     SOCKET
strHost   CString(WSADESCRIPTION_LEN + 1)
lpHost    &PHostEnt

IN_ADDR        Equate(ULONG)

SOCKADDR_IN             GROUP,TYPE
sin_family                SHORT
sin_port                  USHORT
sin_addr                  IN_ADDR
sin_zero                  CSTRING(8)
                        END

sDest       Like(SOCKADDR_IN)
sSrc        Like(SOCKADDR_IN)

pcs  &CString


ICMPHDR  GROUP,Type       !размер в Byte-ах, Word-ах
Type       Byte           !          1        1/2
Code       Byte           !          1        1/2
Checksum   UShort         !          2         1
ID         UShort         !          2         1
Seq        UShort         !          2         1
         END              !          8         4

Sz_cData_echoReq  Equate(64)

ECHOREQUEST GROUP,TYPE                    !размер в Byte-ах, в Word-ах
icmpHdr        LIKE(ICMPHDR)              !           8          4
dwTime         DWORD                      !           4          2
cData          Byte,Dim(Sz_cData_echoReq) !          64         32
            END                           !          76         38

echoReq     Like(ECHOREQUEST)

SzWrd_echoReq  Equate(4+2+32)

echoReq_w   UShort,Dim(SzWrd_echoReq),OVER(echoReq)

ICMP_ECHOREQ Equate(8)

readfds   LIKE(FD_SET)
tVal      LIKE(TIMEVAL)

IPHDR     GROUP,TYPE
VIHL         BYTE
TOS          BYTE
TotLen       UShort
ID           UShort
FlagOff      UShort
TTL          BYTE
Protocol     BYTE
Checksum     UShort
iaSrc        IN_ADDR
iaDst        IN_ADDR
          END

echoReply GROUP
ipHdr       LIKE(IPHDR)
echoRequest LIKE(ECHOREQUEST)
cFiller     Byte(256)
          END

nAddrLen  Short(Size(sSrc))
ok   BYTE(TRUE)
  MAP
    CheckSum(*UShort[] ush, Short ln), UShort
  END

!для отладки:
MestoErr Byte
CodeErr  Long(1)

IpOpt    Group
code       Byte(7)
len        Byte(39)
ptr        Byte(4)
addr       ULong,Dim(10)
         End
    CODE

  IF ~Omitted(4) Then Clear(Elapsed_ms).
  IF ~Omitted(5) Then Clear(TTL).

  IF WSAStartup(202h, wsd) THEN    ! Error
    MestoErr=1; CodeErr=GetLastError()
    Clear(ok)
  ELSE                             ! Create socket (Создание сокета)
    rawSocket = CreateSocket(AF_INET, SOCK_RAW, IPPROTO_ICMP)
    If (rawSocket = SOCKET_ERROR) Then  !   Socket error
      MestoErr=2; CodeErr=GetLastError()
      Clear(ok)
    Else
       ! ! Setup the IP option header to go out on every ICMP packet
       ! !
       ! ipopt.code = IP_RECORD_ROUTE; ! Record route option
       ! ipopt.ptr  = 4;               ! Point to the first addr offset
       ! ipopt.len  = 39;              ! Length of option header
       ! IF SetSockOpt(rawSocket, IPPROTO_IP, IP_OPTIONS, ADDRESS(IpOpt.code), Size(IpOpt)) THEN STOP('SetSockOpt err.1='& GetLastError()).
       
       ! ! Set the send/recv timeout values
       ! bread = setsockopt(sockRaw, SOL_SOCKET, SO_RCVTIMEO, (char*)&timeout, sizeof(timeout));
       ! timeout = 1000;
       ! bread = setsockopt(sockRaw, SOL_SOCKET, SO_SNDTIMEO, (char*)&timeout, sizeof(timeout));
       
      If SetSockOpt(rawSocket, SOL_SOCKET, SO_REUSEADDR, ADDRESS(CodeErr), 4) Then STOP('SetSockOpt err.2='& GetLastError()).
    
      ! Lookup host (Поиск хоста)
      strHost = Clip(IPAddr)
      lpHost &= Address(GetHostByName(strHost))
      If lpHost &= NULL Then                   ! ERROR
        MestoErr=3; CodeErr=GetLastError()
        Clear(Ok)
      Else                         ! Socket address (Адрес сокета)
        sDest.sin_family = AF_INET
        sDest.sin_port = 0
        sDest.sin_addr = GetValFromAddr('L', lpHost.h_addr_list)    ! адрес первого IP
        sDest.sin_addr = GetValFromAddr('L', sDest.sin_addr)        ! значение IP это 4 байта, подлежащие преобразованию
        ! Send ICMP echo request (Посылка эхо-запроса ICMP)
        echoReq.icmpHdr.Type = ICMP_ECHOREQ          ! byte
        echoReq.icmpHdr.Code = 0                     ! byte
        echoReq.icmpHdr.ID   = GetCurrentProcessID() ! ushort
        echoReq.icmpHdr.Seq  = 0                     ! ushort
        echoReq.dwTime = GetTickCount()
        ok += Sz_cData_echoReq
        Loop 
          ok -= 1
          echoReq.cData[ok] = 80
        Until ok = 1
        echoReq.icmpHdr.Checksum = CheckSum(echoReq_w, SzWrd_echoReq)
        ! Send the echo request (Отправка эхо-запроса)
        CASE SendTo(rawSocket, Address(echoReq), Size(echoReq), 0, Address(sDest), Size(sDest))
        OF 0
          MestoErr=4; CodeErr=GetLastError()
          Clear(Ok)
        OF SOCKET_ERROR
          MestoErr=5; CodeErr=GetLastError()
          Clear(Ok)
        ELSE
          readfds.fd_count = 1;  readfds.fd_array[1] = rawSocket
          tVal.tv_sec = TimeOut_sec;  tVal.tv_usec = TimeOut_ms * 1000
          Case select(1, readfds, , , tVal)
          Of 0 
            MestoErr=6; CodeErr=GetLastError()
            Clear(ok)
          Of SOCKET_ERROR
            MestoErr=7; CodeErr=GetLastError()
            Clear(ok)
          Else               !    Receive reply (Получение ответа)
            ! nAddrLen = Size(sSrc) !это сделано при инициализации
            ! Receive the echo reply
            case RecvFrom(rawSocket, Address(echoReply), Size(echoReply), 0, Address(sSrc), nAddrLen)
            of 0 
              MestoErr=8; CodeErr=GetLastError()
              Clear(ok)
            orof SOCKET_ERROR  ! Socket закрыт или Recvfrom Error
              MestoErr=9; CodeErr=GetLastError()
              Clear(ok)
            else             ! Проверяем, что запрос - наш, этот.
              If echoReply.echoRequest.dwTime <> echoReq.dwTime         OR |
                 echoReply.echoRequest.icmpHdr.Type                     OR |
                 echoReply.echoRequest.icmpHdr.ID <> echoReq.icmpHdr.ID OR |
                 sSrc.sin_addr <> sDest.sin_addr                     Then
                MestoErr=10; CodeErr=GetLastError()
                Clear(ok) ! чужое
              Else           ! Calculate time (Расчет времени)
                If ~Omitted(4) Then Elapsed_ms = GetTickCount() - echoReply.echoRequest.dwTime.
                If ~Omitted(5) Then TTL = echoReply.ipHdr.TTL.
              End !If
            end !case RecvFrom(
          End !Case select(
        END !CASE SendTo(
      End !If lpHost &= NULL 
      CloseSocket(rawSocket)  ! на ошибку не проверяем
    End !If (rawSocket = SOCKET_ERROR)
    WSACleanup()
  END !IF WSAStartup(
  IF ~ok THEN
    IF ~Omitted(5) Then TTL=MestoErr.
    IF ~Omitted(4) Then Elapsed_ms=CodeErr.
  END
  Return(ok)

CheckSum Function(*UShort[] ush, Short ln) !, UShort
sum ULong(0)
ret UShort,Auto
i   Short,Auto
  Code
  Loop i = 1 To ln;  sum += ush[i].
  sum = BShift(sum, -16) + BAND(sum, 0FFFFh)
  sum += BShift(sum, -16)
  ret = BXOR(sum, 0FFFFFFFFh)
 Return(ret)

!==========================================================================================
GetValFromAddr       FUNCTION (String Type_WCS124L6R8, ULong addr, Long Leng=-1) !, ?
!==========================================================================================
! Реализует возврат значения по указателю.
! На входе: addr    - адрес значения
!           Type_?  - литера 'C' или 'c'         - вернуть String, то есть в ADDR адрес CString
!                     литера 'W' или 'w'         - вернуть String, полагая в ADDR адрес WideString (Unicode),
!                                                  при этом может быть задан параметр Leng > 0 число символов (а не байт)
!                     литера 'S' или 's'         - вернуть String, то есть в ADDR адрес String, при этом обязателен
!                                                  параметр Leng > 0, число байт
!                     литера '1'                 - вернуть Byte,    то есть в ADDR адрес байта
!                     литера '2'                 - вернуть USort,   то есть в ADDR адрес 2-байтового числа
!                     литера 'L' или 'l' или '4' - вернуть Long,    то есть в ADDR адрес 4-байтового числа
!                     литера '6'                 - вернуть строку из 6 байт
!                     литера 'R' или 'r' или '8' - вернуть REAL
! Следующие структуры используют одно и то же место в памяти
! и реализуют получение по адресу значения

AddressX  Group                 ! адрес на значение переменной
addrX       ULong
lng         ULong
          End
pCString  Group,Over(AddressX)    ! ссылка на CSTRING
_str        &CString
          End
p_String  Group,Over(AddressX)    ! ссылка на STRING
_str        &String
          End
pLong     Group,Over(AddressX)    ! ссылка на ULong
_long       &ULong
          End
pByte     Group,Over(AddressX)    ! ссылка на Byte
_byte       &Byte
          End
pUShort   Group,Over(AddressX)    ! ссылка на UShort
_short      &UShort
          End
pReal     Group,Over(AddressX)    ! ссылка на Real
_real       &Real
          End

  CODE
  
  AddressX.addrX = addr
  Case Upper(Type_WCS124L6R8)
    Of 'C'
      Return(pCString._str)
    Of 'W'
      Return( WideCStr_To_Str(pCString._str, Leng) )
    Of 'S'
      If Leng < 1 Then Return ('').
      AddressX.lng = Leng
      Return(p_String._str)
    Of '1'
      Return(pByte._byte)
    Of '2'
      Return(pUShort._short)
    Of '4' OrOf 'L'
      Return(pLong._long)
    Of '6'
      AddressX.lng = 6
      Return(p_String._str)
    Of '8' OrOf 'R'
      Return(pReal._real)
    Else
      IF MESSAGE('Непоправимая ошибка программиста.|'& |
                 'Нужно задавать тип источника как один из:|'& |
                 '  "C" или "c"         - CSTRING|'& |
                 '  "W" или "w"         - Unicode CSTRING или Unicode STRING|'& |
                 '  "S" или "s"         - STRING|'& |
                 '  "L" или "l" или "4" - ULONG|'& |
                 '  "R" или "r" или "8" - REAL|'& |
                 '  "1"                 - BYTE|'& |
                 '  "2"                 - USHORT|'& |
                 '  "6" (специальный)   - STRING(6)||'& |
                 'Для типа "W" может быть задана длина строки Unicode (в символах)'& |
                 'Для типа "S" ДОЛЖНА быть задана длина строки (в байтах)' |
            , 'GetFromAddr - ERROR.', ICON:HAND, '&STOP|&IGNORE') = 1 THEN
        HALT(999)
      END
      Return('')
  End

!*****************************************************************************************
WideCStr_To_Str  Function(*CString cstr, Long Leng=-1) !, String
buf  CString(2048)
  Code
    WideCharToMultiByte(0, 0, cstr, Leng, buf, Size(buf))
  Return (buf)

Артур

Интересное решение
Чтобы понять нужен пример (меня интересует локальная сеть)
Буду благодарен если покажете как применять ваше средство

WadimZapara

У меня это отдельный модуль, собранный в DLL, с экспортом указанных функций:

Код: Выделить всё

  GetValFromAddr(String Type_WCS124L6R8, ULong addr, Long Leng=-1), ?, Name('GetValFromAddr@ZWM_Function')
  WideCStr_To_Str(*CString cstr, Long Leng=-1), String, Name('WideCStr_To_Str@ZWM_Function')
  PING(String IpAddr, ULong TimeOut_sec=1, ULong TimeOut_mks=0, <*ULong Elapsed_ms>, <*Byte TTL>),Byte,Name('PING@ZWM_Function')

(а также и многих других)
Тема про PING. Вот я и разместил кусок своей библиотеки - функция PING и всё, что она за собой потащила - т.е. работоспособный вариант.
Применение прозрачно:
вопрос: зачем нужен пинг?
ответ: в основном - узнать есть ответ от компа по IP-адресу или нет. Вот она и возвращает TRUE/FALSE.
вопрос: но ведь стандартный пинг ещё отображает дополнительную информацию
ответ: да, и если в эту функцию передать 4 и 5 параметры-переменные, то и получишь время отклика и TTL
вопрос: так каков первый параметр?
ответ: например, '192.168.121.195'
вопрос: а на фига 2-ой и 3-ий параметры
ответ: для точного (насколько позволяют системные функции Windows) задания времени ожидания: количество секунд (параметр 2) и количество микросекунд (параметр 3)

вопрос: а на фига GetValFromAddr()
ответ: как следует из имени - для извлечения значения какого-либо из поддерживаемых функцией типов по адресу, заданному числом. В кларе встроенного средства нет, а для многих системных вызовов это требуется. Подробнее - читай исходник. А WideCStr_To_Str превращает Unicode-строку в привычную нам строку, во втором параметре может быть указано число символов (НЕ БАЙТ) исходной Unicode-строки, а значение -1 означает "определить автоматически"

Артур

Что-то у меня ничего не получается, видимо, нет этой беды, которая называется Windows.DLL
С уважением

Сообщение **Admin** » 03 Июль 2008, 16:40

Артур писал(а):Что-то у меня ничего не получается, видимо, нет этой беды, которая называется Windows.DLL
С уважением

Windows.DLL не нужно!
Подключи к проекту файл LIB\wsock32.lib
Использовать примерно так:

Код: Выделить всё

ADDRPING            STRING(100)

  CODE
  ADDRPING = '127.0.0.1'
  Result# = PING(ADDRPING)
  MESSAGE(Result#) ! 1 - пингуется, 0 - не пингуется

Артур

Дорогой админ !
Мне пришло счастье, а тебе категорическое спасибо за подсказку.

WadimZapara

Спасибо админу, который любезно ответил за меня

!

Артур · Сообщение **Артур** » 07 Июль 2008, 9:17

А тебе люлек отдельное спасибо !

Alisher

Пробовал запустить пример на Vista постояно возрващается значение 0.

У меня вопрос к VadimZapara а что может Ваша библиотека какие функции в ней есть.
если возможность подключится к оборудованию по протоколу telnet.

Alisher

Я использую cswsk32.ocx для работы с телнет. Подробное описание можно найти сдесь:
http://www.clarionmag.com/col/99-03-socketwrench.html

WadimZapara · Сообщение **WadimZapara** » 21 Май 2009, 17:44

есть кое-что из сетевого API...
есть модули для асинхронной работы с FTP...

forum.clarionlife.net

Ping из Clarion

Ping из Clarion

Re: Ping из Clarion

Re: Ping из Clarion

Re: Ping из Clarion

Re: Ping из Clarion

Re: Ping из Clarion

Re: Ping из Clarion

Re: Ping из Clarion

Re: Ping из Clarion

Re: Ping из Clarion

Re: Ping из Clarion

Re: Ping из Clarion

Re: Ping из Clarion

Re: Ping из Clarion