API tools faq
paste
Advertisement
Guest User

VFP HTTP REQUEST

a guest
Apr 18th, 2016
126
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
VisualFoxPro 9.56 KB | None | 0 0
raw download clone embed print report
  1. * Esta es una clase para interrogar un servidor utilizando HTTP
  2. * la misma fue construida sustentado en la propuesta de
  3. * Anatoliy Mogylevets SMTP su código está disponible en
  4. * complementada por cvillaronga at iutm dot edu dot ve
  5. * http://fox.wikis.com/wc.dll?Wiki~SendSmtpEmail
  6.  
  7. DEFINE CLASS SocketWrapper As Custom
  8.   * DEFINIIONES GENERALES
  9.   #DEFINE SMTP_PORT    25
  10.   #DEFINE http_PORT    80
  11.   #DEFINE AF_INET       2
  12.   #DEFINE SOCK_STREAM   1
  13.   #DEFINE IPPROTO_TCP   6
  14.   #DEFINE SOCKET_ERROR -1
  15.   #DEFINE FD_READ       1
  16.   #DEFINE crlf CHR(13)+CHR(10)
  17.   * VALORES DE LA CLASE
  18.   host     = ""
  19.   IP       = ""
  20.   Port     = 80
  21.   hSocket  = 0
  22.   cIn      = ''
  23.   WaitForRead = 0
  24.  
  25.  
  26.   * Inicializador de la clase
  27.   PROCEDURE Init()
  28.     THIS.decl
  29.     IF WSAStartup(0x202, Repli(Chr(0),512)) <> 0
  30.         * Fue imposible iniciar Winsock en este computador
  31.         RETURN .F.
  32.     ENDIF
  33.     RETURN .T.
  34.   ENDPROC
  35.  
  36.   * Destruir
  37.   PROCEDURE Destroy
  38.     = WSACleanup()
  39.   ENDPROC
  40.  
  41.   * Asignar Host
  42.   PROCEDURE Host_Assign( vNewVal )
  43.     if empty(vNewVal)
  44.       THIS.IP = ''
  45.     else
  46.       THIS.IP = THIS.GetIP(vNewVal)
  47.     endif
  48.     if not empty(THIS.IP)
  49.       THIS.Host = vNewVal
  50.     else
  51.       THIS.Host = ''
  52.     endif
  53.   ENDPROC
  54.  
  55.   * Recuperar IP del host actual
  56.   PROTECTED FUNCTION GetIP( pcHost )
  57.   #DEFINE HOSTENT_SIZE 16
  58.       LOCAL nStruct, nSize, cBuffer, nAddr, cIP
  59.       nStruct = gethostbyname(pcHost)
  60.       IF nStruct = 0
  61.           RETURN ""
  62.       ENDIF
  63.       cBuffer = Repli(Chr(0), HOSTENT_SIZE)
  64.       cIP = Repli(Chr(0), 4)
  65.       = CopyMemory(@cBuffer, nStruct, HOSTENT_SIZE)
  66.       = CopyMemory(@cIP, THIS.buf2dword(SUBS(cBuffer,13,4)),4)
  67.       = CopyMemory(@cIP, THIS.buf2dword(cIP),4)
  68.   RETURN inet_ntoa(THIS.buf2dword(cIP))
  69.   ENDFUNC
  70.  
  71.   * Conectar
  72.   PROTECTED FUNCTION Connect
  73.     LOCAL cBuffer, cPort, cHost, lResult
  74.     THIS.hSocket = socket(AF_INET, SOCK_STREAM, IPPROTO_TCP)
  75.    
  76.     IF THIS.hSocket = SOCKET_ERROR
  77.         RETURN .F.
  78.     ENDIF
  79.    
  80.     cPort = THIS.num2word(htons(THIS.Port))
  81.     nHost = inet_addr(THIS.IP)
  82.     cHost = THIS.num2dword(nHost)
  83.     cBuffer = THIS.num2word(AF_INET) + cPort + cHost + Repli(Chr(0),8)
  84.     lResult = (ws_connect(THIS.hSocket, @cBuffer, Len(cBuffer))=0)
  85.   RETURN lResult
  86.  
  87.  
  88.   * Realizar una solicitud via httpGet a un servidor remoto
  89.   FUNCTION httpGet( pcServer, pcUrl )
  90.     LOCAL lResult
  91.     THIS.Host = pcServer
  92.  
  93.     IF THIS.Connect()
  94.         * Ajustar los siguientes valores para indicar que es un cliente premium nativo.
  95.         THIS.snd("GET "+pcURL+" http/1.0"+crlf)
  96.         THIS.snd("Accept: */*"+crlf)
  97.         THIS.snd("Accept-Language: en-us"+crlf)
  98.         THIS.snd("Accept-Encoding: text/plain, deflate"+crlf)
  99.         THIS.snd("User-Agent: Mozilla/4.0"+crlf)
  100.         THIS.snd("Host: "+pcServer+crlf)
  101.         THIS.snd("Pragma: no-cache"+crlf)
  102.         THIS.snd(crlf,.t.) && End of headers
  103.         *info=url encoded string
  104.         lResult = .T.
  105.     ELSE
  106.         lResult = .F.
  107.     ENDIF
  108.     THIS.Disconnect()
  109.   ENDFUNC
  110.  
  111.   * Realizar una solicitud via httpPost a un servidor remoto
  112.   * considere que esta funcion recibe como parametros pcData e implementa un objeto de retorno poFdbk
  113.   * este método no considera el envío de datos adjuntos como parte de la solicitud.
  114.   * por ahora ne se implementa autorización.
  115.   FUNCTION httpPost( pcServer, pcUrl, pcData, poFdbk )
  116.     LOCAL lResult, lnLen, lnComplete, lcRemain, lcSnd
  117.     THIS.Host = pcServer
  118.  
  119.     IF THIS.Connect()
  120.         THIS.snd("POST "+pcURL+" http/1.0"+crlf)
  121.         THIS.snd("Content-Type:application/x-www-form-urlencoded"+crlf)
  122.         THIS.snd("Accept: */*"+crlf)
  123.         THIS.snd("Accept-Language: en-us"+crlf)
  124.         THIS.snd("Accept-Encoding: text/plain, deflate"+crlf)
  125.         THIS.snd("User-Agent: Mozilla/4.0"+crlf)
  126.         THIS.snd("Host: "+pcServer+crlf)
  127.         lnLen = len(pcData)
  128.         THIS.snd("Content-Length: "+tran(lnLen)+crlf)
  129.         THIS.snd("Pragma: no-cache"+crlf)
  130.         THIS.snd(crlf) && End of headers
  131.         * Si tenemos un objeto de feedback proporcinarle respuesta
  132.         if vartype(poFdbk)='O' and PEMStatus(poFdbk,'Feedback',5) ;
  133.            and upper(PEMStatus(poFdbk,'Feedback',3))='METHOD'
  134.           lcRemain   = pcData
  135.           lnComplete = 0
  136.           poFdbk.Feedback( 0 )
  137.           do while len(lcRemain)>0
  138.             lcSnd      = LEFT( lcRemain, 100 )
  139.             lcRemain   = SUBSTR( lcRemain, 101 )
  140.             THIS.snd(lcSnd)
  141.             lnComplete = lnComplete+len(lcSnd)
  142.             poFdbk.Feedback( lnComplete/lnLen*100 )
  143.           enddo
  144.           THIS.snd('',.t.)
  145.         else && No hay objeto de feedback.
  146.           THIS.snd(pcData,.t.)
  147.         endif
  148.         lResult = .T.
  149.     ELSE
  150.         lResult = .F.
  151.     ENDIF
  152.     THIS.Disconnect()
  153.   ENDFUNC
  154.  
  155.   * método para enviar correo electrónico desde VFP
  156.   FUNCTION SendMail( pcSender, pcRecipient, pcSubject, pcBody )
  157.     LOCAL lResult
  158.     IF THIS.Connect()
  159.         THIS.snd("HELO", .T.)
  160.         THIS.snd("MAIL FROM:<" + pcSender + ">", .T.)
  161.         THIS.snd("RCPT TO:<" + pcRecipient + ">", .T.)
  162.         THIS.snd("DATA", .T.)
  163.         THIS.snd("From: " + pcSender)
  164.         THIS.snd("To: " + pcRecipient)
  165.         THIS.snd("Subject: " + pcSubject)
  166.         THIS.snd("")
  167.         THIS.snd(pcBody)
  168.         THIS.snd(".", .T.)
  169.         THIS.snd("QUIT", .T.)
  170.         lResult = .T.
  171.     ELSE
  172.         = MessageB("Unable to connect to [" + THIS.Host +;
  173.             "] on port " + LTRIM(STR(SMTP_PORT)) + ". ",;
  174.             48, " Connection error")
  175.         lResult = .F.
  176.     ENDIF
  177.     THIS.Disconnect()
  178.   RETURN lResult
  179.   ENDFUNC
  180.  
  181.   Function URLencode
  182.   LPARAMETER pcInStr
  183.   *  ' encode Percent signs
  184.   *  '        Double Quotes
  185.   *  '        CarriageReturn / LineFeeds
  186.  
  187.   LOCAL lcOut, lnI
  188.     * StrTran is WAY faster than building the string in memory
  189.     lcOut = StrTran(pcInStr, [%], '%25' )
  190.     lcOut = StrTran(lcOut,   [+], '%2B' )
  191.     lcOut = StrTran(lcOut,   [ ], '+'   )
  192.     for lnI = 0 to 31
  193.       lcOut = StrTran( lcOut, chr(lnI), '%' + Right( Transform(lnI,'@0'), 2 ) )
  194.     endfor
  195.     for lnI = 127 to 255
  196.       lcOut = StrTran( lcOut, chr(lnI), '%' + Right( Transform(lnI,'@0'), 2 ) )
  197.     endfor
  198.  
  199.     RETURN lcOut
  200.  
  201.   ENDFUNC
  202.  
  203.   FUNCTION Disconnect
  204.     if THIS.hSocket<>SOCKET_ERROR
  205.       = closesocket(THIS.hSocket)
  206.     endif
  207.     THIS.hSocket = SOCKET_ERROR
  208.   ENDFUNC
  209.  
  210.   FUNCTION snd(cData, lResponse)
  211.     LOCAL cBuffer, nResult, cResponse
  212.     cBuffer = cData && + CrLf
  213.     nResult = send(THIS.hSocket, @cBuffer, Len(cBuffer), 0)
  214.     IF nResult = SOCKET_ERROR
  215.         RETURN .F.
  216.     ENDIF
  217.     IF Not lResponse
  218.         RETURN .T.
  219.     ENDIF
  220.  
  221.     LOCAL hEventRead, nWait, cRead
  222.     DO WHILE .T.
  223.         * creating event, linking it to the socket and wait
  224.         hEventRead = WSACreateEvent()
  225.         = WSAEventSelect(THIS.hSocket, hEventRead, FD_READ)
  226.  
  227.         * 1000 milliseconds can be not enough
  228.         THIS.WaitForRead = WSAWaitForMultipleEvents(1, @hEventRead, 0, 2000, 0)
  229.         = WSACloseEvent(hEventRead)
  230.  
  231.         IF THIS.WaitForRead <> 0 && error or timeout
  232.             EXIT
  233.         ENDIF
  234.        
  235.         * reading data from connected socket
  236.         THIS.cIn = THIS.cIn+THIS.Rd()
  237.     ENDDO
  238.   RETURN .T.
  239.   ENDFUNC
  240.  
  241.   PROTECTED FUNCTION Rd
  242.   #DEFINE READ_SIZE 16384
  243.     LOCAL cRecv, nRecv, nFlags
  244.     cRecv = Repli(Chr(0), READ_SIZE)
  245.     nFlags = 0
  246.     nRecv = recv(THIS.hSocket, @cRecv, READ_SIZE, nFlags)
  247.     RETURN Iif(nRecv<=0, "", LEFT(cRecv, nRecv))
  248.   ENDFUNC
  249.  
  250.   PROCEDURE decl
  251.     DECLARE INTEGER gethostbyname IN ws2_32 STRING host
  252.     DECLARE STRING inet_ntoa IN ws2_32 INTEGER in_addr
  253.     DECLARE INTEGER socket IN ws2_32 INTEGER af, INTEGER tp, INTEGER pt
  254.     DECLARE INTEGER closesocket IN ws2_32 INTEGER s
  255.     DECLARE INTEGER WSACreateEvent IN ws2_32
  256.     DECLARE INTEGER WSACloseEvent IN ws2_32 INTEGER hEvent
  257.     DECLARE GetSystemTime IN kernel32 STRING @lpSystemTime
  258.     DECLARE INTEGER inet_addr IN ws2_32 STRING cp
  259.     DECLARE INTEGER htons IN ws2_32 INTEGER hostshort
  260.     DECLARE INTEGER WSAStartup IN ws2_32 INTEGER wVerRq, STRING lpWSAData
  261.     DECLARE INTEGER WSACleanup IN ws2_32
  262.  
  263.     DECLARE INTEGER connect IN ws2_32 AS ws_connect ;
  264.         INTEGER s, STRING @sname, INTEGER namelen
  265.  
  266.     DECLARE INTEGER send IN ws2_32;
  267.         INTEGER s, STRING @buf, INTEGER buflen, INTEGER flags
  268.  
  269.     DECLARE INTEGER recv IN ws2_32;
  270.         INTEGER s, STRING @buf, INTEGER buflen, INTEGER flags
  271.  
  272.     DECLARE INTEGER WSAEventSelect IN ws2_32;
  273.         INTEGER s, INTEGER hEventObject, INTEGER lNetworkEvents
  274.  
  275.     DECLARE INTEGER WSAWaitForMultipleEvents IN ws2_32;
  276.         INTEGER cEvents, INTEGER @lphEvents, INTEGER fWaitAll,;
  277.         INTEGER dwTimeout, INTEGER fAlertable
  278.  
  279.     DECLARE RtlMoveMemory IN kernel32 As CopyMemory;
  280.         STRING @Dest, INTEGER Src, INTEGER nLength
  281.   ENDPROC
  282.  
  283.   FUNCTION buf2dword(lcBuffer)
  284.     RETURN Asc(SUBSTR(lcBuffer, 1,1)) + ;
  285.         BitLShift(Asc(SUBSTR(lcBuffer, 2,1)), 8) +;
  286.         BitLShift(Asc(SUBSTR(lcBuffer, 3,1)), 16) +;
  287.         BitLShift(Asc(SUBSTR(lcBuffer, 4,1)), 24)
  288.   ENDFUNC
  289.  
  290.   FUNCTION num2dword(lnValue)
  291.   #DEFINE m0 256
  292.   #DEFINE m1 65536
  293.   #DEFINE m2 16777216
  294.       IF lnValue < 0
  295.           lnValue = 0x100000000 + lnValue
  296.       ENDIF
  297.       LOCAL b0, b1, b2, b3
  298.       b3 = Int(lnValue/m2)
  299.       b2 = Int((lnValue - b3*m2)/m1)
  300.       b1 = Int((lnValue - b3*m2 - b2*m1)/m0)
  301.       b0 = Mod(lnValue, m0)
  302.   RETURN Chr(b0)+Chr(b1)+Chr(b2)+Chr(b3)
  303.   ENDFUNC
  304.  
  305.   FUNCTION num2word(lnValue)
  306.     RETURN Chr(MOD(m.lnValue,256)) + CHR(INT(m.lnValue/256))
  307.   ENDFUNC
  308. ENDDEFI
  309. * la misma fue construida sustentado en la propuesta de
  310. * Anatoliy Mogylevets SMTP su código está disponible en
  311. * complementada por cvillaronga at iutm dot edu dot ve
  312. * http://fox.wikis.com/wc.dll?Wiki~SendSmtpEmail
  313.  
  314. DEFINE CLASS SocketWrapper As Custom
  315.   * DEFINIIONES GENERALES
  316.   #DEFINE SMTP_PORT    25
  317.   #DEFINE http_PORT    80
  318.   #DEFINE AF_INET       2
  319.   #DEFINE SOCK_STREAM   1
  320.   #DEFINE IPPROTO_TCP   6
  321.   #DEFINE SOCKET_ERROR -1
  322.   #DEFINE FD_READ       1
  323.   #DEFINE crlf CHR(13)+CHR(10)
  324.   * VALORES DE LA CLASE
  325.   host     = ""
  326.   IP       = ""
  327.   Port     = 80
  328.   hSocket  = 0
  329.   cIn      = ''
  330.   WaitForRead = 0
  331.  
  332.  
  333.   * Inicializador de la clase
  334.   PROCEDURE Init()
  335.     THIS.decl
  336.     IF WSAStartup(0x202, Repli(Chr(0),512)) <> 0
  337.         * Fue imposible iniciar Winsock en este computador
  338.         RETURN .F.
  339.     ENDIF
  340.     RETURN .T.
  341.   ENDPROC
  342.  
  343.   * Destruir
  344.   PROCEDURE Destroy
  345.     = WSACleanup()
  346.   ENDPROC
  347.  
  348.   * Asignar Host
  349.   PROCEDURE Host_Assign( vNewVal )
  350.     if empty(vNewVal)
  351.       THIS.IP = ''
  352.     else
  353.       THIS.IP = THIS.GetIP(vNewVal)
  354.     endif
  355.     if not empty(THIS.IP)
  356.       THIS.Host = vNewVal
  357.     else
  358.       THIS.Host = ''
  359.     endif
  360.   ENDPROC
  361.  
  362.   * Recuperar IP del host actual
  363.   PROTECTED FUNCTION GetIP( pcHost )
  364.   #DEFINE HOSTENT_SIZE 16
  365.       LOCAL nStruct, nSize, cBuffer, nAddr, cIP
  366.       nStruct = gethostbyname(pcHost)
  367.       IF nStruct = 0
  368.           RETURN ""
  369.       ENDIF
  370.       cBuffer = Repli(Chr(0), HOSTENT_SIZE)
  371.       cIP = Repli(Chr(0), 4)
  372.       = CopyMemory(@cBuffer, nStruct, HOSTENT_SIZE)
  373.       = CopyMemory(@cIP, THIS.buf2dword(SUBS(cBuffer,13,4)),4)
  374.       = CopyMemory(@cIP, THIS.buf2dword(cIP),4)
  375.   RETURN inet_ntoa(THIS.buf2dword(cIP))
  376.   ENDFUNC
  377.  
  378.   * Conectar
  379.   PROTECTED FUNCTION Connect
  380.     LOCAL cBuffer, cPort, cHost, lResult
  381.     THIS.hSocket = socket(AF_INET, SOCK_STREAM, IPPROTO_TCP)
  382.    
  383.     IF THIS.hSocket = SOCKET_ERROR
  384.         RETURN .F.
  385.     ENDIF
  386.    
  387.     cPort = THIS.num2word(htons(THIS.Port))
  388.     nHost = inet_addr(THIS.IP)
  389.     cHost = THIS.num2dword(nHost)
  390.     cBuffer = THIS.num2word(AF_INET) + cPort + cHost + Repli(Chr(0),8)
  391.     lResult = (ws_connect(THIS.hSocket, @cBuffer, Len(cBuffer))=0)
  392.   RETURN lResult
  393.  
  394.  
  395.   * Realizar una solicitud via httpGet a un servidor remoto
  396.   FUNCTION httpGet( pcServer, pcUrl )
  397.     LOCAL lResult
  398.     THIS.Host = pcServer
  399.  
  400.     IF THIS.Connect()
  401.         * Ajustar los siguientes valores para indicar que es un cliente premium nativo.
  402.         THIS.snd("GET "+pcURL+" http/1.0"+crlf)
  403.         THIS.snd("Accept: */*"+crlf)
  404.         THIS.snd("Accept-Language: en-us"+crlf)
  405.         THIS.snd("Accept-Encoding: text/plain, deflate"+crlf)
  406.         THIS.snd("User-Agent: Mozilla/4.0"+crlf)
  407.         THIS.snd("Host: "+pcServer+crlf)
  408.         THIS.snd("Pragma: no-cache"+crlf)
  409.         THIS.snd(crlf,.t.) && End of headers
  410.         *info=url encoded string
  411.         lResult = .T.
  412.     ELSE
  413.         lResult = .F.
  414.     ENDIF
  415.     THIS.Disconnect()
  416.   ENDFUNC
  417.  
  418.   * Realizar una solicitud via httpPost a un servidor remoto
  419.   * considere que esta funcion recibe como parametros pcData e implementa un objeto de retorno poFdbk
  420.   * este método no considera el envío de datos adjuntos como parte de la solicitud.
  421.   * por ahora ne se implementa autorización.
  422.   FUNCTION httpPost( pcServer, pcUrl, pcData, poFdbk )
  423.     LOCAL lResult, lnLen, lnComplete, lcRemain, lcSnd
  424.     THIS.Host = pcServer
  425.  
  426.     IF THIS.Connect()
  427.         THIS.snd("POST "+pcURL+" http/1.0"+crlf)
  428.         THIS.snd("Content-Type:application/x-www-form-urlencoded"+crlf)
  429.         THIS.snd("Accept: */*"+crlf)
  430.         THIS.snd("Accept-Language: en-us"+crlf)
  431.         THIS.snd("Accept-Encoding: text/plain, deflate"+crlf)
  432.         THIS.snd("User-Agent: Mozilla/4.0"+crlf)
  433.         THIS.snd("Host: "+pcServer+crlf)
  434.         lnLen = len(pcData)
  435.         THIS.snd("Content-Length: "+tran(lnLen)+crlf)
  436.         THIS.snd("Pragma: no-cache"+crlf)
  437.         THIS.snd(crlf) && End of headers
  438.         * Si tenemos un objeto de feedback proporcinarle respuesta
  439.         if vartype(poFdbk)='O' and PEMStatus(poFdbk,'Feedback',5) ;
  440.            and upper(PEMStatus(poFdbk,'Feedback',3))='METHOD'
  441.           lcRemain   = pcData
  442.           lnComplete = 0
  443.           poFdbk.Feedback( 0 )
  444.           do while len(lcRemain)>0
  445.             lcSnd      = LEFT( lcRemain, 100 )
  446.             lcRemain   = SUBSTR( lcRemain, 101 )
  447.             THIS.snd(lcSnd)
  448.             lnComplete = lnComplete+len(lcSnd)
  449.             poFdbk.Feedback( lnComplete/lnLen*100 )
  450.           enddo
  451.           THIS.snd('',.t.)
  452.         else && No hay objeto de feedback.
  453.           THIS.snd(pcData,.t.)
  454.         endif
  455.         lResult = .T.
  456.     ELSE
  457.         lResult = .F.
  458.     ENDIF
  459.     THIS.Disconnect()
  460.   ENDFUNC
  461.  
  462.   * método para enviar correo electrónico desde VFP
  463.   FUNCTION SendMail( pcSender, pcRecipient, pcSubject, pcBody )
  464.     LOCAL lResult
  465.     IF THIS.Connect()
  466.         THIS.snd("HELO", .T.)
  467.         THIS.snd("MAIL FROM:<" + pcSender + ">", .T.)
  468.         THIS.snd("RCPT TO:<" + pcRecipient + ">", .T.)
  469.         THIS.snd("DATA", .T.)
  470.         THIS.snd("From: " + pcSender)
  471.         THIS.snd("To: " + pcRecipient)
  472.         THIS.snd("Subject: " + pcSubject)
  473.         THIS.snd("")
  474.         THIS.snd(pcBody)
  475.         THIS.snd(".", .T.)
  476.         THIS.snd("QUIT", .T.)
  477.         lResult = .T.
  478.     ELSE
  479.         = MessageB("Unable to connect to [" + THIS.Host +;
  480.             "] on port " + LTRIM(STR(SMTP_PORT)) + ". ",;
  481.             48, " Connection error")
  482.         lResult = .F.
  483.     ENDIF
  484.     THIS.Disconnect()
  485.   RETURN lResult
  486.   ENDFUNC
  487.  
  488.   Function URLencode
  489.   LPARAMETER pcInStr
  490.   *  ' encode Percent signs
  491.   *  '        Double Quotes
  492.   *  '        CarriageReturn / LineFeeds
  493.  
  494.   LOCAL lcOut, lnI
  495.     * StrTran is WAY faster than building the string in memory
  496.     lcOut = StrTran(pcInStr, [%], '%25' )
  497.     lcOut = StrTran(lcOut,   [+], '%2B' )
  498.     lcOut = StrTran(lcOut,   [ ], '+'   )
  499.     for lnI = 0 to 31
  500.       lcOut = StrTran( lcOut, chr(lnI), '%' + Right( Transform(lnI,'@0'), 2 ) )
  501.     endfor
  502.     for lnI = 127 to 255
  503.       lcOut = StrTran( lcOut, chr(lnI), '%' + Right( Transform(lnI,'@0'), 2 ) )
  504.     endfor
  505.  
  506.     RETURN lcOut
  507.  
  508.   ENDFUNC
  509.  
  510.   FUNCTION Disconnect
  511.     if THIS.hSocket<>SOCKET_ERROR
  512.       = closesocket(THIS.hSocket)
  513.     endif
  514.     THIS.hSocket = SOCKET_ERROR
  515.   ENDFUNC
  516.  
  517.   FUNCTION snd(cData, lResponse)
  518.     LOCAL cBuffer, nResult, cResponse
  519.     cBuffer = cData && + CrLf
  520.     nResult = send(THIS.hSocket, @cBuffer, Len(cBuffer), 0)
  521.     IF nResult = SOCKET_ERROR
  522.         RETURN .F.
  523.     ENDIF
  524.     IF Not lResponse
  525.         RETURN .T.
  526.     ENDIF
  527.  
  528.     LOCAL hEventRead, nWait, cRead
  529.     DO WHILE .T.
  530.         * creating event, linking it to the socket and wait
  531.         hEventRead = WSACreateEvent()
  532.         = WSAEventSelect(THIS.hSocket, hEventRead, FD_READ)
  533.  
  534.         * 1000 milliseconds can be not enough
  535.         THIS.WaitForRead = WSAWaitForMultipleEvents(1, @hEventRead, 0, 2000, 0)
  536.         = WSACloseEvent(hEventRead)
  537.  
  538.         IF THIS.WaitForRead <> 0 && error or timeout
  539.             EXIT
  540.         ENDIF
  541.        
  542.         * reading data from connected socket
  543.         THIS.cIn = THIS.cIn+THIS.Rd()
  544.     ENDDO
  545.   RETURN .T.
  546.   ENDFUNC
  547.  
  548.   PROTECTED FUNCTION Rd
  549.   #DEFINE READ_SIZE 16384
  550.     LOCAL cRecv, nRecv, nFlags
  551.     cRecv = Repli(Chr(0), READ_SIZE)
  552.     nFlags = 0
  553.     nRecv = recv(THIS.hSocket, @cRecv, READ_SIZE, nFlags)
  554.     RETURN Iif(nRecv<=0, "", LEFT(cRecv, nRecv))
  555.   ENDFUNC
  556.  
  557.   PROCEDURE decl
  558.     DECLARE INTEGER gethostbyname IN ws2_32 STRING host
  559.     DECLARE STRING inet_ntoa IN ws2_32 INTEGER in_addr
  560.     DECLARE INTEGER socket IN ws2_32 INTEGER af, INTEGER tp, INTEGER pt
  561.     DECLARE INTEGER closesocket IN ws2_32 INTEGER s
  562.     DECLARE INTEGER WSACreateEvent IN ws2_32
  563.     DECLARE INTEGER WSACloseEvent IN ws2_32 INTEGER hEvent
  564.     DECLARE GetSystemTime IN kernel32 STRING @lpSystemTime
  565.     DECLARE INTEGER inet_addr IN ws2_32 STRING cp
  566.     DECLARE INTEGER htons IN ws2_32 INTEGER hostshort
  567.     DECLARE INTEGER WSAStartup IN ws2_32 INTEGER wVerRq, STRING lpWSAData
  568.     DECLARE INTEGER WSACleanup IN ws2_32
  569.  
  570.     DECLARE INTEGER connect IN ws2_32 AS ws_connect ;
  571.         INTEGER s, STRING @sname, INTEGER namelen
  572.  
  573.     DECLARE INTEGER send IN ws2_32;
  574.         INTEGER s, STRING @buf, INTEGER buflen, INTEGER flags
  575.  
  576.     DECLARE INTEGER recv IN ws2_32;
  577.         INTEGER s, STRING @buf, INTEGER buflen, INTEGER flags
  578.  
  579.     DECLARE INTEGER WSAEventSelect IN ws2_32;
  580.         INTEGER s, INTEGER hEventObject, INTEGER lNetworkEvents
  581.  
  582.     DECLARE INTEGER WSAWaitForMultipleEvents IN ws2_32;
  583.         INTEGER cEvents, INTEGER @lphEvents, INTEGER fWaitAll,;
  584.         INTEGER dwTimeout, INTEGER fAlertable
  585.  
  586.     DECLARE RtlMoveMemory IN kernel32 As CopyMemory;
  587.         STRING @Dest, INTEGER Src, INTEGER nLength
  588.   ENDPROC
  589.  
  590.   FUNCTION buf2dword(lcBuffer)
  591.     RETURN Asc(SUBSTR(lcBuffer, 1,1)) + ;
  592.         BitLShift(Asc(SUBSTR(lcBuffer, 2,1)), 8) +;
  593.         BitLShift(Asc(SUBSTR(lcBuffer, 3,1)), 16) +;
  594.         BitLShift(Asc(SUBSTR(lcBuffer, 4,1)), 24)
  595.   ENDFUNC
  596.  
  597.   FUNCTION num2dword(lnValue)
  598.   #DEFINE m0 256
  599.   #DEFINE m1 65536
  600.   #DEFINE m2 16777216
  601.       IF lnValue < 0
  602.           lnValue = 0x100000000 + lnValue
  603.       ENDIF
  604.       LOCAL b0, b1, b2, b3
  605.       b3 = Int(lnValue/m2)
  606.       b2 = Int((lnValue - b3*m2)/m1)
  607.       b1 = Int((lnValue - b3*m2 - b2*m1)/m0)
  608.       b0 = Mod(lnValue, m0)
  609.   RETURN Chr(b0)+Chr(b1)+Chr(b2)+Chr(b3)
  610.   ENDFUNC
  611.  
  612.   FUNCTION num2word(lnValue)
  613.     RETURN Chr(MOD(m.lnValue,256)) + CHR(INT(m.lnValue/256))
  614.   ENDFUNC
  615. ENDDEFI
  616. * Anatoliy Mogylevets SMTP su código está disponible en
  617. * complementada por cvillaronga at iutm dot edu dot ve
  618. * http://fox.wikis.com/wc.dll?Wiki~SendSmtpEmail
  619.  
  620. DEFINE CLASS SocketWrapper As Custom
  621.   * DEFINIIONES GENERALES
  622.   #DEFINE SMTP_PORT    25
  623.   #DEFINE http_PORT    80
  624.   #DEFINE AF_INET       2
  625.   #DEFINE SOCK_STREAM   1
  626.   #DEFINE IPPROTO_TCP   6
  627.   #DEFINE SOCKET_ERROR -1
  628.   #DEFINE FD_READ       1
  629.   #DEFINE crlf CHR(13)+CHR(10)
  630.   * VALORES DE LA CLASE
  631.   host     = ""
  632.   IP       = ""
  633.   Port     = 80
  634.   hSocket  = 0
  635.   cIn      = ''
  636.   WaitForRead = 0
  637.  
  638.  
  639.   * Inicializador de la clase
  640.   PROCEDURE Init()
  641.     THIS.decl
  642.     IF WSAStartup(0x202, Repli(Chr(0),512)) <> 0
  643.         * Fue imposible iniciar Winsock en este computador
  644.         RETURN .F.
  645.     ENDIF
  646.     RETURN .T.
  647.   ENDPROC
  648.  
  649.   * Destruir
  650.   PROCEDURE Destroy
  651.     = WSACleanup()
  652.   ENDPROC
  653.  
  654.   * Asignar Host
  655.   PROCEDURE Host_Assign( vNewVal )
  656.     if empty(vNewVal)
  657.       THIS.IP = ''
  658.     else
  659.       THIS.IP = THIS.GetIP(vNewVal)
  660.     endif
  661.     if not empty(THIS.IP)
  662.       THIS.Host = vNewVal
  663.     else
  664.       THIS.Host = ''
  665.     endif
  666.   ENDPROC
  667.  
  668.   * Recuperar IP del host actual
  669.   PROTECTED FUNCTION GetIP( pcHost )
  670.   #DEFINE HOSTENT_SIZE 16
  671.       LOCAL nStruct, nSize, cBuffer, nAddr, cIP
  672.       nStruct = gethostbyname(pcHost)
  673.       IF nStruct = 0
  674.           RETURN ""
  675.       ENDIF
  676.       cBuffer = Repli(Chr(0), HOSTENT_SIZE)
  677.       cIP = Repli(Chr(0), 4)
  678.       = CopyMemory(@cBuffer, nStruct, HOSTENT_SIZE)
  679.       = CopyMemory(@cIP, THIS.buf2dword(SUBS(cBuffer,13,4)),4)
  680.       = CopyMemory(@cIP, THIS.buf2dword(cIP),4)
  681.   RETURN inet_ntoa(THIS.buf2dword(cIP))
  682.   ENDFUNC
  683.  
  684.   * Conectar
  685.   PROTECTED FUNCTION Connect
  686.     LOCAL cBuffer, cPort, cHost, lResult
  687.     THIS.hSocket = socket(AF_INET, SOCK_STREAM, IPPROTO_TCP)
  688.    
  689.     IF THIS.hSocket = SOCKET_ERROR
  690.         RETURN .F.
  691.     ENDIF
  692.    
  693.     cPort = THIS.num2word(htons(THIS.Port))
  694.     nHost = inet_addr(THIS.IP)
  695.     cHost = THIS.num2dword(nHost)
  696.     cBuffer = THIS.num2word(AF_INET) + cPort + cHost + Repli(Chr(0),8)
  697.     lResult = (ws_connect(THIS.hSocket, @cBuffer, Len(cBuffer))=0)
  698.   RETURN lResult
  699.  
  700.  
  701.   * Realizar una solicitud via httpGet a un servidor remoto
  702.   FUNCTION httpGet( pcServer, pcUrl )
  703.     LOCAL lResult
  704.     THIS.Host = pcServer
  705.  
  706.     IF THIS.Connect()
  707.         * Ajustar los siguientes valores para indicar que es un cliente premium nativo.
  708.         THIS.snd("GET "+pcURL+" http/1.0"+crlf)
  709.         THIS.snd("Accept: */*"+crlf)
  710.         THIS.snd("Accept-Language: en-us"+crlf)
  711.         THIS.snd("Accept-Encoding: text/plain, deflate"+crlf)
  712.         THIS.snd("User-Agent: Mozilla/4.0"+crlf)
  713.         THIS.snd("Host: "+pcServer+crlf)
  714.         THIS.snd("Pragma: no-cache"+crlf)
  715.         THIS.snd(crlf,.t.) && End of headers
  716.         *info=url encoded string
  717.         lResult = .T.
  718.     ELSE
  719.         lResult = .F.
  720.     ENDIF
  721.     THIS.Disconnect()
  722.   ENDFUNC
  723.  
  724.   * Realizar una solicitud via httpPost a un servidor remoto
  725.   * considere que esta funcion recibe como parametros pcData e implementa un objeto de retorno poFdbk
  726.   * este método no considera el envío de datos adjuntos como parte de la solicitud.
  727.   * por ahora ne se implementa autorización.
  728.   FUNCTION httpPost( pcServer, pcUrl, pcData, poFdbk )
  729.     LOCAL lResult, lnLen, lnComplete, lcRemain, lcSnd
  730.     THIS.Host = pcServer
  731.  
  732.     IF THIS.Connect()
  733.         THIS.snd("POST "+pcURL+" http/1.0"+crlf)
  734.         THIS.snd("Content-Type:application/x-www-form-urlencoded"+crlf)
  735.         THIS.snd("Accept: */*"+crlf)
  736.         THIS.snd("Accept-Language: en-us"+crlf)
  737.         THIS.snd("Accept-Encoding: text/plain, deflate"+crlf)
  738.         THIS.snd("User-Agent: Mozilla/4.0"+crlf)
  739.         THIS.snd("Host: "+pcServer+crlf)
  740.         lnLen = len(pcData)
  741.         THIS.snd("Content-Length: "+tran(lnLen)+crlf)
  742.         THIS.snd("Pragma: no-cache"+crlf)
  743.         THIS.snd(crlf) && End of headers
  744.         * Si tenemos un objeto de feedback proporcinarle respuesta
  745.         if vartype(poFdbk)='O' and PEMStatus(poFdbk,'Feedback',5) ;
  746.            and upper(PEMStatus(poFdbk,'Feedback',3))='METHOD'
  747.           lcRemain   = pcData
  748.           lnComplete = 0
  749.           poFdbk.Feedback( 0 )
  750.           do while len(lcRemain)>0
  751.             lcSnd      = LEFT( lcRemain, 100 )
  752.             lcRemain   = SUBSTR( lcRemain, 101 )
  753.             THIS.snd(lcSnd)
  754.             lnComplete = lnComplete+len(lcSnd)
  755.             poFdbk.Feedback( lnComplete/lnLen*100 )
  756.           enddo
  757.           THIS.snd('',.t.)
  758.         else && No hay objeto de feedback.
  759.           THIS.snd(pcData,.t.)
  760.         endif
  761.         lResult = .T.
  762.     ELSE
  763.         lResult = .F.
  764.     ENDIF
  765.     THIS.Disconnect()
  766.   ENDFUNC
  767.  
  768.   * método para enviar correo electrónico desde VFP
  769.   FUNCTION SendMail( pcSender, pcRecipient, pcSubject, pcBody )
  770.     LOCAL lResult
  771.     IF THIS.Connect()
  772.         THIS.snd("HELO", .T.)
  773.         THIS.snd("MAIL FROM:<" + pcSender + ">", .T.)
  774.         THIS.snd("RCPT TO:<" + pcRecipient + ">", .T.)
  775.         THIS.snd("DATA", .T.)
  776.         THIS.snd("From: " + pcSender)
  777.         THIS.snd("To: " + pcRecipient)
  778.         THIS.snd("Subject: " + pcSubject)
  779.         THIS.snd("")
  780.         THIS.snd(pcBody)
  781.         THIS.snd(".", .T.)
  782.         THIS.snd("QUIT", .T.)
  783.         lResult = .T.
  784.     ELSE
  785.         = MessageB("Unable to connect to [" + THIS.Host +;
  786.             "] on port " + LTRIM(STR(SMTP_PORT)) + ". ",;
  787.             48, " Connection error")
  788.         lResult = .F.
  789.     ENDIF
  790.     THIS.Disconnect()
  791.   RETURN lResult
  792.   ENDFUNC
  793.  
  794.   Function URLencode
  795.   LPARAMETER pcInStr
  796.   *  ' encode Percent signs
  797.   *  '        Double Quotes
  798.   *  '        CarriageReturn / LineFeeds
  799.  
  800.   LOCAL lcOut, lnI
  801.     * StrTran is WAY faster than building the string in memory
  802.     lcOut = StrTran(pcInStr, [%], '%25' )
  803.     lcOut = StrTran(lcOut,   [+], '%2B' )
  804.     lcOut = StrTran(lcOut,   [ ], '+'   )
  805.     for lnI = 0 to 31
  806.       lcOut = StrTran( lcOut, chr(lnI), '%' + Right( Transform(lnI,'@0'), 2 ) )
  807.     endfor
  808.     for lnI = 127 to 255
  809.       lcOut = StrTran( lcOut, chr(lnI), '%' + Right( Transform(lnI,'@0'), 2 ) )
  810.     endfor
  811.  
  812.     RETURN lcOut
  813.  
  814.   ENDFUNC
  815.  
  816.   FUNCTION Disconnect
  817.     if THIS.hSocket<>SOCKET_ERROR
  818.       = closesocket(THIS.hSocket)
  819.     endif
  820.     THIS.hSocket = SOCKET_ERROR
  821.   ENDFUNC
  822.  
  823.   FUNCTION snd(cData, lResponse)
  824.     LOCAL cBuffer, nResult, cResponse
  825.     cBuffer = cData && + CrLf
  826.     nResult = send(THIS.hSocket, @cBuffer, Len(cBuffer), 0)
  827.     IF nResult = SOCKET_ERROR
  828.         RETURN .F.
  829.     ENDIF
  830.     IF Not lResponse
  831.         RETURN .T.
  832.     ENDIF
  833.  
  834.     LOCAL hEventRead, nWait, cRead
  835.     DO WHILE .T.
  836.         * creating event, linking it to the socket and wait
  837.         hEventRead = WSACreateEvent()
  838.         = WSAEventSelect(THIS.hSocket, hEventRead, FD_READ)
  839.  
  840.         * 1000 milliseconds can be not enough
  841.         THIS.WaitForRead = WSAWaitForMultipleEvents(1, @hEventRead, 0, 2000, 0)
  842.         = WSACloseEvent(hEventRead)
  843.  
  844.         IF THIS.WaitForRead <> 0 && error or timeout
  845.             EXIT
  846.         ENDIF
  847.        
  848.         * reading data from connected socket
  849.         THIS.cIn = THIS.cIn+THIS.Rd()
  850.     ENDDO
  851.   RETURN .T.
  852.   ENDFUNC
  853.  
  854.   PROTECTED FUNCTION Rd
  855.   #DEFINE READ_SIZE 16384
  856.     LOCAL cRecv, nRecv, nFlags
  857.     cRecv = Repli(Chr(0), READ_SIZE)
  858.     nFlags = 0
  859.     nRecv = recv(THIS.hSocket, @cRecv, READ_SIZE, nFlags)
  860.     RETURN Iif(nRecv<=0, "", LEFT(cRecv, nRecv))
  861.   ENDFUNC
  862.  
  863.   PROCEDURE decl
  864.     DECLARE INTEGER gethostbyname IN ws2_32 STRING host
  865.     DECLARE STRING inet_ntoa IN ws2_32 INTEGER in_addr
  866.     DECLARE INTEGER socket IN ws2_32 INTEGER af, INTEGER tp, INTEGER pt
  867.     DECLARE INTEGER closesocket IN ws2_32 INTEGER s
  868.     DECLARE INTEGER WSACreateEvent IN ws2_32
  869.     DECLARE INTEGER WSACloseEvent IN ws2_32 INTEGER hEvent
  870.     DECLARE GetSystemTime IN kernel32 STRING @lpSystemTime
  871.     DECLARE INTEGER inet_addr IN ws2_32 STRING cp
  872.     DECLARE INTEGER htons IN ws2_32 INTEGER hostshort
  873.     DECLARE INTEGER WSAStartup IN ws2_32 INTEGER wVerRq, STRING lpWSAData
  874.     DECLARE INTEGER WSACleanup IN ws2_32
  875.  
  876.     DECLARE INTEGER connect IN ws2_32 AS ws_connect ;
  877.         INTEGER s, STRING @sname, INTEGER namelen
  878.  
  879.     DECLARE INTEGER send IN ws2_32;
  880.         INTEGER s, STRING @buf, INTEGER buflen, INTEGER flags
  881.  
  882.     DECLARE INTEGER recv IN ws2_32;
  883.         INTEGER s, STRING @buf, INTEGER buflen, INTEGER flags
  884.  
  885.     DECLARE INTEGER WSAEventSelect IN ws2_32;
  886.         INTEGER s, INTEGER hEventObject, INTEGER lNetworkEvents
  887.  
  888.     DECLARE INTEGER WSAWaitForMultipleEvents IN ws2_32;
  889.         INTEGER cEvents, INTEGER @lphEvents, INTEGER fWaitAll,;
  890.         INTEGER dwTimeout, INTEGER fAlertable
  891.  
  892.     DECLARE RtlMoveMemory IN kernel32 As CopyMemory;
  893.         STRING @Dest, INTEGER Src, INTEGER nLength
  894.   ENDPROC
  895.  
  896.   FUNCTION buf2dword(lcBuffer)
  897.     RETURN Asc(SUBSTR(lcBuffer, 1,1)) + ;
  898.         BitLShift(Asc(SUBSTR(lcBuffer, 2,1)), 8) +;
  899.         BitLShift(Asc(SUBSTR(lcBuffer, 3,1)), 16) +;
  900.         BitLShift(Asc(SUBSTR(lcBuffer, 4,1)), 24)
  901.   ENDFUNC
  902.  
  903.   FUNCTION num2dword(lnValue)
  904.   #DEFINE m0 256
  905.   #DEFINE m1 65536
  906.   #DEFINE m2 16777216
  907.       IF lnValue < 0
  908.           lnValue = 0x100000000 + lnValue
  909.       ENDIF
  910.       LOCAL b0, b1, b2, b3
  911.       b3 = Int(lnValue/m2)
  912.       b2 = Int((lnValue - b3*m2)/m1)
  913.       b1 = Int((lnValue - b3*m2 - b2*m1)/m0)
  914.       b0 = Mod(lnValue, m0)
  915.   RETURN Chr(b0)+Chr(b1)+Chr(b2)+Chr(b3)
  916.   ENDFUNC
  917.  
  918.   FUNCTION num2word(lnValue)
  919.     RETURN Chr(MOD(m.lnValue,256)) + CHR(INT(m.lnValue/256))
  920.   ENDFUNC
  921. ENDDEFI
  922. * complementada por cvillaronga at iutm dot edu dot ve
  923. * http://fox.wikis.com/wc.dll?Wiki~SendSmtpEmail
  924.  
  925. DEFINE CLASS SocketWrapper As Custom
  926.   * DEFINIIONES GENERALES
  927.   #DEFINE SMTP_PORT    25
  928.   #DEFINE http_PORT    80
  929.   #DEFINE AF_INET       2
  930.   #DEFINE SOCK_STREAM   1
  931.   #DEFINE IPPROTO_TCP   6
  932.   #DEFINE SOCKET_ERROR -1
  933.   #DEFINE FD_READ       1
  934.   #DEFINE crlf CHR(13)+CHR(10)
  935.   * VALORES DE LA CLASE
  936.   host     = ""
  937.   IP       = ""
  938.   Port     = 80
  939.   hSocket  = 0
  940.   cIn      = ''
  941.   WaitForRead = 0
  942.  
  943.  
  944.   * Inicializador de la clase
  945.   PROCEDURE Init()
  946.     THIS.decl
  947.     IF WSAStartup(0x202, Repli(Chr(0),512)) <> 0
  948.         * Fue imposible iniciar Winsock en este computador
  949.         RETURN .F.
  950.     ENDIF
  951.     RETURN .T.
  952.   ENDPROC
  953.  
  954.   * Destruir
  955.   PROCEDURE Destroy
  956.     = WSACleanup()
  957.   ENDPROC
  958.  
  959.   * Asignar Host
  960.   PROCEDURE Host_Assign( vNewVal )
  961.     if empty(vNewVal)
  962.       THIS.IP = ''
  963.     else
  964.       THIS.IP = THIS.GetIP(vNewVal)
  965.     endif
  966.     if not empty(THIS.IP)
  967.       THIS.Host = vNewVal
  968.     else
  969.       THIS.Host = ''
  970.     endif
  971.   ENDPROC
  972.  
  973.   * Recuperar IP del host actual
  974.   PROTECTED FUNCTION GetIP( pcHost )
  975.   #DEFINE HOSTENT_SIZE 16
  976.       LOCAL nStruct, nSize, cBuffer, nAddr, cIP
  977.       nStruct = gethostbyname(pcHost)
  978.       IF nStruct = 0
  979.           RETURN ""
  980.       ENDIF
  981.       cBuffer = Repli(Chr(0), HOSTENT_SIZE)
  982.       cIP = Repli(Chr(0), 4)
  983.       = CopyMemory(@cBuffer, nStruct, HOSTENT_SIZE)
  984.       = CopyMemory(@cIP, THIS.buf2dword(SUBS(cBuffer,13,4)),4)
  985.       = CopyMemory(@cIP, THIS.buf2dword(cIP),4)
  986.   RETURN inet_ntoa(THIS.buf2dword(cIP))
  987.   ENDFUNC
  988.  
  989.   * Conectar
  990.   PROTECTED FUNCTION Connect
  991.     LOCAL cBuffer, cPort, cHost, lResult
  992.     THIS.hSocket = socket(AF_INET, SOCK_STREAM, IPPROTO_TCP)
  993.    
  994.     IF THIS.hSocket = SOCKET_ERROR
  995.         RETURN .F.
  996.     ENDIF
  997.    
  998.     cPort = THIS.num2word(htons(THIS.Port))
  999.     nHost = inet_addr(THIS.IP)
  1000.     cHost = THIS.num2dword(nHost)
  1001.     cBuffer = THIS.num2word(AF_INET) + cPort + cHost + Repli(Chr(0),8)
  1002.     lResult = (ws_connect(THIS.hSocket, @cBuffer, Len(cBuffer))=0)
  1003.   RETURN lResult
  1004.  
  1005.  
  1006.   * Realizar una solicitud via httpGet a un servidor remoto
  1007.   FUNCTION httpGet( pcServer, pcUrl )
  1008.     LOCAL lResult
  1009.     THIS.Host = pcServer
  1010.  
  1011.     IF THIS.Connect()
  1012.         * Ajustar los siguientes valores para indicar que es un cliente premium nativo.
  1013.         THIS.snd("GET "+pcURL+" http/1.0"+crlf)
  1014.         THIS.snd("Accept: */*"+crlf)
  1015.         THIS.snd("Accept-Language: en-us"+crlf)
  1016.         THIS.snd("Accept-Encoding: text/plain, deflate"+crlf)
  1017.         THIS.snd("User-Agent: Mozilla/4.0"+crlf)
  1018.         THIS.snd("Host: "+pcServer+crlf)
  1019.         THIS.snd("Pragma: no-cache"+crlf)
  1020.         THIS.snd(crlf,.t.) && End of headers
  1021.         *info=url encoded string
  1022.         lResult = .T.
  1023.     ELSE
  1024.         lResult = .F.
  1025.     ENDIF
  1026.     THIS.Disconnect()
  1027.   ENDFUNC
  1028.  
  1029.   * Realizar una solicitud via httpPost a un servidor remoto
  1030.   * considere que esta funcion recibe como parametros pcData e implementa un objeto de retorno poFdbk
  1031.   * este método no considera el envío de datos adjuntos como parte de la solicitud.
  1032.   * por ahora ne se implementa autorización.
  1033.   FUNCTION httpPost( pcServer, pcUrl, pcData, poFdbk )
  1034.     LOCAL lResult, lnLen, lnComplete, lcRemain, lcSnd
  1035.     THIS.Host = pcServer
  1036.  
  1037.     IF THIS.Connect()
  1038.         THIS.snd("POST "+pcURL+" http/1.0"+crlf)
  1039.         THIS.snd("Content-Type:application/x-www-form-urlencoded"+crlf)
  1040.         THIS.snd("Accept: */*"+crlf)
  1041.         THIS.snd("Accept-Language: en-us"+crlf)
  1042.         THIS.snd("Accept-Encoding: text/plain, deflate"+crlf)
  1043.         THIS.snd("User-Agent: Mozilla/4.0"+crlf)
  1044.         THIS.snd("Host: "+pcServer+crlf)
  1045.         lnLen = len(pcData)
  1046.         THIS.snd("Content-Length: "+tran(lnLen)+crlf)
  1047.         THIS.snd("Pragma: no-cache"+crlf)
  1048.         THIS.snd(crlf) && End of headers
  1049.         * Si tenemos un objeto de feedback proporcinarle respuesta
  1050.         if vartype(poFdbk)='O' and PEMStatus(poFdbk,'Feedback',5) ;
  1051.            and upper(PEMStatus(poFdbk,'Feedback',3))='METHOD'
  1052.           lcRemain   = pcData
  1053.           lnComplete = 0
  1054.           poFdbk.Feedback( 0 )
  1055.           do while len(lcRemain)>0
  1056.             lcSnd      = LEFT( lcRemain, 100 )
  1057.             lcRemain   = SUBSTR( lcRemain, 101 )
  1058.             THIS.snd(lcSnd)
  1059.             lnComplete = lnComplete+len(lcSnd)
  1060.             poFdbk.Feedback( lnComplete/lnLen*100 )
  1061.           enddo
  1062.           THIS.snd('',.t.)
  1063.         else && No hay objeto de feedback.
  1064.           THIS.snd(pcData,.t.)
  1065.         endif
  1066.         lResult = .T.
  1067.     ELSE
  1068.         lResult = .F.
  1069.     ENDIF
  1070.     THIS.Disconnect()
  1071.   ENDFUNC
  1072.  
  1073.   * método para enviar correo electrónico desde VFP
  1074.   FUNCTION SendMail( pcSender, pcRecipient, pcSubject, pcBody )
  1075.     LOCAL lResult
  1076.     IF THIS.Connect()
  1077.         THIS.snd("HELO", .T.)
  1078.         THIS.snd("MAIL FROM:<" + pcSender + ">", .T.)
  1079.         THIS.snd("RCPT TO:<" + pcRecipient + ">", .T.)
  1080.         THIS.snd("DATA", .T.)
  1081.         THIS.snd("From: " + pcSender)
  1082.         THIS.snd("To: " + pcRecipient)
  1083.         THIS.snd("Subject: " + pcSubject)
  1084.         THIS.snd("")
  1085.         THIS.snd(pcBody)
  1086.         THIS.snd(".", .T.)
  1087.         THIS.snd("QUIT", .T.)
  1088.         lResult = .T.
  1089.     ELSE
  1090.         = MessageB("Unable to connect to [" + THIS.Host +;
  1091.             "] on port " + LTRIM(STR(SMTP_PORT)) + ". ",;
  1092.             48, " Connection error")
  1093.         lResult = .F.
  1094.     ENDIF
  1095.     THIS.Disconnect()
  1096.   RETURN lResult
  1097.   ENDFUNC
  1098.  
  1099.   Function URLencode
  1100.   LPARAMETER pcInStr
  1101.   *  ' encode Percent signs
  1102.   *  '        Double Quotes
  1103.   *  '        CarriageReturn / LineFeeds
  1104.  
  1105.   LOCAL lcOut, lnI
  1106.     * StrTran is WAY faster than building the string in memory
  1107.     lcOut = StrTran(pcInStr, [%], '%25' )
  1108.     lcOut = StrTran(lcOut,   [+], '%2B' )
  1109.     lcOut = StrTran(lcOut,   [ ], '+'   )
  1110.     for lnI = 0 to 31
  1111.       lcOut = StrTran( lcOut, chr(lnI), '%' + Right( Transform(lnI,'@0'), 2 ) )
  1112.     endfor
  1113.     for lnI = 127 to 255
  1114.       lcOut = StrTran( lcOut, chr(lnI), '%' + Right( Transform(lnI,'@0'), 2 ) )
  1115.     endfor
  1116.  
  1117.     RETURN lcOut
  1118.  
  1119.   ENDFUNC
  1120.  
  1121.   FUNCTION Disconnect
  1122.     if THIS.hSocket<>SOCKET_ERROR
  1123.       = closesocket(THIS.hSocket)
  1124.     endif
  1125.     THIS.hSocket = SOCKET_ERROR
  1126.   ENDFUNC
  1127.  
  1128.   FUNCTION snd(cData, lResponse)
  1129.     LOCAL cBuffer, nResult, cResponse
  1130.     cBuffer = cData && + CrLf
  1131.     nResult = send(THIS.hSocket, @cBuffer, Len(cBuffer), 0)
  1132.     IF nResult = SOCKET_ERROR
  1133.         RETURN .F.
  1134.     ENDIF
  1135.     IF Not lResponse
  1136.         RETURN .T.
  1137.     ENDIF
  1138.  
  1139.     LOCAL hEventRead, nWait, cRead
  1140.     DO WHILE .T.
  1141.         * creating event, linking it to the socket and wait
  1142.         hEventRead = WSACreateEvent()
  1143.         = WSAEventSelect(THIS.hSocket, hEventRead, FD_READ)
  1144.  
  1145.         * 1000 milliseconds can be not enough
  1146.         THIS.WaitForRead = WSAWaitForMultipleEvents(1, @hEventRead, 0, 2000, 0)
  1147.         = WSACloseEvent(hEventRead)
  1148.  
  1149.         IF THIS.WaitForRead <> 0 && error or timeout
  1150.             EXIT
  1151.         ENDIF
  1152.        
  1153.         * reading data from connected socket
  1154.         THIS.cIn = THIS.cIn+THIS.Rd()
  1155.     ENDDO
  1156.   RETURN .T.
  1157.   ENDFUNC
  1158.  
  1159.   PROTECTED FUNCTION Rd
  1160.   #DEFINE READ_SIZE 16384
  1161.     LOCAL cRecv, nRecv, nFlags
  1162.     cRecv = Repli(Chr(0), READ_SIZE)
  1163.     nFlags = 0
  1164.     nRecv = recv(THIS.hSocket, @cRecv, READ_SIZE, nFlags)
  1165.     RETURN Iif(nRecv<=0, "", LEFT(cRecv, nRecv))
  1166.   ENDFUNC
  1167.  
  1168.   PROCEDURE decl
  1169.     DECLARE INTEGER gethostbyname IN ws2_32 STRING host
  1170.     DECLARE STRING inet_ntoa IN ws2_32 INTEGER in_addr
  1171.     DECLARE INTEGER socket IN ws2_32 INTEGER af, INTEGER tp, INTEGER pt
  1172.     DECLARE INTEGER closesocket IN ws2_32 INTEGER s
  1173.     DECLARE INTEGER WSACreateEvent IN ws2_32
  1174.     DECLARE INTEGER WSACloseEvent IN ws2_32 INTEGER hEvent
  1175.     DECLARE GetSystemTime IN kernel32 STRING @lpSystemTime
  1176.     DECLARE INTEGER inet_addr IN ws2_32 STRING cp
  1177.     DECLARE INTEGER htons IN ws2_32 INTEGER hostshort
  1178.     DECLARE INTEGER WSAStartup IN ws2_32 INTEGER wVerRq, STRING lpWSAData
  1179.     DECLARE INTEGER WSACleanup IN ws2_32
  1180.  
  1181.     DECLARE INTEGER connect IN ws2_32 AS ws_connect ;
  1182.         INTEGER s, STRING @sname, INTEGER namelen
  1183.  
  1184.     DECLARE INTEGER send IN ws2_32;
  1185.         INTEGER s, STRING @buf, INTEGER buflen, INTEGER flags
  1186.  
  1187.     DECLARE INTEGER recv IN ws2_32;
  1188.         INTEGER s, STRING @buf, INTEGER buflen, INTEGER flags
  1189.  
  1190.     DECLARE INTEGER WSAEventSelect IN ws2_32;
  1191.         INTEGER s, INTEGER hEventObject, INTEGER lNetworkEvents
  1192.  
  1193.     DECLARE INTEGER WSAWaitForMultipleEvents IN ws2_32;
  1194.         INTEGER cEvents, INTEGER @lphEvents, INTEGER fWaitAll,;
  1195.         INTEGER dwTimeout, INTEGER fAlertable
  1196.  
  1197.     DECLARE RtlMoveMemory IN kernel32 As CopyMemory;
  1198.         STRING @Dest, INTEGER Src, INTEGER nLength
  1199.   ENDPROC
  1200.  
  1201.   FUNCTION buf2dword(lcBuffer)
  1202.     RETURN Asc(SUBSTR(lcBuffer, 1,1)) + ;
  1203.         BitLShift(Asc(SUBSTR(lcBuffer, 2,1)), 8) +;
  1204.         BitLShift(Asc(SUBSTR(lcBuffer, 3,1)), 16) +;
  1205.         BitLShift(Asc(SUBSTR(lcBuffer, 4,1)), 24)
  1206.   ENDFUNC
  1207.  
  1208.   FUNCTION num2dword(lnValue)
  1209.   #DEFINE m0 256
  1210.   #DEFINE m1 65536
  1211.   #DEFINE m2 16777216
  1212.       IF lnValue < 0
  1213.           lnValue = 0x100000000 + lnValue
  1214.       ENDIF
  1215.       LOCAL b0, b1, b2, b3
  1216.       b3 = Int(lnValue/m2)
  1217.       b2 = Int((lnValue - b3*m2)/m1)
  1218.       b1 = Int((lnValue - b3*m2 - b2*m1)/m0)
  1219.       b0 = Mod(lnValue, m0)
  1220.   RETURN Chr(b0)+Chr(b1)+Chr(b2)+Chr(b3)
  1221.   ENDFUNC
  1222.  
  1223.   FUNCTION num2word(lnValue)
  1224.     RETURN Chr(MOD(m.lnValue,256)) + CHR(INT(m.lnValue/256))
  1225.   ENDFUNC
  1226. ENDDEFI
  1227. * http://fox.wikis.com/wc.dll?Wiki~SendSmtpEmail
  1228.  
  1229. DEFINE CLASS SocketWrapper As Custom
  1230.   * DEFINIIONES GENERALES
  1231.   #DEFINE SMTP_PORT    25
  1232.   #DEFINE http_PORT    80
  1233.   #DEFINE AF_INET       2
  1234.   #DEFINE SOCK_STREAM   1
  1235.   #DEFINE IPPROTO_TCP   6
  1236.   #DEFINE SOCKET_ERROR -1
  1237.   #DEFINE FD_READ       1
  1238.   #DEFINE crlf CHR(13)+CHR(10)
  1239.   * VALORES DE LA CLASE
  1240.   host     = ""
  1241.   IP       = ""
  1242.   Port     = 80
  1243.   hSocket  = 0
  1244.   cIn      = ''
  1245.   WaitForRead = 0
  1246.  
  1247.  
  1248.   * Inicializador de la clase
  1249.   PROCEDURE Init()
  1250.     THIS.decl
  1251.     IF WSAStartup(0x202, Repli(Chr(0),512)) <> 0
  1252.         * Fue imposible iniciar Winsock en este computador
  1253.         RETURN .F.
  1254.     ENDIF
  1255.     RETURN .T.
  1256.   ENDPROC
  1257.  
  1258.   * Destruir
  1259.   PROCEDURE Destroy
  1260.     = WSACleanup()
  1261.   ENDPROC
  1262.  
  1263.   * Asignar Host
  1264.   PROCEDURE Host_Assign( vNewVal )
  1265.     if empty(vNewVal)
  1266.       THIS.IP = ''
  1267.     else
  1268.       THIS.IP = THIS.GetIP(vNewVal)
  1269.     endif
  1270.     if not empty(THIS.IP)
  1271.       THIS.Host = vNewVal
  1272.     else
  1273.       THIS.Host = ''
  1274.     endif
  1275.   ENDPROC
  1276.  
  1277.   * Recuperar IP del host actual
  1278.   PROTECTED FUNCTION GetIP( pcHost )
  1279.   #DEFINE HOSTENT_SIZE 16
  1280.       LOCAL nStruct, nSize, cBuffer, nAddr, cIP
  1281.       nStruct = gethostbyname(pcHost)
  1282.       IF nStruct = 0
  1283.           RETURN ""
  1284.       ENDIF
  1285.       cBuffer = Repli(Chr(0), HOSTENT_SIZE)
  1286.       cIP = Repli(Chr(0), 4)
  1287.       = CopyMemory(@cBuffer, nStruct, HOSTENT_SIZE)
  1288.       = CopyMemory(@cIP, THIS.buf2dword(SUBS(cBuffer,13,4)),4)
  1289.       = CopyMemory(@cIP, THIS.buf2dword(cIP),4)
  1290.   RETURN inet_ntoa(THIS.buf2dword(cIP))
  1291.   ENDFUNC
  1292.  
  1293.   * Conectar
  1294.   PROTECTED FUNCTION Connect
  1295.     LOCAL cBuffer, cPort, cHost, lResult
  1296.     THIS.hSocket = socket(AF_INET, SOCK_STREAM, IPPROTO_TCP)
  1297.    
  1298.     IF THIS.hSocket = SOCKET_ERROR
  1299.         RETURN .F.
  1300.     ENDIF
  1301.    
  1302.     cPort = THIS.num2word(htons(THIS.Port))
  1303.     nHost = inet_addr(THIS.IP)
  1304.     cHost = THIS.num2dword(nHost)
  1305.     cBuffer = THIS.num2word(AF_INET) + cPort + cHost + Repli(Chr(0),8)
  1306.     lResult = (ws_connect(THIS.hSocket, @cBuffer, Len(cBuffer))=0)
  1307.   RETURN lResult
  1308.  
  1309.  
  1310.   * Realizar una solicitud via httpGet a un servidor remoto
  1311.   FUNCTION httpGet( pcServer, pcUrl )
  1312.     LOCAL lResult
  1313.     THIS.Host = pcServer
  1314.  
  1315.     IF THIS.Connect()
  1316.         * Ajustar los siguientes valores para indicar que es un cliente premium nativo.
  1317.         THIS.snd("GET "+pcURL+" http/1.0"+crlf)
  1318.         THIS.snd("Accept: */*"+crlf)
  1319.         THIS.snd("Accept-Language: en-us"+crlf)
  1320.         THIS.snd("Accept-Encoding: text/plain, deflate"+crlf)
  1321.         THIS.snd("User-Agent: Mozilla/4.0"+crlf)
  1322.         THIS.snd("Host: "+pcServer+crlf)
  1323.         THIS.snd("Pragma: no-cache"+crlf)
  1324.         THIS.snd(crlf,.t.) && End of headers
  1325.         *info=url encoded string
  1326.         lResult = .T.
  1327.     ELSE
  1328.         lResult = .F.
  1329.     ENDIF
  1330.     THIS.Disconnect()
  1331.   ENDFUNC
  1332.  
  1333.   * Realizar una solicitud via httpPost a un servidor remoto
  1334.   * considere que esta funcion recibe como parametros pcData e implementa un objeto de retorno poFdbk
  1335.   * este método no considera el envío de datos adjuntos como parte de la solicitud.
  1336.   * por ahora ne se implementa autorización.
  1337.   FUNCTION httpPost( pcServer, pcUrl, pcData, poFdbk )
  1338.     LOCAL lResult, lnLen, lnComplete, lcRemain, lcSnd
  1339.     THIS.Host = pcServer
  1340.  
  1341.     IF THIS.Connect()
  1342.         THIS.snd("POST "+pcURL+" http/1.0"+crlf)
  1343.         THIS.snd("Content-Type:application/x-www-form-urlencoded"+crlf)
  1344.         THIS.snd("Accept: */*"+crlf)
  1345.         THIS.snd("Accept-Language: en-us"+crlf)
  1346.         THIS.snd("Accept-Encoding: text/plain, deflate"+crlf)
  1347.         THIS.snd("User-Agent: Mozilla/4.0"+crlf)
  1348.         THIS.snd("Host: "+pcServer+crlf)
  1349.         lnLen = len(pcData)
  1350.         THIS.snd("Content-Length: "+tran(lnLen)+crlf)
  1351.         THIS.snd("Pragma: no-cache"+crlf)
  1352.         THIS.snd(crlf) && End of headers
  1353.         * Si tenemos un objeto de feedback proporcinarle respuesta
  1354.         if vartype(poFdbk)='O' and PEMStatus(poFdbk,'Feedback',5) ;
  1355.            and upper(PEMStatus(poFdbk,'Feedback',3))='METHOD'
  1356.           lcRemain   = pcData
  1357.           lnComplete = 0
  1358.           poFdbk.Feedback( 0 )
  1359.           do while len(lcRemain)>0
  1360.             lcSnd      = LEFT( lcRemain, 100 )
  1361.             lcRemain   = SUBSTR( lcRemain, 101 )
  1362.             THIS.snd(lcSnd)
  1363.             lnComplete = lnComplete+len(lcSnd)
  1364.             poFdbk.Feedback( lnComplete/lnLen*100 )
  1365.           enddo
  1366.           THIS.snd('',.t.)
  1367.         else && No hay objeto de feedback.
  1368.           THIS.snd(pcData,.t.)
  1369.         endif
  1370.         lResult = .T.
  1371.     ELSE
  1372.         lResult = .F.
  1373.     ENDIF
  1374.     THIS.Disconnect()
  1375.   ENDFUNC
  1376.  
  1377.   * método para enviar correo electrónico desde VFP
  1378.   FUNCTION SendMail( pcSender, pcRecipient, pcSubject, pcBody )
  1379.     LOCAL lResult
  1380.     IF THIS.Connect()
  1381.         THIS.snd("HELO", .T.)
  1382.         THIS.snd("MAIL FROM:<" + pcSender + ">", .T.)
  1383.         THIS.snd("RCPT TO:<" + pcRecipient + ">", .T.)
  1384.         THIS.snd("DATA", .T.)
  1385.         THIS.snd("From: " + pcSender)
  1386.         THIS.snd("To: " + pcRecipient)
  1387.         THIS.snd("Subject: " + pcSubject)
  1388.         THIS.snd("")
  1389.         THIS.snd(pcBody)
  1390.         THIS.snd(".", .T.)
  1391.         THIS.snd("QUIT", .T.)
  1392.         lResult = .T.
  1393.     ELSE
  1394.         = MessageB("Unable to connect to [" + THIS.Host +;
  1395.             "] on port " + LTRIM(STR(SMTP_PORT)) + ". ",;
  1396.             48, " Connection error")
  1397.         lResult = .F.
  1398.     ENDIF
  1399.     THIS.Disconnect()
  1400.   RETURN lResult
  1401.   ENDFUNC
  1402.  
  1403.   Function URLencode
  1404.   LPARAMETER pcInStr
  1405.   *  ' encode Percent signs
  1406.   *  '        Double Quotes
  1407.   *  '        CarriageReturn / LineFeeds
  1408.  
  1409.   LOCAL lcOut, lnI
  1410.     * StrTran is WAY faster than building the string in memory
  1411.     lcOut = StrTran(pcInStr, [%], '%25' )
  1412.     lcOut = StrTran(lcOut,   [+], '%2B' )
  1413.     lcOut = StrTran(lcOut,   [ ], '+'   )
  1414.     for lnI = 0 to 31
  1415.       lcOut = StrTran( lcOut, chr(lnI), '%' + Right( Transform(lnI,'@0'), 2 ) )
  1416.     endfor
  1417.     for lnI = 127 to 255
  1418.       lcOut = StrTran( lcOut, chr(lnI), '%' + Right( Transform(lnI,'@0'), 2 ) )
  1419.     endfor
  1420.  
  1421.     RETURN lcOut
  1422.  
  1423.   ENDFUNC
  1424.  
  1425.   FUNCTION Disconnect
  1426.     if THIS.hSocket<>SOCKET_ERROR
  1427.       = closesocket(THIS.hSocket)
  1428.     endif
  1429.     THIS.hSocket = SOCKET_ERROR
  1430.   ENDFUNC
  1431.  
  1432.   FUNCTION snd(cData, lResponse)
  1433.     LOCAL cBuffer, nResult, cResponse
  1434.     cBuffer = cData && + CrLf
  1435.     nResult = send(THIS.hSocket, @cBuffer, Len(cBuffer), 0)
  1436.     IF nResult = SOCKET_ERROR
  1437.         RETURN .F.
  1438.     ENDIF
  1439.     IF Not lResponse
  1440.         RETURN .T.
  1441.     ENDIF
  1442.  
  1443.     LOCAL hEventRead, nWait, cRead
  1444.     DO WHILE .T.
  1445.         * creating event, linking it to the socket and wait
  1446.         hEventRead = WSACreateEvent()
  1447.         = WSAEventSelect(THIS.hSocket, hEventRead, FD_READ)
  1448.  
  1449.         * 1000 milliseconds can be not enough
  1450.         THIS.WaitForRead = WSAWaitForMultipleEvents(1, @hEventRead, 0, 2000, 0)
  1451.         = WSACloseEvent(hEventRead)
  1452.  
  1453.         IF THIS.WaitForRead <> 0 && error or timeout
  1454.             EXIT
  1455.         ENDIF
  1456.        
  1457.         * reading data from connected socket
  1458.         THIS.cIn = THIS.cIn+THIS.Rd()
  1459.     ENDDO
  1460.   RETURN .T.
  1461.   ENDFUNC
  1462.  
  1463.   PROTECTED FUNCTION Rd
  1464.   #DEFINE READ_SIZE 16384
  1465.     LOCAL cRecv, nRecv, nFlags
  1466.     cRecv = Repli(Chr(0), READ_SIZE)
  1467.     nFlags = 0
  1468.     nRecv = recv(THIS.hSocket, @cRecv, READ_SIZE, nFlags)
  1469.     RETURN Iif(nRecv<=0, "", LEFT(cRecv, nRecv))
  1470.   ENDFUNC
  1471.  
  1472.   PROCEDURE decl
  1473.     DECLARE INTEGER gethostbyname IN ws2_32 STRING host
  1474.     DECLARE STRING inet_ntoa IN ws2_32 INTEGER in_addr
  1475.     DECLARE INTEGER socket IN ws2_32 INTEGER af, INTEGER tp, INTEGER pt
  1476.     DECLARE INTEGER closesocket IN ws2_32 INTEGER s
  1477.     DECLARE INTEGER WSACreateEvent IN ws2_32
  1478.     DECLARE INTEGER WSACloseEvent IN ws2_32 INTEGER hEvent
  1479.     DECLARE GetSystemTime IN kernel32 STRING @lpSystemTime
  1480.     DECLARE INTEGER inet_addr IN ws2_32 STRING cp
  1481.     DECLARE INTEGER htons IN ws2_32 INTEGER hostshort
  1482.     DECLARE INTEGER WSAStartup IN ws2_32 INTEGER wVerRq, STRING lpWSAData
  1483.     DECLARE INTEGER WSACleanup IN ws2_32
  1484.  
  1485.     DECLARE INTEGER connect IN ws2_32 AS ws_connect ;
  1486.         INTEGER s, STRING @sname, INTEGER namelen
  1487.  
  1488.     DECLARE INTEGER send IN ws2_32;
  1489.         INTEGER s, STRING @buf, INTEGER buflen, INTEGER flags
  1490.  
  1491.     DECLARE INTEGER recv IN ws2_32;
  1492.         INTEGER s, STRING @buf, INTEGER buflen, INTEGER flags
  1493.  
  1494.     DECLARE INTEGER WSAEventSelect IN ws2_32;
  1495.         INTEGER s, INTEGER hEventObject, INTEGER lNetworkEvents
  1496.  
  1497.     DECLARE INTEGER WSAWaitForMultipleEvents IN ws2_32;
  1498.         INTEGER cEvents, INTEGER @lphEvents, INTEGER fWaitAll,;
  1499.         INTEGER dwTimeout, INTEGER fAlertable
  1500.  
  1501.     DECLARE RtlMoveMemory IN kernel32 As CopyMemory;
  1502.         STRING @Dest, INTEGER Src, INTEGER nLength
  1503.   ENDPROC
  1504.  
  1505.   FUNCTION buf2dword(lcBuffer)
  1506.     RETURN Asc(SUBSTR(lcBuffer, 1,1)) + ;
  1507.         BitLShift(Asc(SUBSTR(lcBuffer, 2,1)), 8) +;
  1508.         BitLShift(Asc(SUBSTR(lcBuffer, 3,1)), 16) +;
  1509.         BitLShift(Asc(SUBSTR(lcBuffer, 4,1)), 24)
  1510.   ENDFUNC
  1511.  
  1512.   FUNCTION num2dword(lnValue)
  1513.   #DEFINE m0 256
  1514.   #DEFINE m1 65536
  1515.   #DEFINE m2 16777216
  1516.       IF lnValue < 0
  1517.           lnValue = 0x100000000 + lnValue
  1518.       ENDIF
  1519.       LOCAL b0, b1, b2, b3
  1520.       b3 = Int(lnValue/m2)
  1521.       b2 = Int((lnValue - b3*m2)/m1)
  1522.       b1 = Int((lnValue - b3*m2 - b2*m1)/m0)
  1523.       b0 = Mod(lnValue, m0)
  1524.   RETURN Chr(b0)+Chr(b1)+Chr(b2)+Chr(b3)
  1525.   ENDFUNC
  1526.  
  1527.   FUNCTION num2word(lnValue)
  1528.     RETURN Chr(MOD(m.lnValue,256)) + CHR(INT(m.lnValue/256))
  1529.   ENDFUNC
  1530. ENDDEFINE
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!