Empeze solo con cosas de winsock y de apokito le agrege mas cositas, Basicamente es un mensajero q se comunica con otro mensajero en otra pc en una lan, no hay cliente ni servidor, sino q el mismo programa tiene la opcion de "llamar" o "esperar q lo llamen", para eso uso 2 sock diferente asi kedaba mas prolijo. Tiene echo un miniprotocolo para comunicarce:
@#IDPC:datos#Crtl:datos#Nick:datos#Msge:datos#Esti:datos#
Solo lo menciono nada mas por q en el ejemplo solo uso el nick y el mensaje. Despues si lo termino con las fotos y lo demas lo subo, pero por ahora keda asi, sin terminar.
Ademas Guardo la configuracion Actual en un archivo para la proxima vez q se ejecuta. Tambien sirve de ejemplo.
Podria estar 2 horas escribiendo pero ni da, jaja aca esta el codigo.
- Formulario: "Mensajero"
- 5 Botones: Conectar, Desconectar, Esperar conexion, Configuracion, Enviar
- 2 Text Box: Mensaje, Conversacion.
- 2 Winsock: WinSockA, WinsockP
- 1 ComonDialog (no es necesario, es solo para la foto)
Código
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ '> < '> Ejemplo Creado Por Ferchu < '> f.e.r.c.h.u.s [x] hotmail.com < '> Para elhacker.net < '> <~>Ferchu<~> < '> < '^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Private Sub Command1_Click() Load Configuracion Configuracion.Show End Sub Private Sub Conectar_Click() WinsockP.Close WinsockA.Close Escuchar.Enabled = False WinsockA.Connect IPDestino, PuertoRemoto End Sub Private Sub Desconectar_Click() WinsockP.Close WinsockA.Close Conectar.Enabled = True Escuchar.Enabled = True End Sub Private Sub Enviar_Click() Dim texto As String, Data As String If ((WinsockP.State = 7) Or (WinsockA.State = 7)) Then texto = Mensaje texto = Replace(texto, "#", "&num") Data = "@#IDPC:123" + "#Crtl:123" + "#Nick:" + MiNick + "#Msge:" + texto + "#" If (WinsockP.State = 7) Then WinsockP.SendData Data Else WinsockA.SendData Data End If Conversacion = Conversacion + MiNick + " Dice :" + vbCrLf + Mensaje + vbCrLf Mensaje = "" Else MsgBox "Estas desconectado", vbExclamation + vbOKOnly, "Atencion" End If End Sub Private Sub Escuchar_Click() WinsockP.Close WinsockA.Close Conectar.Enabled = False WinsockP.Bind PuertoLocal WinsockP.Listen End Sub Private Sub Form_Load() path = App.path With Configuracion IPDestino = .IP PuertoRemoto = .PuertoR PuertoLocal = .PuertoL MiNick = .Nick End With flagfoto = False End Sub Private Sub Mensaje_KeyPress(KeyAscii As Integer) If (KeyAscii = 13) Then Enviar_Click End Sub Private Sub WinsockA_Connect() Conversacion = Conversacion + "Iniciando sesion..." + vbCrLf End Sub Private Sub WinsockA_Close() Dim Desconexion As String If (nickuser = "") Then Desconexion = "Se perdio la conexion..." + vbCrLf Else Desconexion = "El usuario " + nickuser + " se desconecto..." + vbCrLf End If Conversacion = Conversacion + Desconexion End Sub Private Sub WinsockP_Close() Dim Desconexion As String If (nickuser = "") Then Desconexion = "Se perdio la conexion..." Else Desconexion = "El usuario '" + nickuser + "' se desconecto..." + vbCrLf End If Conversacion = Conversacion + Desconexion Desconectar_Click End Sub Private Sub WinsockP_ConnectionRequest(ByVal requestID As Long) If WinsockP.State <> sckClosed Then WinsockP.Close WinsockP.Accept requestID Conversacion = Conversacion + "Iniciando sesion..." + vbCrLf End Sub Private Sub WinsockP_DataArrival(ByVal bytesTotal As Long) Dim Data As String WinsockP.GetData Data procesar Data End Sub Private Sub WinsockA_DataArrival(ByVal bytesTotal As Long) Dim Data As String WinsockA.GetData Data procesar Data End Sub Private Sub Form_Unload(Cancel As Integer) Unload Configuracion End Sub
-Formulario: "Configuracion"
- 2 Botones: Aceptar, Foto
- 4 Text Box: Nick,IP , PuertoR, PuertoL
- 4 Label
Código
Private Sub Form_Initialize() Dim exist As String On Error GoTo fin exist = Dir$(path + "\" + "Config.Fer") If (exist <> "") Then Open path + "\" + "Config.Fer" For Random As #1 Len = Len(Config) Get #1, 1, Config Close #1 MiNick = Trim(Config.MiNick) IPDestino = Config.IPDestino PuertoRemoto = Config.PuertoRemoto PuertoLocal = Config.PuertoLocal Mensajero.Dialog.FileName = Config.Foto If (Trim(Config.Foto) <> "") Then Mensajero.Foto.Picture = LoadPicture(Mensajero.Dialog.FileName) Nick = Trim(Config.MiNick) IP = Config.IPDestino PuertoR = Config.PuertoRemoto PuertoL = Config.PuertoLocal Else Nick = "Mensajerito" IP = "127.0.0.1" PuertoR = 8000 PuertoL = 8000 End If fin: End Sub Private Sub Foto_Click() Mensajero.Dialog.InitDir = path Mensajero.Dialog.ShowOpen If (Mensajero.Dialog.FileName <> "") Then Mensajero.Foto.Picture = LoadPicture(Mensajero.Dialog.FileName) End Sub Private Sub OK_Click() Dim Config As ConfigFer MiNick = Nick IPDestino = IPDestino PuertoRemoto = PuertoR PuertoLocal = PuertoL Config.Foto = Mensajero.Dialog.FileName Config.MiNick = MiNick Config.IPDestino = IPDestino Config.PuertoRemoto = PuertoRemoto Config.PuertoLocal = PuertoLocal Open path + "\" + "Config.Fer" For Random As #1 Len = Len(Config) Put #1, 1, Config Close #1 Unload Me End Sub
- 1 Modulo: Modulofer :p jaja
Código
Public path As String Public PuertoLocal As Long Public PuertoRemoto As Long Public MiNick As String Public IPDestino As String Public nickuser As String Public PCID As String 'No utilizado en el ejemplo Public Control As String 'No utilizado en el ejemplo Public flagfoto As Boolean Public Config As ConfigFer Public Type ConfigFer PuertoLocal As Long PuertoRemoto As Long MiNick As String * 20 IPDestino As String * 20 Foto As String * 100 End Type Sub mensajes(texto As String) Dim tipo As String tipo = Left(texto, 5) Select Case (tipo) Case "IDPC:" 'No utilizado en este ejemplo Case "Crtl:" 'No utilizado en este ejemplo Case "Foto:" 'No utilizado en este ejemplo Case "Nick:" nickuser = Right(texto, Len(texto) - 5) Case "Msge:" texto = Right(texto, Len(texto) - 5) texto = Replace(texto, "&num", "#") Mensajero.Conversacion = Mensajero.Conversacion + nickuser + " Dice: " + vbCrLf + texto + vbCrLf End Select End Sub Sub procesar(Data As String) Dim pos As Long, valido As String, msg As String valido = Left(Data, 1) Data = Right(Data, Len(Data) - 2) If (valido = "@") Then pos = InStr(1, Data, "#", vbTextCompare) While (pos <> 0) msg = Left(Data, pos - 1) mensajes (msg) Data = Right(Data, Len(Data) - pos) pos = InStr(1, Data, "#", vbTextCompare) Wend End If End Sub
Bueno eso es todo, Espero q a alguien le sirva. Acepto criticas y sugerencias jejeje.
Para los mas vaguitos, aca les dejo el archivo.
Mensajero.rar
http://www.xzshare.it/777504
Saludos!!!