Место общения программистов, форум разработчиков БД на Clarion
https://www.forum.clarionlife.net/
Код: Выделить всё
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)
Код: Выделить всё
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')
Windows.DLL не нужно!Артур писал(а):Что-то у меня ничего не получается, видимо, нет этой беды, которая называется Windows.DLL
С уважением
Код: Выделить всё
ADDRPING STRING(100)
CODE
ADDRPING = '127.0.0.1'
Result# = PING(ADDRPING)
MESSAGE(Result#) ! 1 - пингуется, 0 - не пингуется
!