>*!* Created by : William GC Steinford >*!* with controdutions by : Anatoliy Mogylevets, MikeYearwood, Doug Thomson, Andrus Moor, >*!* Cetin Yasar, Ted Roche, Tom Bellin, Ken Sands, PAC >FUNCTION SmtpEmail() >* strServ: The SMTP server to use. Can be in the following formats: >* xxx.xxx.xxx.xxx "xxx.xxx.xxx.xxx:port" "xxx.xxx.xxx.xxx port" >* ServerName "servername:port" "servername port" >* strFrom: The email address to provide as the "FROM" address >* strToA: The email address to send the email to. >* strSubj: Subject for the email >* strMsg: The Message to include as the body of the email. >* oFB_Attachments: Comma separated list of files to attach (full path to each file) >* (for backward compatibility, the Feedback object can be passed as this parameter) >* All Attachments+message can be at most 16MB right now, because of VFP string size limit. >* oFeedBack: An object with a method "FeedBack" that expects one string property. >* If not provided, the feedback messages will be output to the console through "?". >* Pass .NULL. (or an object without "Feedback" method) to turn off all feedback. >* >* Updated: April 1, 2004: Fixed RCPT TO handling to properly >* bracket the email address. > > LPARAMETERS strServ, strFrom, StrToA, strSubj, strMsg, oFB_cAttachments, oFeedBack > #DEFINE crlf CHR(13)+CHR(10) > #DEFINE TIME_OUT 5 > > LOCAL Sock, llRet, lnI, laTO[1], lnCnt, lcServ, lnServPort > LOCAL lnTime, lcOutStr, Junk, lcAttachments, loFB, laAtch[1], lnAtchCnt > LOCAL laFiles[1] > > lcMsg = strMsg > lcAttachments = oFB_cAttachments > loFB = oFeedBack > IF TYPE('oFB_cAttachments')='O' > loFB = oFB_cAttachments > lcAttachments = '' > ENDIF > >* Load Attachments > IF TYPE('lcAttachments')='C' AND NOT EMPTY(lcAttachments) > lnAtchCnt = ALINES( laAtch, STRTRAN(lcAttachments,',',CHR(13)) ) > lcMsg = lcMsg + crlf + crlf > FOR lnI = 1 TO lnAtchCnt > IF ADIR(laFiles,laAtch[lnI])=0 > GiveFeedBack( loFB, "ERROR: Attachment Not Found:"+laAtch[lnI] ) > RETURN .F. > ENDIF > lcAtch = FILETOSTR( laAtch[lnI] ) > IF EMPTY(lcAtch) > GiveFeedBack( loFB, "ERROR: Attachment Empty/Could not be Read:"+laAtch[lnI] ) > RETURN .F. > ENDIF > > GiveFeedBack( loFB, "Encoding file: "+laAtch[lnI] ) > lcAtch = UUEncode( laAtch[lnI], lcAtch ) && <-- This is the start of the problem, I think. > > lcMsg = lcMsg + lcAtch > lcAtch = '' && free memory > ENDFOR > ENDIF > > GiveFeedBack( loFB, "Connecting to Server: "+strServ ) >*!* Sock=CREATE('mswinsock.winsock') >** OR > Sock=CREATE('vfpWinSock') >** to use the winsock emulator class below (wayyyy below!) to avoid >** the licensing issues stemming from OCX's, and to avoid having to >** register MSWINSCK.OCX on the customers' machines. > llRet = .F. > > lnServPort = 25 > lcServ = strServ > DO CASE && Find Port > CASE ':' $ lcServ > lnAt = AT(':',lcServ) > lnServPort = VAL( SUBSTR(lcServ, lnAt+1) ) > lcServ = LEFT( lcServ, lnAt-1 ) && moved below "lnServPort =...." > IF lnServPort<=0 > lnServPort = 25 > ENDIF > CASE ' ' $ lcServ > lnAt = AT(' ',lcServ) > lnServPort = VAL( SUBSTR(lcServ, lnAt+1) ) > lcServ = LEFT( lcServ, lnAt-1 ) && moved below "lnServPort =...." > IF lnServPort<=0 > lnServPort = 25 > ENDIF > ENDCASE > > Sock.CONNECT(strServ,lnServPort) > lnTime = SECONDS() > > DO WHILE .T. && Control Loop > IF Sock.State <> 7 && Connected > GiveFeedBack( loFB, "Waiting to connect..." ) > INKEY(0.1) > IF SECONDS() - lnTime > TIME_OUT > GiveFeedBack( loFB, "Connect Timed Out") > EXIT && Leave Control Loop > ENDIF > LOOP && Wait to connect > ENDIF > GiveFeedBack( loFB, "Connected." ) > IF NOT ReadWrite(Sock,"HELO " + ALLTRIM(strServ), 220) > GiveFeedBack( loFB, "Failed HELO" ) > EXIT && Leave Control Loop > ENDIF > > IF NOT ReadWrite(Sock,"MAIL FROM: " + ALLTRIM(strFrom), 250) > GiveFeedBack( loFB, "Failed MAIL" ) > EXIT > ENDIF > > lnCnt = ALINES(laTO, CHRTRAN(StrToA,' ,;',CHR(13))) >* once for each email address > FOR lnI = 1 TO lnCnt > IF NOT EMPTY(laTO[lnI]) > lcTo = IIF( '<' $ laTO[lnI], laTO[lnI], '<' + ALLTRIM(laTO[lnI]) + '>' ) > IF NOT ReadWrite(Sock,"RCPT TO: " + lcTo, 250) > GiveFeedBack( loFB, "RCPT Failed" ) > EXIT && Leave Control Loop > ENDIF > ENDIF > ENDFOR > > IF NOT ReadWrite(Sock,"DATA", 250) > GiveFeedBack( loFB, "Failed DATA" ) > EXIT && Leave Control Loop > ENDIF >* tran(day(date()))+' '+tran(month(date()))+' '+tran(year(date())); >* + ' ' +tran(hour(datetime()))+':'+tran(minute(datetime()))+':'+tran(sec(datetime())) +crlf > lcOutStr = "DATE: " + GetSMTPDateTime() +crlf; > + "FROM: " + ALLTRIM(strFrom) + crlf ; > + "TO: " + ALLTRIM(StrToA) + crlf ; > + "SUBJECT: " + ALLTRIM(strSubj) ; > + crlf ; > + crlf ; > + lcMsg >* remove any inadvertant end-of-data marks: > lcOutStr = STRTRAN(lcOutStr, crlf+'.'+crlf, crlf+'. '+crlf) >* Place end of data mark on end: > lcOutStr = lcOutStr + crlf + "." > IF NOT ReadWrite(Sock,lcOutStr, 354 ) > > GiveFeedBack( loFB, "Failed DATA (Cont'd)" ) > EXIT && Leave Control Loop > ENDIF > > IF NOT ReadWrite(Sock,"QUIT", 250) > GiveFeedBack( loFB, "Failed QUIT" ) > EXIT && Leave Control Loop > ENDIF > > GiveFeedBack( loFB, "Email Sent!" ) > llRet = .T. > EXIT && Leave Control Loop > ENDDO > >* Do cleanup code. > Junk = REPL(CHR(0),1000) > IF Sock.State = 7 && Connected > Sock.GETDATA(@Junk) > ENDIF > Sock.CLOSE > Sock = .NULL. > RETURN llRet >*-------------------------------------------------- >FUNCTION GiveFeedBack( oFB, cMsg ) > IF VARTYPE(oFB)='O' OR ISNULL(oFB) > IF NOT ISNULL(oFB) AND PEMStatus(oFB,'Feedback',3)='Method' > RETURN oFB.Feedback( cMsg ) > ELSE > RETURN .T. && Hide Feedback > ENDIF > ELSE > ?cMsg > ENDIF >ENDFUNC >*-------------------------------------------------- >FUNCTION GetSMTPDateTime >* Wed, 12 Mar 2003 07:54:56 -0500 > LOCAL lcRet, ltDT, lnBias > ltDT = DATETIME() > IF 'UTIL' $ SET('PROC') > lnBias = GetTimeZone('BIAS') && In Util.prg > ELSE > lnBias = -5 && EST > ENDIF > lcBias = IIF( lnBias<0, '+', '-' ) > lnBias = ABS(lnBias) > lcBias = lcBias+PADL(TRAN(lnBias/60),2,'0')+PADL(TRAN(lnBias%60),2,'0') > lcRet = LEFT( CDOW(ltDT), 3 )+', '+STR( DAY(ltDT), 2 ) + ' ' + LEFT( CMONTH(ltDT), 3); > +' '+TRAN( YEAR(ltDT) )+' '+PADL(TRAN(HOUR(ltDT)),2,'0')+':'; > +PADL(TRAN(MINUTE(ltDT)),2,'0')+':'; > +PADL(TRAN(SEC(ltDT)),2,'0')+' '; > +lcBias > RETURN lcRet >ENDFUNC >*-------------------------------------------------- >FUNCTION ReadWrite( oSock, cMsgOut, iExpectedCode ) > LOCAL cMsgIn, iCode, lnTime > lnTime = SECONDS() > > DO WHILE oSock.BytesReceived = 0 >* ?"Waiting to Receive data..." > INKEY(0.2) > IF SECONDS() - lnTime > TIME_OUT >* ?"Timed Out" > RETURN .F. > ENDIF > ENDDO > cMsgIn = REPL(CHR(0),1000) > oSock.GETDATA(@cMsgIn) >*?"expected:",iExpectedCode >* >*?"resp:",cMsgIn > iCode = VAL(LEFT(cMsgIn, 3)) >*?"Got:",icode > IF iCode = iExpectedCode > oSock.SendData( cMsgOut + crlf ) > ELSE >* ?"Failed; Code="+cMsgin >* ?"Code="+tran(iCode) > RETURN .F. > ENDIF > RETURN .T. >FUNCTION GetTimeZone( pcFunc ) >* Purpose: Return the Time Zone bias or description >* Input: pcFunc = "BIAS" or Missing... return the bias in Minutes >* ( GMT = LocalTime + Bias ) >* pcFunc = "NAME" ... Return the time zone name. >* Author: William GC Steinford >*********************************************************** >*!* typedef struct _TIME_ZONE_INFORMATION { >*!* LONG Bias; 2: 1- 2 >*!* WCHAR StandardName[ 32 ]; 64: 3- 66 >*!* SYSTEMTIME StandardDate; 16: 67- 82 >*!* LONG StandardBias; 2: 83- 84 >*!* WCHAR DaylightName[ 32 ]; 64: 85-148 >*!* SYSTEMTIME DaylightDate; 16:149-164 >*!* LONG DaylightBias; 2:165-166 >*!* } TIME_ZONE_INFORMATION, *PTIME_ZONE_INFORMATION; >*!* typedef struct _SYSTEMTIME { >*!* WORD wYear; >*!* WORD wMonth; >*!* WORD wDayOfWeek; >*!* WORD wDay; >*!* WORD wHour; >*!* WORD wMinute; >*!* WORD wSecond; >*!* WORD wMilliseconds; >*!* } SYSTEMTIME, *PSYSTEMTIME; >LOCAL lcTZInfo, lcDesc > lcTZInfo = num2dword(0); > +REPL(CHR(0),64)+REPL(num2Word(0),8)+num2dword(0); > +REPL(CHR(0),64)+REPL(num2Word(0),8)+num2dword(0) > DECLARE INTEGER GetTimeZoneInformation IN kernel32.DLL; > STRING @ lpTimeZoneInformation > #DEFINE TIME_ZONE_ID_INVALID 0xFFFFFFFF > #DEFINE TIME_ZONE_ID_UNKNOWN 0 > #DEFINE TIME_ZONE_ID_STANDARD 1 > #DEFINE TIME_ZONE_ID_DAYLIGHT 2 > lcRes = GetTimeZoneInformation( @lcTZInfo ) > lnBias = Buf2DWord( lcTZInfo ) > lcDesc = "Unknown" > DO CASE > CASE lcRes=TIME_ZONE_ID_STANDARD > lcDesc = SUBSTR( lcTZInfo, 3, 64 ) > lcDesc = STRCONV( lcDesc, 6 ) && 6=Unicode(wide)->DoubleByte > lcDesc = STRTRAN( lcDesc, CHR(0), '' ) > CASE lcRes=TIME_ZONE_ID_DAYLIGHT > lcDesc = SUBSTR( lcTZInfo, 3, 64 ) > lcDesc = STRCONV( lcDesc, 6 ) > lcDesc = STRTRAN( lcDesc, CHR(0), '' ) > ENDCASE > IF VARTYPE(pcFunc)='C' AND pcFunc='NAME' > RETURN lcDesc > ENDIF > RETURN lnBias >ENDFUNC >* * * >* dword is compatible with LONG >FUNCTION num2Long( lnValue ) > RETURN num2dword(lnValue) >ENDFUNC > >FUNCTION num2dword (lnValue) > #DEFINE m0 256 > #DEFINE m1 65536 > #DEFINE m2 16777216 > LOCAL b0, b1, b2, b3 > b3 = INT(lnValue/m2) > b2 = INT((lnValue - b3*m2)/m1) > b1 = INT((lnValue - b3*m2 - b2*m1)/m0) > b0 = MOD(lnValue, m0) > RETURN CHR(b0)+CHR(b1)+CHR(b2)+CHR(b3) >ENDFUNC >* * * >* word is compatible with Integer >FUNCTION num2Word (lnValue) > RETURN CHR(MOD(m.lnValue,256)) + CHR(INT(m.lnValue/256)) >ENDFUNC >* * * >FUNCTION buf2word (lcBuffer) > RETURN ASC(SUBSTR(lcBuffer, 1,1)) + ; > ASC(SUBSTR(lcBuffer, 2,1)) * 256 >ENDFUNC >* * * >FUNCTION buf2Long (lcBuffer) > RETURN Buf2DWord(lcBuffer) >ENDFUNC >FUNCTION Buf2DWord(lcBuffer) > RETURN ASC(SUBSTR(lcBuffer, 1,1)) + ; > ASC(SUBSTR(lcBuffer, 2,1)) * 256 +; > ASC(SUBSTR(lcBuffer, 3,1)) * 65536 +; > ASC(SUBSTR(lcBuffer, 4,1)) * 16777216 >ENDFUNC >************************************************************************************** >FUNCTION UUEncode( strFilePath, pcFileData ) && <-- This is the code that seams to be messing up my table files. >* Converted by wgcs From VB code at http://www.vbip.com/winsock/winsock_uucode_02.asp >* strFilePath: Specify the full path to the file to load and UU-encode. >* pcFileData: an optional parameter. Specify this, and strFilePath is not loaded, >* but just the filename from strFilePath is used for the encoding label. >* > LOCAL strFileName, strFileData, i, j, lEncodedLines, ; > strTempLine, lFileSize, strResult, strChunk > >*Get file name > strFileName = JUSTFNAME(strFilePath) > IF TYPE('pcFileData')='C' > strFileData = pcFileData > ELSE > strFileData = FILETOSTR(strFilePath) > ENDIF > >*Insert first marker: "begin 664 ..." > strResult = "begin 664 " + strFileName + CHR(10) > >*Get file size > lFileSize = LEN(strFileData) > lEncodedLines = INT(lFileSize / 45) + 1 > > FOR i = 1 TO lEncodedLines >*Process file data by 45-bytes cnunks > >*reset line buffer > strTempLine = "" > > IF i = lEncodedLines Then >*Last line of encoded data often is not >*equal to 45 > strChunk = strFileData > strFileData = '' > ELSE > strChunk = LEFT( strFileData, 45 ) > strFileData = SUBSTR( strFileData, 46 ) > ENDIF > >* Thanks to "AllTheTimeInTheWorld" on Tek-Tips.com, it was recognized that >* the length calculation should be after the correction of the last line >* with the blankspace symbols: >* *Add first symbol to encoded string that informs >* *about quantity of symbols in encoded string. >* *More often "M" symbol is used. >* strTempLine = Chr(Len(strChunk) + 32) > > IF i = lEncodedLines AND (LEN(strChunk) % 3<>0) Then >*If the last line is processed and length of >*source data is not a number divisible by 3, >*add one or two blankspace symbols > strChunk = strChunk + SPACE( 3 -(LEN(strChunk) % 3) ) > ENDIF > >*Now that we know the final length of the last string, >*Add first symbol to encoded string that informs >*about quantity of symbols in encoded string. >*More often "M" symbol is used. > strTempLine = CHR(LEN(strChunk) + 32) > > >*!* For j = 1 To Len(strChunk) Step 3 >*!* *Break each 3 (8-bits) bytes to 4 (6-bits) bytes >*!* * >*!* *1 byte >*!* strTempLine = strTempLine + ; >*!* Chr(Asc(SubStr(strChunk, j, 1)) / 4 + 32) >*!* *2 byte >*!* strTempLine = strTempLine + ; >*!* Chr((Asc(SubStr(strChunk, j, 1)) % 4) * 16 ; >*!* + Asc(SubStr(strChunk, j + 1, 1)) / 16 + 32) >*!* *3 byte >*!* strTempLine = strTempLine + ; >*!* Chr((Asc(SubStr(strChunk, j + 1, 1)) % 16) * 4 ; >*!* + Asc(SubStr(strChunk, j + 2, 1)) / 64 + 32) >*!* *4 byte >*!* strTempLine = strTempLine + ; >*!* Chr(Asc(SubStr(strChunk, j + 2, 1)) % 64 + 32) > >*!* EndFor > >* Faster method: > FOR j = 1 TO LEN(strChunk) STEP 3 >*Break each 3 (8-bits) bytes to 4 (6-bits) bytes > ln1 = ASC(SUBSTR(strChunk, j, 1)) > ln2 = ASC(SUBSTR(strChunk, j + 1, 1)) > ln3 = ASC(SUBSTR(strChunk, j + 2, 1)) >*1 byte > strTempLine = strTempLine + CHR(ln1 / 4 + 32) ; > + CHR((ln1 % 4) * 16 + ln2 / 16 + 32) ; > + CHR((ln2 % 16) * 4 + ln3 / 64 + 32) ; > + CHR(ln3 % 64 + 32) > ENDFOR > > >*add encoded line to result buffer > strResult = strResult + strTempLine + CHR(10) > ENDFOR >*add the end marker > strResult = strResult + "*" + CHR(10) + "end" + CHR(10) >*asign return value > RETURN strResult > >FUNCTION UUDecode(strUUCodeData) && <-- This code never seems to be called bw >* Converted by wgcs From VB code at http://www.vbip.com/winsock/winsock_uucode_04.asp > LOCAL lnLines, laLines[1], lcOut, lnI, lnJ > LOCAL strDataLine, intSymbols, strTemp > >*Remove first marker > > IF LEFT(strUUCodeData, 6) = "begin " > strUUCodeData = SUBSTR(strUUCodeData, AT(CHR(10),strUUCodeData) + 1) > ENDIF > >*Remove marker of the attachment's end > IF RIGHT(strUUCodeData, 5) = "end" + CHR(13)+CHR(10) >* Remove last 10 characters: CR,LF,*,CR,LF,E,N,D,CR,LF > strUUCodeData = LEFT(strUUCodeData, LEN(strUUCodeData) - 10) > ENDIF > strTemp = "" > >*Break decoded data to the strings > >*From now each member of the array vDataLines contains >*one line of the encoded data > lnLines = ALINES(laLines, strUUCodeData) > > FOR lnI = 1 TO lnLines >*Decode data line by line > strDataLine = laLines[lnI] > >*Extract the number of characters in the string >*We can figure it out by means of the first string character > intSymbols = ASC(LEFT(strDataLine, 1)) > >*which we delete because of its uselessness > strDataLine = SUBSTR(strDataLine, 2, intSymbols) > >*Decode the string by 4 bytes portion. >*From each byte remove two oldest bits. >*From remain 24 bits make 3 bytes > FOR lnJ = 1 TO LEN(strDataLine) STEP 4 >*1 byte > strTemp = strTemp + CHR( (ASC(SUBSTR(strDataLine, lnJ, 1)) - 32) * 4 ; > +(ASC(SUBSTR(strDataLine, lnJ+1, 1)) - 32) / 16 ) >*2 byte > strTemp = strTemp + CHR( (ASC(SUBSTR(strDataLine, lnJ+1, 1)) % 16) * 16 ; > +(ASC(SUBSTR(strDataLine, lnJ+2, 1)) - 32) / 4 ) >*3 byte > > strTemp = strTemp + CHR( (ASC(SUBSTR(strDataLine, lnJ+2, 1)) % 4) * 64 ; > + ASC(SUBSTR(strDataLine, lnJ+3, 1)) - 32) > ENDFOR >*Write decoded string to the file > lcOut = lcOut + strTemp > >*Clear the buffer in order to receive the next >*line of the encoded data > strTemp = "" > ENDFOR > > RETURN lcOut >ENDFUNC > > >DEFINE CLASS vfpWinSock AS SESSION > >* 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 > State = 0 > BytesReceived = 0 > > HOST = "" > IP = "" > Port = 80 > hSocket = 0 > cIn = '' > > WaitForRead = 0 > >* 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 > > FUNCTION CONNECT( 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 > > FUNCTION CLOSE > IF THIS.hSocket<>SOCKET_ERROR > = closesocket(THIS.hSocket) > ENDIF > THIS.hSocket = SOCKET_ERROR > THIS.State = 0 > ENDFUNC > > FUNCTION SendData( cData ) > LOCAL cBuffer, nResult > cBuffer = cData > nResult = SEND(THIS.hSocket, @cBuffer, LEN(cBuffer), 0) > IF nResult = SOCKET_ERROR > RETURN .F. > ENDIF > RETURN .T. > ENDFUNC > > FUNCTION GETDATA( tcOutData ) >* NOTE: tcOutData MUST be passed by reference, ie: Sock.GetData( @Outstr ) > tcOutData = THIS.cIn > THIS.cIn = '' > ENDFUNC > >* Private methods follow: > > FUNCTION BytesReceived_Access > THIS.RD() > RETURN LEN(THIS.cIn) > ENDFUNC > > PROTECTED FUNCTION 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 > >* reading data from connected socket >*This didn't belong here: >* THIS.cIn = THIS.cIn+THIS.Rd() > > 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 > ENDFUNC > > PROCEDURE INIT() > 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 > > PROTECTED FUNCTION GetIP( 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)) > ENDFUNC > > FUNCTION Buf2DWord(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) > ENDFUNC > > FUNCTION num2dword(lnValue) >*#DEFINE m0 256 2^8 >*#DEFINE m1 65536 2^16 >*#DEFINE m2 16777216 2^24 > 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) > ENDFUNC > > FUNCTION num2Word(lnValue) > RETURN CHR(MOD(m.lnValue,256)) + CHR(INT(m.lnValue/256)) > ENDFUNC >ENDDEFINE >>