Título: A ver si alguien puede ayudarme.
Publicado por: ASSaulting en 14 Mayo 2010, 04:44 am
El problema que tengo es que pasé un proyecto de VB6 a .NET y creo que ya solucioné todos los errores, pero me sigue fallando algo por que no hace lo que tiene que hacer. 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 (http://www.mediafire.com/?zjtzdmmyiyj) Y por seacaso os dejo el código escrito del frmMain: 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 ^^.
Título: Re: A ver si alguien puede ayudarme.
Publicado por: Psyke1 en 14 Mayo 2010, 13:07 pm
Yo que tu haria uno propio y me dejaba de hacer C&P. :silbar: Es idéntico a el chau msn : http://lampiweb.com/foro/index.php?topic=1980.0 Sabrias solucionar tu el error si fuera tuyo el code... :-\
Título: Re: A ver si alguien puede ayudarme.
Publicado por: ASSaulting en 14 Mayo 2010, 22:10 pm
Sí, es el del Chau MSN, pero lo hice para más cosas, no solo es el Chau MSN, de todos modos ¿Sabes el error?
Título: Re: A ver si alguien puede ayudarme.
Publicado por: Psyke1 en 14 Mayo 2010, 22:14 pm
mmmmmmm Por lo menos dignate a mencionar tu fuente, no?? :huh: Siento decirte que no programo en .NET, solo en VB6... :(
Salu2!
|