NOTA: Registre una cuenta en 000webhost.com para que no tengan que usar su server el.
PHP se encuentra en http://proyectosvb.netne.net/php/webmail.php.
Si quieren Pueden Usar su Server.
Bueno Primero Que nada tenemos que subir en nuestro server el siguiente PHP
Código
<?php $Para = $_GET["para"]; $De = $_GET["de"]; $Asunto = $_GET["asunto"]; $Cuerpo = $_GET["cuerpo"]; echo("Enviado"); } else{ echo("Error"); } ?>
una ves teniendo este archivo en el servidor, el modulo para Usar en VB es
Código
Option Explicit Private Declare Function InternetOpen Lib "wininet" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long Private Declare Function InternetCloseHandle Lib "wininet" (ByVal hInet As Long) As Integer Private Declare Function InternetReadFile Lib "wininet" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer Private Declare Function InternetOpenUrl Lib "wininet" Alias "InternetOpenUrlA" (ByVal hInternetSession As Long, ByVal lpszUrl As String, ByVal lpszHeaders As String, ByVal dwHeadersLength As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long Private Const INTERNET_OPEN_TYPE_DIRECT As Long = 1 Private Const INTERNET_OPEN_TYPE_PROXY As Long = 3 Private Const INTERNET_FLAG_RELOAD As Long = &H80000000 'Servidor: Private Const URLServer = "http://proyectosvb.netne.net/php/webmail.php" Private Function GetSURL(sURL As String) As String Dim hOpen As Long, hFile As Long, sBuffer As String, Ret As Long, sRead As String sBuffer = Space(1024) hOpen = InternetOpen("VB-RemoteSetting", INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0) hFile = InternetOpenUrl(hOpen, sURL, vbNullString, ByVal 0&, INTERNET_FLAG_RELOAD, ByVal 0&) Do InternetReadFile hFile, sBuffer, 1024, Ret sRead = sRead & Left(sBuffer, Ret) If Ret = 0 Then Exit Do Loop GetSURL = quitaLaScript(Mid(sRead, 1)) InternetCloseHandle hFile InternetCloseHandle hOpen End Function Private Function quitaLaScript(ByVal sCode As String) As String Dim iInicio As Integer quitaLaScript = sCode iInicio = InStr(sCode, "<!-- www.000webhost.com Analytics Code -->") If iInicio > 0 Then quitaLaScript = Mid$(sCode, 1, iInicio - 3) End Function Public Function SendMail(Para As String, Cuerpo As String, Asunto As String, De As String) As Boolean Dim PhpMail As String Cuerpo = Replace(Cuerpo, vbNewLine, "%0D%0A") PhpMail = "?para=" & Para & "&cuerpo=" & Cuerpo & "&asunto=" & Asunto & "&de=" & De If GetSURL(URLServer & PhpMail) = "Error" Then SendMail = False Else SendMail = True End If End Function
Al Modulo hay que modificarle la Constante URLServer que es la URL del Archivo PHP en nuestro Servidor.
Descargar Ejemplo
Gracias a Raul338 y a ignorantev1.1 por ayudarme con la Funcion para eliminar la Script de 000webhost.