**************************************************
*-- Class: foxsock (c:\bit_apps\develop\classes\winsock.vcx)
*-- ParentClass: custom
*-- BaseClass: custom
*-- Time Stamp: 05/30/12 07:34:10 AM
*
#INCLUDE "c:\bit_apps\develop\includes\bitincl.h"
*
DEFINE CLASS foxsock AS custom
Height = 20
Width = 32
*-- State of Connection
state = 0
bytesreceived = 0
host = ""
ip = .F.
port = .F.
hsocket = .F.
cin = .F.
waitforread = .F.
*-- Winsock Property Name counterpart
localhostname = .F.
*-- Winsock Property Name counterpart
localip = .F.
*-- Winsock Property Name counterpart
localport = .F.
PROCEDURE connect
LPARAMETERS tcServer, tnServerPort
LOCAL cBuffer, cPort, cHost, lResult
THIS.IP = THIS.GetIP(tcServer)
IF EMPTY(THIS.IP)
RETURN .F.
ENDIF
THIS.Host = tcServer
THIS.Port = tnServerPort
THIS.hSocket = socket(AF_INET, SOCK_STREAM, IPPROTO_TCP)
IF THIS.hSocket = SOCKET_ERROR
RETURN .F.
ENDIF
THIS.State = 6
cPort = THIS.num2word(htons(THIS.Port))
nHost = inet_addr(THIS.IP)
cHost = THIS.num2dword(nHost)
cBuffer = THIS.num2word(AF_INET) + cPort + cHost + Repli(Chr(0),8)
lResult = (ws_connect(THIS.hSocket, @cBuffer, Len(cBuffer))=0)
IF lResult
THIS.State = 7
ELSE
THIS.State = 0
ENDIF
RETURN lResult
ENDPROC
PROCEDURE close
if THIS.hSocket<>SOCKET_ERROR
= closesocket(THIS.hSocket)
endif
THIS.hSocket = SOCKET_ERROR
THIS.State = 0
ENDPROC
PROCEDURE senddata
LPARAMETERS cData
LOCAL cBuffer, nResult
cBuffer = cData
nResult = send(THIS.hSocket, @cBuffer, Len(cBuffer), 0)
IF nResult = SOCKET_ERROR
RETURN .F.
ENDIF
RETURN .T.
ENDPROC
*-- Retrieves data from the OLE drag and drop DataObject object.
PROCEDURE getdata
LPARAMETERS tcOutData
* NOTE: tcOutData MUST be passed by reference, ie: Sock.GetData( @Outstr )
tcOutData = THIS.cIn
THIS.cIn = ''
ENDPROC
PROCEDURE bytesreceived_access
THIS.Rd()
RETURN LEN(THIS.cIn)
ENDPROC
PROTECTED PROCEDURE rd
LOCAL hEventRead, nWait, cRead, cRecv, nRecv, nFlags, lcRead
DO WHILE .T.
* creating event, linking it to the socket and wait
hEventRead = WSACreateEvent()
= WSAEventSelect(THIS.hSocket, hEventRead, FD_READ)
* 1000 milliseconds can be not enough
THIS.WaitForRead = WSAWaitForMultipleEvents(1, @hEventRead, 0, READ_FROM_SERVER_TIMEOUT, 0)
= WSACloseEvent(hEventRead)
IF THIS.WaitForRead <> 0 && error or timeout
EXIT
ENDIF
cRecv = Repli(Chr(0), READ_SIZE)
nFlags = 0
nRecv = recv(THIS.hSocket, @cRecv, READ_SIZE, nFlags)
IF nRecv>0
THIS.cIn = THIS.cIn + LEFT(cRecv, nRecv)
ENDIF
ENDDO
ENDPROC
PROTECTED PROCEDURE getip
LPARAMETERS pcHost
LOCAL nStruct, nSize, cBuffer, nAddr, cIP
nStruct = gethostbyname(pcHost)
IF nStruct = 0
RETURN ""
ENDIF
cBuffer = Repli(Chr(0), HOSTENT_SIZE)
cIP = Repli(Chr(0), 4)
= CopyMemory(@cBuffer, nStruct, HOSTENT_SIZE)
= CopyMemory(@cIP, THIS.buf2dword(SUBS(cBuffer,13,4)),4)
= CopyMemory(@cIP, THIS.buf2dword(cIP),4)
RETURN inet_ntoa(THIS.buf2dword(cIP))
ENDPROC
PROCEDURE buf2dword
LPARAMETERS lcBuffer
RETURN Asc(SUBSTR(lcBuffer, 1,1)) + ;
BitLShift(Asc(SUBSTR(lcBuffer, 2,1)), 8) +;
BitLShift(Asc(SUBSTR(lcBuffer, 3,1)), 16) +;
BitLShift(Asc(SUBSTR(lcBuffer, 4,1)), 24)
ENDPROC
PROCEDURE num2dword
LPARAMETERS lnValue
IF lnValue < 0
lnValue = 0x100000000 + lnValue
ENDIF
LOCAL b0, b1, b2, b3
b3 = Int(lnValue/2^24)
b2 = Int((lnValue - b3*2^24)/2^16)
b1 = Int((lnValue - b3*2^24 - b2*2^16)/2^8)
b0 = Mod(lnValue, 2^8)
RETURN Chr(b0)+Chr(b1)+Chr(b2)+Chr(b3)
ENDPROC
PROCEDURE num2word
LPARAMETERS lnValue
RETURN Chr(MOD(m.lnValue,256)) + CHR(INT(m.lnValue/256))
ENDPROC
PROCEDURE host_assign
LPARAMETERS vNewVal
*To do: Modify this routine for the Assign method
THIS.LocalHostName = vNewVal
ENDPROC
PROCEDURE ip_assign
LPARAMETERS vNewVal
*To do: Modify this routine for the Assign method
THIS.LocalIp = vNewVal
ENDPROC
PROCEDURE port_assign
LPARAMETERS vNewVal
*To do: Modify this routine for the Assign method
THIS.LocalPort = vNewVal
ENDPROC
PROCEDURE Init
* This class was written by William GC Steinford
* based on code posted by AnatoliyMogylevets on fox.wikis.com
* This class is designed to mimic the features of the MSWINSCK.WinSock activeX control
* which are used by SendSmtpEmail
* Public Interface Properties:
* N - State
* N - BytesReceived (read only)
* C - Host (read only)
* C - IP (read only)
* N - Port (read only)
* C - cIn (read/write)
*
* Public Interface Methods:
* L - Connect( cServer, nServerPort )
* L - Close()
* L - SendData( cData )
* L - GetData( @cDataOut )
* State property Values
* 0 Default. Closed
* 1 Open
* 2 Listening
* 3 Connection pending
* 4 Resolving host
* 5 Host resolved
* 6 Connecting
* 7 Connected
* 8 Peer is closing the connection
* 9 Error
* Performance Adjustable Constants:
#DEFINE READ_SIZE 16384
#DEFINE READ_FROM_SERVER_TIMEOUT 200
* API Constants:
#DEFINE SMTP_PORT 25
#DEFINE HTTP_PORT 80
#DEFINE AF_INET 2
#DEFINE SOCK_STREAM 1
#DEFINE IPPROTO_TCP 6
#DEFINE SOCKET_ERROR -1
#DEFINE FD_READ 1
#DEFINE HOSTENT_SIZE 16
DECLARE INTEGER gethostbyname IN ws2_32 STRING host
DECLARE STRING inet_ntoa IN ws2_32 INTEGER in_addr
DECLARE INTEGER socket IN ws2_32 INTEGER af, INTEGER tp, INTEGER pt
DECLARE INTEGER closesocket IN ws2_32 INTEGER s
DECLARE INTEGER WSACreateEvent IN ws2_32
DECLARE INTEGER WSACloseEvent IN ws2_32 INTEGER hEvent
DECLARE GetSystemTime IN kernel32 STRING @lpSystemTime
DECLARE INTEGER inet_addr IN ws2_32 STRING cp
DECLARE INTEGER htons IN ws2_32 INTEGER hostshort
DECLARE INTEGER WSAStartup IN ws2_32 INTEGER wVerRq, STRING lpWSAData
DECLARE INTEGER WSACleanup IN ws2_32
DECLARE INTEGER connect IN ws2_32 AS ws_connect ;
INTEGER s, STRING @sname, INTEGER namelen
DECLARE INTEGER send IN ws2_32;
INTEGER s, STRING @buf, INTEGER buflen, INTEGER flags
DECLARE INTEGER recv IN ws2_32;
INTEGER s, STRING @buf, INTEGER buflen, INTEGER flags
DECLARE INTEGER WSAEventSelect IN ws2_32;
INTEGER s, INTEGER hEventObject, INTEGER lNetworkEvents
DECLARE INTEGER WSAWaitForMultipleEvents IN ws2_32;
INTEGER cEvents, INTEGER @lphEvents, INTEGER fWaitAll,;
INTEGER dwTimeout, INTEGER fAlertable
DECLARE RtlMoveMemory IN kernel32 As CopyMemory;
STRING @Dest, INTEGER Src, INTEGER nLength
IF WSAStartup(0x202, Repli(Chr(0),512)) <> 0
* unable to initialize Winsock on this computer
RETURN .F.
ENDIF
RETURN .T.
ENDPROC
PROCEDURE Destroy
=WSACleanup()
ENDPROC
ENDDEFINE
*
*-- EndDefine: foxsock
**************************************************