Mensajes

Si puedes, en el ejemplo seria como tener varias salas de chat generales...

En el ejemplo que te pase no hace mucho esta lo que quieres hacer, al menos algo parecido, hablamos de un chat multi-usuarios con posibilidad de mensajes privados estre usuarios, lo que tu llamas salas (conexion entre 2 o mas clientes independiente de los demas clientes conectados al servidor) es lo mismo que el sistema de whispers (chat privados) que usan en el ejemplo.

Un cliente le indica al servidor que quiere empezar un chat privado con otro usuario (independiente del chat general), para esto el servidor necesita saber con que usuario quiere empezar el chat y de este modo poder redirigir los mensajes de un cliente a otro, siendo el servidor un intermedio de comunicacion. Tal y como te comento el usuario @noalg en este caso es una comunicacion del tipo (cliente <-> servidor <-> cliente).

En el ejemplo, cada cliente ya tiene la lista de usuarios que estan conectados al sevidor, por lo que el usuario selecciona con quien quiere empezar el chat privado y le envia al servidor el nick del usuario y el mensaje que quiere enviarle.. El servidor agarra estos datos, busca en que sock esta conectado el usuario con el nick especificado y redirige el mensaje hacia ese sock...

Cliente1 -> Servidor = ChatPrivado(NickCliente1,NickCliente2,Mensaje)
Servidor Analiza el paquete y busca en que sock esta conectado NickCliente2 cuando lo encuentra entonces redirige los otros 2 datos, que son el NickCliente1 y el mensaje...
Servidor -> Cliente2 = ChatPrivadoRecibido(NickCliente1,Mensaje)

Sabes este ejemplo te ayudara mucho: http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=60099&lngWId=1

Y asi:

Código (vb) [Seleccionar] Expandir


Option Explicit

Public MyBytePos()        As Long
Public MyByteArray()      As Byte

Public Const StrByteArray As String = "255,254,253,0,252,0,0,0,251,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,250,0,0,0,0,0,0," & _
                                     "0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,249,0," & _
                                     "0,0,3,4,248,3,0,247,246,5,6,2,245,244,5,6,243,242,7,241,8,240,9,10,239,9,11,12,8,238,11," & _
                                     "13,13,10,237,8,236,14,8,9,235,13,8,7,13,8,7,234,233,8,12,10,232,14,231,15,15,230,229,0,0,0," & _
                                     "0,0,0,0,228,227,226,16,5,2,17,18,5,2,17,18,5,2,17,18,225,224,4,18,223,2,17,18,222,19,18," & _
                                     "18,20,2,17,18,21,22,221,18,220,2,17,18,21,22,219,18,23,2,17,18,5,2,218,18,16,2,17,18,21,22," & _
                                     "217,18,19,2,17,18,21,22,216,218,23,2,17,18,21,22,215,18,20,2,17"
                                     
Public MaxArray           As Integer

Public Sub ConfigArray()

    Dim I              As Integer
    Dim Pos            As Double
    Dim NewPos         As Double
    Dim SplitOneTime() As String

    SplitOneTime = Split(StrByteArray, ",")

    MaxArray = UBound(SplitOneTime)
   
    ReDim MyBytePos(0 To MaxArray)
    ReDim MyByteArray(0 To MaxArray)

    Pos = 1

    For I = 0 To MaxArray

        MyByteArray(I) = CByte(SplitOneTime(I))
       
        If I = 0 Then

            MyBytePos(I) = 1

        Else
       
            MyBytePos(I) = (MyBytePos(I - 1) + Len(SplitOneTime(I - 1))) + 1
       
        End If

    Next I
   
    'MsgBox MyBytePos(5) ' = 19
    'MsgBox MyBytePos(40) ' = 93

End Sub

Public Sub Stuff()

    Dim I             As Integer
    Dim CurrentByte   As Byte
    Dim found         As Double
    Dim CurrentPos    As Double
    Dim NextPos       As Double
    Dim FirstPattern  As String
    Dim SecondPattern As String

    For I = 0 To MaxArray

        'Ejemplo, index 5 -> 255,254,253,0,252,0,0,0,251,0,0,0,1,1,0,0,0

        CurrentByte = MyByteArray(I)

        If I = 103 Then

            Stop
           
            CurrentPos = MyBytePos(I)

            NextPos = MyBytePos(I + 1)

            found = InStr(NextPos, StrByteArray, CurrentByte)

            FirstPattern = Mid(StrByteArray, CurrentPos, found - CurrentPos) '= "13,8,7,"
            SecondPattern = Mid(StrByteArray, found, found - CurrentPos) '= "13,8,7,"

            MsgBox StrComp(FirstPattern, SecondPattern) = 0

        End If

    Next I

End Sub


Bueno he probado el codigo del amigo Hades y no me ha funcionado muy bien, asi que lo modifique un poco para mejorarlo:

Código (vb) [Seleccionar] Expandir

Option Explicit

Dim Flag As Boolean
Dim FileSize As Long

Private Sub Command1_Click()

    Wk.Connect "www.snarkles.net", 80    'Conectamos al host

End Sub

