No me hace nada... ????
// \SAMPLES\SOCKET1.PRG
// FiveWin WinSocket.dll support !!!
/* 25/05/2021
MODIFICACION DE LA CLASE ORIGINAL TSOCKET:
El problema radicaba en que la clase TSocket original de FiveWin no gestiona los errores
cuando trata de enviar datos, EL FALLO CONSISTE en que deja al m茅todo SendData en un bucle
infinito. He modificado TSockets para gestionarlo.
Referencia de sockets propios de harbour (No usados en esta clase).
https://github.com/Petewg/harbour-core/wiki/Harbour-Socket-API
*/
#include "FiveWin.ch"
#include "Fileio.ch"
#define AF_INET 2
#define SOCK_STREAM 1
#define IPPROTO_IP 0
#define SOL_SOCKET -1
#define FD_READ 1
#define FD_WRITE 2
#define FD_OOB 4
#define FD_ACCEPT 8
#define FD_CONNECT 16
#define FD_CLOSE 32
#define SD_RECEIVE 0
#define SD_SEND 1
#define SD_BOTH 2
#define SO_REUSEADDR 4
#define FILE_BLOCK 30000
/* ERRORES DE CONEXION SOCKETS DE WINSOCK2 :
<!-- m --><a class="postlink" href="https://docs.microsoft.com/es-es/window">https://docs.microsoft.com/es-es/window</a><!-- m --> ... or-codes-2 */
#define WSAEWOULDBLOCK 10035 // El buffer de env铆o est谩 lleno.
/* WSAEWOULDBLOCK is not really an error but simply tells you that your send buffers are full.
This can happen if you saturate the network or if the other side simply doesn't acknowledge the received data.*/
#define WSAECONNRESET 10054 // El host remoto cort贸 la conexi贸n.
#define WSAENOTCONN 10057 /* Socket is not connected.
A request to send or receive data was disallowed because the socket is not connected
and (when sending on a datagram socket using sendto) no address was supplied.
Any other type of operation might also return this error鈥攆or example,
setsockopt setting SO_KEEPALIVE if the connection has been reset. */
#ifdef __XPP__
#define New _New
#endif
// ----------------------------------------------------------------------------//
CLASS GSocket
DATA nPort AS NUMERIC INIT 0 // socket port number
DATA cIPAddr AS String INIT "" // socket IP address
DATA nTimeOut AS NUMERIC INIT 30
DATA nBackLog AS NUMERIC INIT 5
DATA nSocket AS NUMERIC INIT -1
DATA hFile AS NUMERIC INIT 0
DATA bAccept, bRead, bWrite, bClose, bConnect, bOOB
DATA lDebug
DATA cLogFile
DATA cMsg, nRetCode, Cargo
DATA aBuffer // data sending buffer
DATA lSending // sending in progress
CLASSDATA aSockets INIT {}
METHOD New( nPort, oWnd ) CONSTRUCTOR
MESSAGE ACCEPT METHOD _Accept( nSocket )
METHOD End()
METHOD HandleEvent( nSocket, nOperation, nErrorCode )
METHOD GetData()
METHOD SendBin( pMemory, nSize ) INLINE SendBinary( pMemory, nSize )
METHOD SendChunk( nBlockSize )
METHOD SendFile( cFileName, nBlockSize )
METHOD SendData( cData )
MESSAGE Listen METHOD _Listen()
METHOD Close()
METHOD Connect( cIPAddr, nPort ) INLINE ;
ConnectTo( ::nSocket, If( nPort != NIL, nPort, ::nPort ), cIPAddr )
METHOD Refresh() INLINE SocketSelect( ::nSocket )
METHOD OnAccept() INLINE If( ::bAccept != NIL, Eval( ::bAccept, Self ), )
METHOD OnRead() INLINE If( ::bRead != NIL, Eval( ::bRead, Self ), )
METHOD OnWrite() INLINE If( ::bWrite != NIL, Eval( ::bWrite, Self ), )
METHOD OnClose() INLINE If( ::bClose != NIL, Eval( ::bClose, Self ), )
METHOD OnConnect( nErrorCode ) INLINE If( ::bConnect != NIL, Eval( ::bConnect, Self, nErrorCode ), )
METHOD OnOOB() INLINE If( ::bOOB != NIL, Eval( ::bOOB, Self ), )
METHOD ClientIP() INLINE GetPeerName( ::nSocket )
ENDCLASS
// ----------------------------------------------------------------------------//
METHOD New( nPort, oWnd ) CLASS GSocket
DEFAULT oWnd := WndMain(), ::aSockets := {}
IF Len( ::aSockets ) == 0
IF WSAStartup() != 0
MsgAlert( "WSAStartup error" )
ENDIF
ENDIF
IF ( ::nSocket := Socket( AF_INET, SOCK_STREAM, IPPROTO_IP ) ) == 0
MsgAlert( "Socket creation error: " + Str( WsaGetLastError() ) )
ENDIF
// msginfo(::nSocket,"wintpv: Nuevo socket creado")
::cIPAddr = GetHostByName( GetHostName() ) // "127.1.1.1"
::aBuffer = {}
::lSending = .F.
::lDebug = .F.
IF nPort != nil
::nPort = nPort
BindToPort( ::nSocket, nPort ) // Bind is not needed for connect sockets
ENDIF
AAdd( ::aSockets, Self )
// msginfo(Len( ::aSockets ),"Sockets totales creados con este nuevo:")
IF oWnd != nil
oWnd:bSocket = {| nSocket, nLParam | ::HandleEvent( nSocket, ;
nLoWord( nLParam ), nHiWord( nLParam ) ) }
WSAAsyncSelect( ::nSocket, oWnd:hWnd, WM_ASYNCSELECT, ;
nOr( FD_ACCEPT, FD_OOB, FD_READ, FD_CLOSE, FD_CONNECT, FD_WRITE ) )
ELSE
MsgAlert( "You must create a main window in order to use a GSocket object" )
ENDIF
RETURN Self
// ----------------------------------------------------------------------------//
METHOD _Accept( nSocket ) CLASS GSocket
::nSocket = Accept( nSocket )
::aBuffer = {}
::lSending = .F.
::lDebug = .F.
AAdd( ::aSockets, Self )
WSAAsyncSelect( ::nSocket, WndMain():hWnd, WM_ASYNCSELECT, ;
nOr( FD_ACCEPT, FD_OOB, FD_READ, FD_CLOSE, FD_CONNECT, FD_WRITE ) )
RETURN Self
// ----------------------------------------------------------------------------//
METHOD GetData() CLASS GSocket
LOCAL cData := ""
::nRetCode = Recv( ::nSocket, @cData )
IF ::lDebug .AND. ! Empty( ::cLogFile )
LogFile( ::cLogFile, { cData } )
ENDIF
RETURN cData
// ----------------------------------------------------------------------------//
METHOD _Listen() CLASS GSocket
LOCAL nRetCode := Listen( ::nSocket, ::nBackLog )
RETURN ( nRetCode == 0 )
// ----------------------------------------------------------------------------//
METHOD End() CLASS GSocket
LOCAL nAt := AScan( ::aSockets, {| oSocket | oSocket:nSocket == ::nSocket } )
LOCAL nShutdown := 0
WHILE ::lSending
SysRefresh()
END
/* if nAt != 0
ADel( ::aSockets, nAt )
ASize( ::aSockets, Len( ::aSockets ) - 1 )
if Len( ::aSockets ) == 0
msginfo("antes de WSACleanUp()")
WSACleanUp()
endif
endif */
// A帽adido el 23/05/2021 para ver si al salir del programa y volver a entrar no hay problema
// para volver a conectar con el servidor.
IF ( nShutdown := shutdown( ::nSocket, SD_BOTH ) ) <> 0
// msginfo( nShutdown, "Shutdown()" )
// msgwait('ERROR: ShutDown(), WSAGetLastError = '+alltrim(str(WSAGetLastError())),"oSocket:ShutDown()",3)
EscribeEnFichTxt( DToS( Date() ) + ' ' + Time() + ;
' ERROR: ShutDown(' + AllTrim( Str( ::nSocket ) ) + '), WSAGetLastError = ' + AllTrim( Str( WSAGetLastError() ) ), ;
'LOG_SOCKETS.TXT', .T., 2 )
// else
// msgwait('OK, ShutDown() == '+str(nShutdown),"oSocket:ShutDown()",2)
ENDIF
IF ! Empty( ::nSocket )
CloseSocket( ::nSocket )
::nSocket = 0
ENDIF
IF nAt != 0
ADel( ::aSockets, nAt )
ASize( ::aSockets, Len( ::aSockets ) - 1 )
IF Len( ::aSockets ) == 0
// msginfo("antes de WSACleanUp()")
// EscribeEnFichTxt(dtos(Date())+" "+time()+" WSACleanUp() OK",'LOG_SOCKETS.TXT',.T.,2)
WSACleanUp()
ENDIF
ENDIF
RETURN NIL
// ----------------------------------------------------------------------------//
METHOD Close() CLASS GSocket
WHILE ::lSending
SysRefresh()
END
RETURN CloseSocket( ::nSocket )
// ----------------------------------------------------------------------------//
METHOD HandleEvent( nSocket, nOperation, nErrorCode ) CLASS GSocket
LOCAL nAt := AScan( ::aSockets, {| oSocket | oSocket:nSocket == nSocket } )
LOCAL oSocket
IF nAt != 0
oSocket = ::aSockets[ nAt ]
DO CASE
CASE nOperation == FD_ACCEPT
IF ::lDebug .AND. ! Empty( ::cLogFile )
LogFile( ::cLogFile, { "Accept", ;
"Socket handle:" + Str( nSocket ) } )
ENDIF
oSocket:OnAccept()
CASE nOperation == FD_READ
IF ::lDebug .AND. ! Empty( ::cLogFile )
LogFile( ::cLogFile, { "Read", ;
"Socket handle:" + Str( nSocket ) } )
ENDIF
oSocket:OnRead()
CASE nOperation == FD_WRITE
IF ::lDebug .AND. ! Empty( ::cLogFile )
LogFile( ::cLogFile, { "Write", ;
"Socket handle:" + Str( nSocket ) } )
ENDIF
oSocket:OnWrite()
CASE nOperation == FD_CLOSE
IF ::lDebug .AND. ! Empty( ::cLogFile )
LogFile( ::cLogFile, { "Close", ;
"Socket handle:" + Str( nSocket ) } )
ENDIF
oSocket:OnClose()
CASE nOperation == FD_CONNECT
IF ::lDebug .AND. ! Empty( ::cLogFile )
LogFile( ::cLogFile, { "Connect", ;
"Socket handle:" + Str( nSocket ) } )
ENDIF
oSocket:OnConnect( nErrorCode )
CASE nOperation == FD_OOB
IF ::lDebug .AND. ! Empty( ::cLogFile )
LogFile( ::cLogFile, { "OOB", ;
"Socket handle:" + Str( nSocket ) } )
ENDIF
oSocket:OnOOB()
OTHERWISE
IF ::lDebug .AND. ! Empty( ::cLogFile )
LogFile( ::cLogFile, { "nOperation not recognized", ;
Str( nOperation ) } )
ENDIF
ENDCASE
ENDIF
RETURN NIL
// ----------------------------------------------------------------------------//
METHOD SendChunk( nBlockSize ) CLASS GSocket
LOCAL cBuffer, nBytes := 0
DEFAULT nBlockSize := FILE_BLOCK
cBuffer = Space( nBlockSize )
IF ::hFile != 0
nBytes = FRead( ::hFile, @cBuffer, nBlockSize )
IF nBytes < nBlockSize
cBuffer = SubStr( cBuffer, 1, nBytes )
FClose( ::hFile )
::hFile = 0
ENDIF
::SendData( cBuffer )
END
RETURN nBytes
// ----------------------------------------------------------------------------//
METHOD SendFile( cFileName, nBlockSize ) CLASS GSocket
DEFAULT nBlockSize := FILE_BLOCK
IF ! Empty( cFileName ) .AND. File( cFileName )
If( ( ::hFile := FOpen( cFileName ) ) != -1 )
WHILE ::SendChunk( nBlockSize ) == nBlockSize
END
ENDIF
ENDIF
RETURN NIL
METHOD SendData( cData ) CLASS GSocket
LOCAL nSize := Len( cData )
LOCAL nLen := nSize
LOCAL nSent := 0
LOCAL nIntentos := 3
LOCAL nErrorWSA := 0, cErrDesc := ""
IF ! ::lSending
::lSending = .T.
ELSE
AAdd( ::aBuffer, cData )
RETURN nSize
ENDIF
WHILE ( nLen > 0 .AND. ;
( nSent := SocketSend( ::nSocket, cData ) ) < nLen ) .OR. ;
Len( ::aBuffer ) > 0
SYSREFRESH()
// Check for buffered packets to send
IF nLen == 0 .AND. Len( ::aBuffer ) > 0
cData = ::aBuffer[ 1 ]
ADel( ::aBuffer, 1 )
ASize( ::aBuffer, Len( ::aBuffer ) - 1 )
ENDIF
IF nSent != -1 // No hay error en el env铆o.
cData = SubStr( cData, nSent + 1 )
nLen = Len( cData )
ELSE // Ha habido error en el env铆o.
nErrorWSA = WSAGetLastError()
IF nErrorWSA != WSAEWOULDBLOCK // Buffer lleno
EXIT
ELSE // WSAEWOULDBLOCK => Buffer lleno. Reintenta el env铆o hasta nIntentos veces.
IF nIntentos > 0
nIntentos = nIntentos - 1
RetardoSecs(1)
LOOP
ELSE
EXIT // 14/08/2018 Sale para no quedar en un bucle sin fin si hay errores WINSOCK2.
ENDIF
ENDIF
ENDIF
ENDDO
IF nSent == -1
// Descripci贸n del Error:
DO CASE
CASE nErrorWSA == WSAENOTCONN // Socket is not connected.
cErrDesc := "Socket is not connected."
// Tiene que volver a conectar el Socket porque se ha desconectado.
CASE nErrorWSA == WSAECONNRESET // El host remoto cort贸 la conexi贸n.
cErrDesc := "El host remoto cort贸 la conexi贸n."
CASE nErrorWSA != WSAEWOULDBLOCK
cErrDesc := "Buffer Send lleno."
ENDCASE
// msgwait('ERROR: SocketSend(), WSAGetLastError = '+alltrim(str(nErrorWSA)),"oSocket:SendData",2)
EscribeEnFichTxt( DToS( Date() ) + ' ' + Time() + ;
' ERROR: SocketSend(), WSAGetLastError = ' + AllTrim( Str( nErrorWSA ) ) + ;
' FROM ' + iif( Empty( ::cIPAddr ), "ip ???", ::cIPAddr ) + ":" + iif( Empty( ::nPort ), "port ???", AllTrim( Str( ::nPort ) ) ) + " = " + cErrDesc, 'LOG_SOCKETS.TXT', .T., 2 )
ENDIF
// if ::lDebug .AND. ! Empty( ::cLogFile )
// LogFile( ::cLogFile, { cData } )
// endif
::lSending = .F.
RETURN nSent // Propongo nSent en vez de nSize porque Si nSent = -1 es que la instrucci贸n no ha ido bien, hay errores. //nSize
// ----------------------------------------------------------------------------//
FUNCTION GShowIP()
LOCAL oSocket := GSocket():New( 2000 )
LOCAL cIp := oSocket:cIPAddr
oSocket:End()
RETURN cIp
// ----------------------------------------------------------------------------//
/* Escribe en un fichero txt.
A帽ade la l铆nea si lAppend:=.t. o NIL
Devuelve: .F. si no tuvo exito al abrir el fichero.
.T. si tuvo exito.
*/
FUNCTION EscribeEnFichTxt( cMensaje, cFich, lAppend, Intentos, lAvisoError, lBorraFichExistente, lAnadeCRLFfinal )
LOCAL lValRet := .F.
LOCAL nLongFichero := 0
LOCAL nLongRec := Len( cMensaje )
LOCAL nManejador := -1
DEFAULT cFich := "LOG.TXT"
DEFAULT lAppend := .T.
DEFAULT Intentos := 1
DEFAULT lAvisoError := .T.
DEFAULT lBorraFichExistente := .F.
DEFAULT lAnadeCRLFfinal := .T.
IF lBorraFichExistente
FErase( cFich )
ENDIF
WHILE lValRet = .F. .AND. intentos > 0
SYSREFRESH()
intentos = intentos - 1
nManejador := iif( File( cFich ), ;
FOpen( cfich, FO_READWRITE + FO_SHARED ), ;
FCreate( cFich, FC_NORMAL ) )
IF FError() = 0
// Longitud del fichero y se sit煤a al final del fichero.
nLongFichero := FSeek( nManejador, 0, FS_END )
// Devuelve a la posici贸n inicial si lAppend=.f.
iif( lAppend, NIL, FSeek( nManejador, 0 ) )
// Escribe el mensaje
iif( FWrite( nManejador, cMensaje + iif( lAnadeCRLFfinal, CRLF, "" ) ) < nLongRec, lValRet := .F., lValRet := .T. )
FClose( nManejador )
ELSE
IF lAvisoError
msgwait( 'ERROR AL ABRIR FICHERO:' + CRLF + cFich, 'EscribeFich', 1 )
ENDIF
ENDIF
ENDDO
RETURN lValRet
FUNCTION RetardoSecs(nSecs, lVerMsgProceso, cMensaje)
local nSecIni:=Secs(Time())
local nElapsed:=0
local oDlg, oSay, oFont
default cMensaje:='Sistema procesando, espere...'
default lVerMsgProceso:=.f.
if lVerMsgProceso
DEFINE DIALOG oDlg TITLE 'PROCESO EN CURSO' FROM 6,10 TO 15,60 ;
FONT oFont
@ 1,2 SAY oSay VAR cMensaje FONT oFont OF oDlg
ACTIVATE DIALOG oDlg NOWAIT
//sysrefresh()
endif
while nElapsed < nSecs
nElapsed:=Secs(Time())-nSecIni
if nElapsed < 0
nElapsed:=nElapsed+86400
endif
enddo
if lVerMsgProceso
oDlg:end()
//sysrefresh()
endif
RETURN NIL
DLL32 STATIC FUNCTION shutdown( dwReserved AS LONG, lpdwReserved AS LONG );
AS LONG PASCAL FROM "shutdown" LIB "ws2_32.dll" // "wsock32.dll" tambi茅n vale
// FIN
Sorry, saludos.
