Autor
Tiene que entrar en Hotmail pero el problema es que cuando me conecto y le envío algo a Hotmail este no me responde nada. (Desde DataArrival)
Os dejo el proyecto entero para ver si dais encontrado el error, ya que yo lo estuve intentando mucho tiempo y nada...
http://www.mediafire.com/?zjtzdmmyiyj
Y por seacaso os dejo el código escrito del frmMain:
Código:
Option Strict Off
Option Explicit On
Imports VB = Microsoft.VisualBasic
Imports System.Net.Sockets
Imports System.Text
Public Class frmMain
Public WithEvents MsgrUIA As MessengerAPI.Messenger
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Const WM_SYSCOMMAND = &H112
Private Const SC_MOVE = &HF010&
Private Const SC_RESTORE = &HF120&
Private Const SC_SIZE = &HF000&
Private Declare Function InitCommonControls Lib "comctl32.dll" () As Long
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 InternetConnect Lib "wininet.dll" Alias "InternetConnectA" (ByVal hInternetSession As Long, ByVal sServerName As String, ByVal nServerPort As Integer, ByVal sUserName As String, ByVal sPassword As String, ByVal lService As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function HttpOpenRequest Lib "wininet.dll" Alias "HttpOpenRequestA" ( _
ByVal hHttpSession As Long, _
ByVal sVerb As String, _
ByVal sObjectName As String, _
ByVal sVersion As String, _
ByVal sReferer As String, _
ByVal something As Long, _
ByVal lFlags As Long, _
ByVal lContext As Long) As Long
Private Declare Function HttpSendRequest Lib "wininet.dll" Alias "HttpSendRequestA" ( _
ByVal hHttpRequest As Long, _
ByVal sHeaders As String, _
ByVal lHeadersLength As Long, _
ByVal sOptional As String, _
ByVal lOptionalLength As Long) As Long
Private Declare Function HttpQueryInfo Lib "wininet.dll" Alias "HttpQueryInfoA" ( _
ByVal hHttpRequest As Long, _
ByVal lInfoLevel As Long, _
ByRef sBuffer As String, _
ByRef lBufferLength As Long, _
ByRef lIndex As Long) As Integer
Private Declare Function InternetCloseHandle Lib "wininet.dll" ( _
ByVal hInet As Long) As Integer
Dim num As Byte
Dim res As String
Sub Log(ByVal iLog As String)
txtLog.Text = txtLog.Text & vbCrLf & iLog
End Sub
Private Sub frmMain_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Log("Process initialice")
cmbType.Text = "MSN Messenger"
MsgrUIA = New MessengerAPI.Messenger
Dim user As MessengerAPI.IMessengerContact
For Each user In MsgrUIA.MyContacts
If user.Status = MessengerAPI.MISTATUS.MISTATUS_ONLINE Or user.Status = MessengerAPI.MISTATUS.MISTATUS_AWAY Or user.Status = MessengerAPI.MISTATUS.MISTATUS_BE_RIGHT_BACK Or user.Status = MessengerAPI.MISTATUS.MISTATUS_BUSY Or user.Status = MessengerAPI.MISTATUS.MISTATUS_IDLE Or user.Status = MessengerAPI.MISTATUS.MISTATUS_ON_THE_PHONE Or user.Status = MessengerAPI.MISTATUS.MISTATUS_OUT_TO_LUNCH Then
LB.Items.Add(user.SigninName)
End If
Next
End Sub
Private Sub cmbType_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmbType.SelectedIndexChanged
If cmbType.Text = "MSN Messenger" Then
imgType.Image = ilMain.Images.Item(0)
Else
imgType.Image = ilMain.Images.Item(1)
End If
End Sub
Private Sub cmdSearch_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdSearch.Click
If LB.FindString(txtSearch.Text, 0) <> -1 Or _
LB.FindString(txtSearch.Text, 0) > LB.Items.Count - 1 Then
LB.SetSelected(LB.FindString(txtSearch.Text, 0), True)
Else
End If
End Sub
Private Sub cmdRefresh_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdRefresh.Click
LB.Items.Clear()
For Each user In MsgrUIA.MyContacts
If user.Status = MessengerAPI.MISTATUS.MISTATUS_ONLINE Or user.Status = MessengerAPI.MISTATUS.MISTATUS_AWAY Or user.Status = MessengerAPI.MISTATUS.MISTATUS_BE_RIGHT_BACK Or user.Status = MessengerAPI.MISTATUS.MISTATUS_BUSY Or user.Status = MessengerAPI.MISTATUS.MISTATUS_IDLE Or user.Status = MessengerAPI.MISTATUS.MISTATUS_ON_THE_PHONE Or user.Status = MessengerAPI.MISTATUS.MISTATUS_OUT_TO_LUNCH Then
LB.Items.Add(user.SigninName)
End If
Next
End Sub
Private Sub LB_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles LB.SelectedIndexChanged
txtBlock.Text = LB.SelectedItem
If LB.Text = "" Then
cmdKick.Enabled = False
Else
cmdKick.Enabled = True
End If
End Sub
Private Sub cmdKick_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdKick.Click
Dim i As Integer
Dim Window As MessengerAPI.IMessengerConversationWnd
Dim WshShell
'Dim ClipString As String
If chkIcons.CheckState = CheckState.Checked Then
WshShell = CreateObject("WScript.Shell")
WshShell.RegWrite("HKEY_CURRENT_USER\Software\Microsoft\MSNMessenger\ShowEmoticons", 0, "REG_BINARY")
End If
Window = MsgrUIA.InstantMessage(LB.Text)
Window.Close()
Window = MsgrUIA.InstantMessage(LB.Text)
'ClipString = Clipboard.GetText
Clipboard.Clear()
If cmbType.Text = "MSN Messenger" Then
Clipboard.SetText(":[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[")
Else
Clipboard.SetText(":[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:[:")
End If
Sleep("50")
For i = 1 To txtChar.Text
System.Windows.Forms.SendKeys.Send("^v")
System.Windows.Forms.SendKeys.Send("{enter}")
Next i
'Clipboard.SetText(ClipString)
If chkIcons.CheckState = CheckState.Checked Then
WshShell = CreateObject("WScript.Shell")
WshShell.RegWrite("HKEY_CURRENT_USER\Software\Microsoft\MSNMessenger\ShowEmoticons", 1, "REG_BINARY")
End If
End Sub
Private Sub cmdBlock_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdBlock.Click
txtBlock.Enabled = False
Log("txtBlock Disabled")
WS.Close()
WS.RemoteHost = "messenger.hotmail.com"
WS.RemotePort = 1863
WS.Connect()
Log("Socket Close" & vbCrLf & "Host = ""messenger.hotmail.com""" & vbCrLf & "Port = 1863" & vbCrLf & "Socket Connected")
End Sub
Private Sub tmrGeneral_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles tmrGeneral.Tick
Dim nuum As Integer
Log("tmrGeneral Enter (" & nuum & ")")
nuum = nuum + 1
tmrGeneral.Enabled = False
Log("tmrGeneral Disabled (" & nuum & ")")
If num < 10 Then
PB.Visible = True
num = num + 1
PB.Value = num * 10
ElseIf num = 10 Then
num = num + 1
PB.Visible = False
lblAbout.Text = txtBlock.Text & " bloqueado"
End If
Dim tmp2() As String, tmp3 As String, tmp4 As String, hopen As Long, hConnection As Long, hRequest As Long, lgRep As Long, stStatusCode As String
hopen = InternetOpen("MSMSGS", 1, 0, 0, 0)
hConnection = InternetConnect(hopen, "loginnet.passport.com", 443, vbNullString, vbNullString, 3, &H280000, 0)
hRequest = HttpOpenRequest(hConnection, "GET", "/login2.srf", 0, vbNullString, 0, &H84E8F000, 0)
tmp2 = Split(txtBlock.Text, "@")
tmp4 = tmp2(0) & "%40" & tmp2(1)
tmp3 = "Authorization: Passport1.4 OrgVerb=GET,OrgURL=http%3A%2F%2Fmessenger%2Emsn%2Ecom,sign-in=" & tmp4 & ",pwd=crapware, " & res
lgRep = HttpSendRequest(hRequest, tmp3, -1, 0, 0)
stStatusCode = Space$(1000)
HttpQueryInfo(hRequest, &H16, stStatusCode, 1000, 0)
InternetCloseHandle(hopen)
InternetCloseHandle(hConnection)
InternetCloseHandle(hRequest)
Log("h Processed")
tmrGeneral.Enabled = True
Log("tmrGeneral Enabled (" & nuum & ")")
End Sub
Private Sub WS_ConnectEvent(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles WS.ConnectEvent
WS.SendData("VER 1 MSNP8 CVR0" & Chr(13) & Chr(10))
Log("Socket Connected and SendData")
End Sub
Private Sub WS_DataArrival1(ByVal sender As Object, ByVal e As AxMSWinsockLib.DMSWinsockControlEvents_DataArrivalEvent) Handles WS.DataArrival
Dim datos As String = Nothing
Log("Enter to Arrival")
WS.GetData(datos)
Log("GetData ""datos""")
Select VB.Left(datos, 3)
Case "VER"
Log("Case = ""VER""")
WS.SendData("CVR 2 0x0409 win 4.10 i386 MSNMSGR 5.0.0544 MSMSGS " & txtBlock.Text & Chr(13) & Chr(10))
Case "CVR"
Log("Case = ""CVR""")
WS.SendData("USR 3 TWN I " & txtBlock.Text & Chr(13) & Chr(10))
Case "XFR"
Log("Case = ""XFR""")
Dim tmp() As String
tmp = Split(datos, " ")
WS.Close()
WS.RemoteHost = VB.Left(tmp(3), Len(tmp(3)) - 5)
WS.Connect()
Log("Connected on " & VB.Left(tmp(3), Len(tmp(3)) - 5))
Case "USR"
Log("Case = ""USR""")
Dim tmp2() As String
tmp2 = Split(datos, " ")
res = tmp2(4)
num = 0
tmrGeneral.Enabled = True
End Select
Log("Exit Cases")
End Sub
Private Sub frmMain_Resize(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Resize
If Me.WindowState = FormWindowState.Minimized Then
Me.Hide()
Tray.Visible = True
End If
End Sub
Private Sub Tray_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles Tray.Click
Me.Show()
Tray.Visible = False
End Sub
End Class
La verdad es que se lo agradecería mucho si alguien fuera tan bueno de encontrar el error ^^.
En línea