Private Sub Command2_Click()

    ' Hacemos la peticion del archivo ubicado en la carpeta scripts/sneak/sneak-1.27.zip

    Wk.SendData "GET /scripts/sneak/sneak-1.27.zip HTTP/1.1" & vbCrLf & "Host: www.snarkles.net" & vbCrLf & "Connection: keep-alive" & vbCrLf & vbCrLf

End Sub

Private Sub Wk_Connect()
   
    Debug.Print "Conectado..."
   
End Sub

Private Sub Wk_DataArrival(ByVal bytesTotal As Long)
   
    Dim strData   As String
    Dim Archivo   As String
    Dim Headers() As String

    Wk.GetData strData

    If InStr(1, strData, vbCrLf & vbCrLf) <> 0 And Flag = False Then      'Si en la primera peticion se nos envia las cabeceras del servidor que indican que todo va bien, entonces dividimos lo que nos envia en dos partes, la primera que son las cabeceras del servidor, y la segunda que es el archivo

        Flag = True
       
        Headers = Split(strData, vbCrLf & vbCrLf, 2)

        FileSize = CLng(Split(Mid$(strData, InStr(1, LCase$(strData), LCase$("Content-Length: ")) + Len("Content-Length: ")), vbCrLf)(0)) ' Extraemos la el tamaño del archivo del header
       
        Archivo = Headers(1)     'Es la parte de la imagen, sin las cabeceras del servidor

    Else

        Archivo = Archivo & strData       'Si no se estan enviando las cabeceras, entonces asignamos a archiv2 el valor de archivo. Recordamos que el servidor se conecta varias veces a nosotros para enviarnos el contenido del archivo.
       
        If Len(Archivo) = FileSize Then

            Open App.Path & "\snarkles.zip" For Binary Access Write As #1      'Abrimos el archivo snarkles.zip, puede ser cualquier otro tipo de archivo, en modo binario

            Put #1, , Archivo       'escribimos el contenido al final del archivo del valor que nos ha enviado el servidor

            Close #1
           
            Flag = False
       
        End If
       
        MsgBox "Descarga Completa..."
       
    End If

End Sub

He modificado un poco el source y agregue un archivo Leeme.txt, donde explica un poco el funcionamiento del programa y un ejemplo de como usarlo. Aqui esta el source resubido: http://www.multiupload.nl/YI6IVZ4T42 espero que les ayude

Nota: Deben modificar el archivo config.ini y agregar la URL del servidor donde alojaran sus archivos.

Aqui un video de como podrian utilizarlo:

[youtube=640,360]GxqwSBEcudY[/youtube]

Saludos ^^,

Bueno, a partir de 9 cifras se hace un poco lento el calculo asi que solo calcule hasta 8 cifras, aqui mi codigo:

Código (vb) [Seleccionar] Expandir

Public Function PE4_Dark(Optional ByVal lCifras As Long = 3) As Double
   
   Dim A   As Double
   Dim B   As Double
   Dim Min As Double
   Dim Max As Double
   Dim Tmp As Double

   If lCifras < 2 Then Exit Function
   
   Min = 10 * (10 ^ (lCifras - 2)) * 9
   Max = 10 * (10 ^ (lCifras - 1)) - 1

   For A = Max To Min Step -2
       
       For B = Max To Min Step -2

           Tmp = A * B
           
           If Tmp = InvNumber(Tmp) Then
               
               PE4_Dark = Tmp
               
               Exit Function
               
           End If

       Next B

   Next A
   
End Function

Public Function InvNumber(ByVal Number As Double) As Double

   Dim A As Double
   Dim C As Integer
   
   While Number > 0
       
       A = (Number / 10)
       
       Number = Int(A)
       
       C = (A - Number) * 10
       
       InvNumber = (InvNumber * 10) + C
       
   Wend
   
End Function

Salidas:

Código [Seleccionar] Expandir

PE4_Dark(2) = ( 99 x 91 ) = 9.009
PE4_Dark(3) = ( 993 x 913 ) = 906.609
PE4_Dark(4) = ( 9999 x 9901 ) = 99.000.099
PE4_Dark(5) = ( 99979 x 99681 ) = 9.966.006.699
PE4_Dark(6) = ( 999999 x 999001 ) = 999.000.000.999
PE4_Dark(7) = ( 9999979 x 9467731 ) = 94.677.111.177.649
PE4_Dark(8) = ( 99999999 x 90063991 ) = 9.006.399.009.936.009

Bueno no creo que sea el mas rapido pero al menos da el resultado correcto xD

Código (vb) [Seleccionar] Expandir

Public Function ProyectEuler3_ByDark(Optional ByVal lNumber As Double = 600851475143#) As Double
   
   Dim N As Double
   Dim A As Double
   Dim B As Double

   Do
       
       N = N + 1
       
       A = lNumber / N
       B = Fix(lNumber / N)

       If A - B = 0 Then
       
           lNumber = B
           ProyectEuler3_ByDark = N
           N = 1
       
       End If
   
   Loop Until lNumber = 1
   
End Function

Pero a que te refieres con el inicio de sesion, con con el aspecto visual o el codigo para hacer login y eso?

Sabes este ejemplo te ayudara mucho: http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=60099&lngWId=1

La diferencia del tuyo Elemental Code al mio es que el mio actualiza no solo la app principal, si no tambien archivos que son necesarios para la aplicacion (Como imagenes externas, documentos de texto, etc...)