Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Sending Email - attachments can be dbfs
Message
From
28/03/2006 12:53:53
 
 
To
27/03/2006 11:16:21
General information
Forum:
Visual FoxPro
Category:
Coding, syntax & commands
Environment versions
Visual FoxPro:
VFP 8 SP1
OS:
Windows 2000 SP4
Miscellaneous
Thread ID:
01107987
Message ID:
01108433
Views:
16
how about cursortoxml()
that creaztes a text file

Peter


>Hi All,
>
> I am sending email thru VFP, works great for xls, pdfs, txt files, but when I try to send a dbf file, the file comes across, but it is corrupted. Anyone know how to fix this problem?
>
>Here is the code:
>
>*!* 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
>
>
>TIA
>Beth
Peter Cortiel
Previous
Next
Reply
Map
View

Click here to load this message in the networking platform