Bueno como dice el titulo quiero saber esto pero este es mi duda concreta:
Estoy creando un Chat en vb 6.0 la cual conta con conexión por winsock es multiusuarios
Puedes chatar en salas distintas
puedes crear salas
puedes ver los usuarios conectados a la sala
Puedes crear salas
Mandar mensajes privados
ETC..
El punto es cuando creo la sala hay un listbox la cual quiero agregarle los usuarios que crearon la sala & ip del que creo la sala & el puerto , espero me ayuden abajo les dejare imagenes y el code
Garcias por Adelantado!:
Capturas
[IMG=http://img801.imageshack.us/img801/1121/68668029.jpg][/IMG]
Aqui Completo el Code Que Uso :
Las descripciones estan en Ingles por que asi me gusta mas ... espero que lo entiendan y me ayuden a agregar esto no allo la forma de hacerlo
Código:
Option Explicit
'Default port to be used when establishing connections.
Const DEFAULT_PORT = 1000
'INI file to be used by the program.
Const INI_FILE = "manychat.ini"
'Sometimes parameters are sent along with the commands that are sent between computers.
'All parameters will be formatted to be exactly PARAM_LEN characters long to simplify the parsing of commands by the receiving computer(s).
Const PARAM_LEN = 10
'Used to indicate that a connection is really yourself.
'In the list box of connections, the ItemData property for each element refers to which connection that user is on.
'The first element will be for the server, and this Const will define it as the server.
Const SELF = -1
'Constants used to define codes used by the Winsock engine.
'These codes determine what each command sent is being used for.
Const SCK_CODE_CHANGE_NAME = "[Change Name]"
Const SCK_CODE_CLEAR_DRAW = "[Clear Draw]"
Const SCK_CODE_DISCONNECTED = "[Disconnected]"
Const SCK_CODE_JOINED = "[Joined]"
Const SCK_CODE_KICKED = "[Kicked]"
Const SCK_CODE_LINE = "[Line]"
Const SCK_CODE_MESSAGE = "[Message]"
Const SCK_CODE_NEW_NAME_LIST = "[NEW NAME LIST]"
Const SCK_CODE_PEOPLE = "[People]"
Const SCK_CODE_PRIVATE_MESSAGE = "[Private Message]"
'This is a collection of commands and data to be sent to other computers, either the server (if you have connected to one) or to all connected computers (if you are the server).
Dim mSendList As New Collection
'This is a collection of commands and data that specifies where to send the items in mSendList.
'Each item in mSendList has an associated item in mSendTo which says to which computer the information in mSendList is to be sent.
Dim mSendTo As New Collection
'These are used in tracking where your mouse is when drawing pictures.
Dim miX As Integer, miY As Integer
'Stores number of Winsock controls loaded.
Dim miNumConnections As Integer
'Stores whether or not you are the server.
Dim mbServer As Boolean
Public Function sFormatSend(vData) As String
'Format data to send.
'Make it exactly PARAM_LEN chars long.
sFormatSend = Format(vData, String(PARAM_LEN, "0"))
'If it is (PARAM_LEN + 1) chars long, that means there is a negative sign.
'So format it one character shorter.
If Len(sFormatSend) = PARAM_LEN + 1 Then
sFormatSend = Format(vData, String(PARAM_LEN - 1, "0"))
End If
End Function
Public Sub SendToAllButOriginator(vsData As String, viConnection As Integer)
'Send vsData to all connections except viConnection (the originator of the data).
Dim i As Integer
'Cycle through connections and send data to each open connection except viConnection.
For i = 1 To miNumConnections
If i <> viConnection And frmMain.sckConnection(i).State = sckConnected Then
SendToPerson vsData, i
End If
Next i
End Sub
Public Sub ProcessData(vsString As String, viConnection As Integer)
'This procedure processes data received from either the server or from connections to the server.
'vsString = the command string being processed
'viConnection = the connection from which the command string was received
Dim i As Integer
Dim sCommand As String
Dim sInstruction As String
Dim sData As String
Dim bTemp As Boolean
Dim iCount As Integer
Dim iUser As Integer
'Separate commands may be received together so each command is followed by a carriage return.
'So as long as a carriage return is found in the data stream, there must be a command in it so continue processing data.
Do While InStr(1, vsString, vbCrLf)
'Store in sCommand the part of the data stream that contains the first command.
sCommand = Mid(vsString, 1, InStr(1, vsString, vbCrLf) - 1)
'Show the received command in the tutorial section.
If viConnection = SELF Then
End If
'Each command contains an instruction such as [Message] or [Disconnect].
'Some commands also contain parameters.
'Here the instruction part of the command is stored in sInstruction and the rest is stored in sData.
sInstruction = Mid(sCommand, 1, InStr(1, sCommand, "]"))
sData = Mid(sCommand, InStr(1, sCommand, "]") + 1, Len(sCommand))
'Branch depending upon the instruction.
Select Case sInstruction
Case SCK_CODE_CHANGE_NAME
'This command is sent by a connecting user when they change their name in their Name text box. (Only the server will receive such a command.)
'Update their name in the name list.
ChangeAddName viConnection, sData
'Refresh the name list on all connected computers.
SendPeopleList
Case SCK_CODE_CLEAR_DRAW
'This command is sent when someone presses the Clear button to clear the picture box.
'Clear the picture box.
picDraw.Cls
'For each open connection, send the command to clear the picture box.
'(This is done only by the server.)
If mbServer Then
SendToAllButOriginator SCK_CODE_CLEAR_DRAW, viConnection
End If
Case SCK_CODE_DISCONNECTED
'This command is received when the server notifies someone that someone else has disconnected.
'Update the status.
UpdateStatus sConnectionName(sParam(sData, 1)) & " desconectado."
'Reset their name in the name list.
RemoveName sParam(sData, 1)
Case SCK_CODE_JOINED
'This command is sent to the server when someone joins, notifying the server of the name of the person connecting.
'Update the status.
UpdateStatus sData & " ingresando."
'If you are the server...
If mbServer Then
'Notify all other connections that someone has joined and send the name of the new connection.
SendToAll SCK_CODE_JOINED & sData, False
'Add name to name list.
AddName viConnection, sData
'Refresh each connection's name list.
SendPeopleList
End If
Case SCK_CODE_KICKED
'This command is sent by the server notifying connections that someone was kicked.
'Update the status.
UpdateStatus "Ha sido sacado de la sala " & sConnectionName(sParam(sData, 1)) & "."
'Remove their name from the name list.
RemoveName sParam(sData, 1)
Case SCK_CODE_LINE
'This command is sent when someone draws a line.
'Draw the line.
picDraw.Line (sParam(sData, 1), sParam(sData, 2))-(sParam(sData, 3), sParam(sData, 4)), sParam(sData, 5)
'If you are the server, send the data on the line to all open connections.
If mbServer Then
SendToAll SCK_CODE_LINE & sData, False
End If
Case SCK_CODE_MESSAGE
'This command is sent when someone enters a message.
'Show the message.
UpdateDialog sData
'Notify all open connections of the message.
If mbServer Then
SendToAllButOriginator SCK_CODE_MESSAGE & sData, viConnection
End If
Case SCK_CODE_NEW_NAME_LIST
'This command is sent by the server before refreshing the name list.
lstConnections.Clear
Case SCK_CODE_PEOPLE
'This is sent by the server to notify open connections of name changes.
'Update the name list.
ChangeAddName sParam(sData, 1), sLongParam(sData, 2)
Case SCK_CODE_PRIVATE_MESSAGE
'This command is received by the server when someone sends a private message
'Get number of users message is being delivered to.
iCount = sParam(sData, 1)
'Read the next iCount parameters.
'These represent the users the message is for.
For i = 2 To iCount + 1
'Get next user in list of users the message is for.
iUser = sParam(sData, i)
If iUser = SELF Then
'Message is for server.
'Last parameter is the message.
UpdateDialog sLongParam(sData, iCount + 2)
ElseIf iUser <> viConnection Then
'Ensure message is not being sent back to person who sent it.
'Message is for some other connected user.
SendToPerson SCK_CODE_MESSAGE & sLongParam(sData, iCount + 2), iUser
End If
Next i
End Select
'Remove the processed command from the data stream.
vsString = Mid(vsString, InStr(1, vsString, vbCrLf) + 2, Len(vsString))
Loop
End Sub
Private Sub cmdClearDraw_Click()
'Someone clicked the Clear button. This clears the drawing.
If mbServer Then
'If you are the server, send the command to all open connections.
SendToAll SCK_CODE_CLEAR_DRAW, False
Else
'If you are connected to the server, send the command to the server.
SendToServer SCK_CODE_CLEAR_DRAW
End If
'Clear the box.
picDraw.Cls
End Sub
Private Sub cmdDeselect_Click()
'Deselect all elements in the connection list box.
Dim i As Integer
For i = 0 To lstConnections.ListCount - 1
lstConnections.Selected(i) = False
Next i
End Sub
Private Sub cmdHost_Click()
Frame1.Visible = True
'Someone clicked the Host button to host a chat room.
'Hide/show certain controls because a connection is being opened.
OpenConnection
'Remember that you are the server.
mbServer = True
'Clear stuff to start a new chat room (name list, dialog, etc.)
ClearStuff
'Close the Winsock control that allows you to connect to the server.
sckConnect.Close
'Reset the Winsock control that listens for connections.
sckConnection(0).Close
sckConnection(0).LocalPort = glPort
sckConnection(0).Listen
'Update the status.
UpdateStatus "Eres el Host de esta Sala."
'Show the Lobbys created conections
List1.AddItem "Host : " & txtName.Text
List1.ItemData(0) = SELF
'Show the host's name in list of connections.
lstConnections.AddItem txtName.Text
lstConnections.ItemData(0) = SELF
'Show the Kick button. This is only available to the server.
cmdKick.Visible = True
End Sub
Private Sub cmdKick_Click()
'The server decided to kick some people.
Dim i As Integer, j As Integer
'Check who is selected on the name list.
'Be sure to ignore the server if it is selected.
For i = lstConnections.ListCount - 1 To 0 Step -1
If lstConnections.Selected(i) And lstConnections.ItemData(i) <> SELF Then
'When a selected name is found, nofity all open connections that this person was kicked.
'But do not send this information to other people who are being kicked or to the server.
For j = 0 To lstConnections.ListCount - 1
If lstConnections.ItemData(j) <> SELF Then
If sckConnection(lstConnections.ItemData(j)).State = sckConnected And lstConnections.Selected(j) = False Then
SendToPerson SCK_CODE_KICKED & sFormatSend(lstConnections.ItemData(i)), lstConnections.ItemData(j)
End If
End If
Next j
'Close the connection.
sckConnection(lstConnections.ItemData(i)).Close
'Update the status.
UpdateStatus "Ha sido sacado de la sala " & lstConnections.List(i) & "."
'Remove their name from the name list.
lstConnections.RemoveItem (i)
End If
Next i
'Deselect all names from the name list.
For i = 0 To lstConnections.ListCount - 1
lstConnections.Selected(i) = False
Next i
End Sub
Private Sub cmdPorts_Click()
'Someone clicked the Port Settings button.
'Do not allow this to happen if connections are open.
If bConnected Then
MsgBox "Lo sentimos ya esta en uso. Intentalo de nuevo con otra IP o Puerto.", vbInformation, App.Title
Exit Sub
End If
'Show frmPorts.
frmPorts.Show vbModal
End Sub
Private Sub cmdSend_Click()
'Someone clicked the Send button to send a message.
Dim i As Integer
Dim iCount As Integer
Dim sUsers As String
If mbServer Then
'If you are the server, send the message to all open connections.
If chkPrivate.Value = vbChecked Then
'Private message - only for selected users.
'See who is selected in the list box and send message to them.
For i = 0 To lstConnections.ListCount - 1
If lstConnections.Selected(i) = True Then
'Do not send message to self.
If lstConnections.ItemData(i) <> SELF Then
SendToPerson SCK_CODE_MESSAGE & "Privado - " & txtName.Text & " *: " & txtMessage.Text, lstConnections.ItemData(i)
End If
End If
Next i
Else
'Message is for all users.
SendToAll SCK_CODE_MESSAGE & txtName.Text & ": " & txtMessage.Text, False
End If
Else
'If you are connected to the server, send the message to the server.
If chkPrivate.Value = vbChecked Then
'Private message - only for selected users.
'See who is selected in the list box and send message to them.
For i = 0 To lstConnections.ListCount - 1
If lstConnections.Selected(i) = True Then
'Create string of list of users message will be delivered to.
'This string will be parsed by the server, which will redirect the message.
sUsers = sUsers & sFormatSend(lstConnections.ItemData(i))
'Increment count of users message is being sent to.
'This is needed so the server knows how to parse the string.
iCount = iCount + 1
End If
Next i
'If list is not empty, send message to server
If iCount <> 0 Then
SendToServer SCK_CODE_PRIVATE_MESSAGE & sFormatSend(iCount) & sUsers & " * " & txtName.Text & " *: " & txtMessage.Text
End If
Else
'Message is for all users.
SendToServer SCK_CODE_MESSAGE & txtName.Text & ": " & txtMessage.Text
End If
End If
If chkPrivate.Value = vbChecked Then
'Update the message dialog.
UpdateDialog "Privado - " & txtName.Text & " *: " & txtMessage.Text
Else
'Update the message dialog.
UpdateDialog txtName.Text & ": " & txtMessage.Text
End If
End Sub
Private Sub cmdConnect_Click()
'Someone clicked the Connect button to connect to someone acting as a server.
On Error GoTo Err_cmdConnect_Click
'Hide/show certain controls because a connection is being opened.
OpenConnection
'You are not the server.
mbServer = False
'Clear stuff to start a new chat room (name list, dialog, etc.)
ClearStuff
'Update the status.
UpdateStatus "Conectando..."
'Close the port being used to connect and try to connect.
sckConnect.Close
sckConnect.RemotePort = glPort
sckConnect.Connect txtIP.Text
'Send the user's name to the server.
SendToServer SCK_CODE_JOINED & txtName.Text
Exit Sub
'If a connection cannot be established, this code is run.
Err_cmdConnect_Click:
MsgBox "Imposible Conectar. Intentalo de Nuevo!", vbExclamation, App.Title
sckConnect.Close
UpdateStatus "Desconectado de la sala..."
'Hide/show certain controls because a connection is being closed.
CloseConnection
End Sub
Private Sub cmdDisconnect_Click()
'Someone clicked the Disconnect button to break a connection.
Dim i As Integer
'Close all connections.
sckConnect.Close
For i = 0 To miNumConnections
sckConnection(i).Close
Next i
mbServer = False
'Update status.
UpdateStatus "Desconectado de sala..."
'Erase Host Name
List1_Click
'Clear stuff to start a new chat room (name list, dialog, etc.)
ClearStuff
'Hide/show certain controls because a connection is being closed.
CloseConnection
End Sub
Private Sub Form_Load()
'Call the procedure that gets the user preferences from an INI file.
GetPreferences
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim i As Integer
'Close all connections.
sckConnect.Close
For i = 1 To miNumConnections
sckConnection(i).Close
Next i
'Call the procedure that writes the user preferences to an INI file.
WritePreferences
End Sub
Private Sub Option1_Click()
glPort = 1000
txtIP.Text = "127.0.0.1"
End Sub
Private Sub Option2_Click()
glPort = 1001
txtIP.Text = "127.0.0.1"
End Sub
Private Sub Option3_Click()
glPort = 1002
txtIP.Text = "127.0.0.1"
End Sub
Private Sub Option4_Click()
glPort = 1003
txtIP.Text = "127.0.0.1"
End Sub
Private Sub picDraw_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'The mouse is over the drawing surface and the button was just pressed.
'Draw the line.
'Since the mouse was just pressed, the line will just be a point where the mouse was clicked.
picDraw.Line (X, Y)-(X, Y), sCurrentColor
'Remember where the mouse is so new lines can be drawn connecting to this point.
miX = X
miY = Y
If mbServer Then
'If you are the server, send the info on the line to all open connections.
SendToAll SCK_CODE_LINE & sFormatSend(X) & sFormatSend(Y) & sFormatSend(X) & sFormatSend(Y) & sCurrentColor, False
Else
'If you are connected to the server, send the info on the line to the server.
SendToServer SCK_CODE_LINE & sFormatSend(X) & sFormatSend(Y) & sFormatSend(X) & sFormatSend(Y) & sCurrentColor
End If
End Sub
Private Sub picDraw_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim siX1 As String
Dim siY1 As String
Dim siX2 As String
Dim siY2 As String
Dim sFormatStr As String, sFormatStr2 As String
Dim i As Integer
If Button = vbLeftButton Then
'The mouse button is down and the mouse is moving over the drawing surface.
'Draw the line.
picDraw.Line (miX, miY)-(X, Y), sCurrentColor
If mbServer Then
'If you are the server, send the info on the line to all open connections.
SendToAll SCK_CODE_LINE & sFormatSend(miX) & sFormatSend(miY) & sFormatSend(X) & sFormatSend(Y) & sCurrentColor, False
Else
'If you are connected to the server, send the info on the line to the server.
SendToServer SCK_CODE_LINE & sFormatSend(miX) & sFormatSend(miY) & sFormatSend(X) & sFormatSend(Y) & sCurrentColor
End If
'Remember where the mouse is so new lines can be drawn connecting to this point.
miX = X
miY = Y
End If
End Sub
Private Sub picSelColor_Click(Index As Integer)
Dim i As Integer
For i = 0 To picSelColor.UBound
picSelColor(i).BorderStyle = 0
Next i
picSelColor(Index).BorderStyle = 1
End Sub
Private Sub sckConnect_Close()
'This occurs when the connection to the server is broken.
'Update the status.
UpdateStatus "Desconectado de la sala..."
'Close the connection
sckConnect.Close
'Clear the names list.
lstConnections.Clear
'Clear stuff to start a new chat room (name list, dialog, etc.)
ClearStuff
'Hide/show certain controls because a connection is being closed.
CloseConnection
End Sub
Private Sub sckConnect_DataArrival(ByVal bytesTotal As Long)
'Data has arrived at the computer connected to the server.
Dim sString As String
'Get the data.
sckConnect.GetData sString, vbString
'Process the data. Pass -1 for the computer sending the data because it was from the server.
ProcessData sString, -1
End Sub
Private Sub sckConnection_Close(Index As Integer)
'One of the connections to the server was closed.
'Close the connection.
sckConnection(Index).Close
'If someone was on that connection, notify open connections.
If sConnectionName(Index) <> "" Then
'Update the status.
UpdateStatus sConnectionName(Index) & " usuario desconectado..."
'Remove their name from the name list.
RemoveName Index
'Have the server notify all connected computer that this person has disconnected.
SendToAll SCK_CODE_DISCONNECTED & sFormatSend(Index), False
End If
End Sub
Private Sub sckConnection_ConnectionRequest(Index As Integer, ByVal requestID As Long)
'A connection was requested from the server.
Dim i As Integer
Dim iConnection As Integer
'Make sure this is control 0 in the array. This is the only one that can accept connections.
If Index = 0 Then
'Search for available Winsock control.
For i = 1 To miNumConnections
If sckConnection(i).State = sckClosed Then
iConnection = i
Exit For
End If
Next i
'If none was found, create a new one.
If iConnection = 0 Then
'Increment number of connections.
miNumConnections = miNumConnections + 1
'Load a new Winsock control for this connection.
Load sckConnection(miNumConnections)
'Control to be used is this new control.
iConnection = miNumConnections
End If
'Set port for this control to 0. (Randomly assigns an available port.)
sckConnection(iConnection).LocalPort = 0
'Have this control accept the connection.
sckConnection(iConnection).Accept requestID
End If
End Sub
Private Sub sckConnection_DataArrival(Index As Integer, ByVal bytesTotal As Long)
'Data has arrived at the server from an open connection.
Dim sString As String
'Get the data.
sckConnection(Index).GetData sString, vbString
'Process the data. Pass the index of the connection from which the data came.
ProcessData sString, Index
End Sub
Private Sub tmrSendData_Timer()
'The is the timer that continuously checks for data to send.
'Remembers whether or not something has been sent.
'Only one piece of data can be sent at a time, otherwise the data runs togeter.
Dim bSent As Boolean
'Index variable to determine which piece of data from the queue will be sent.
Dim iSend As Long
'Remembers where the data will be sent.
Dim iConnection As Integer
'Start the index variable at 1.
iSend = 1
'Loop while nothing has been sent and while the index variable is less than the maximum.
Do While bSent = False And iSend <= mSendTo.Count
If mSendTo.Item(iSend) = "sckConnect" And sckConnect.State = sckConnected Then
'Check to see if it is to be sent to the server and make sure the connection is still open.
'Send the data.
sckConnect.SendData mSendList.Item(iSend) & vbCrLf
'Delete the data from the queue.
mSendTo.Remove iSend
mSendList.Remove iSend
'Something has been sent.
bSent = True
ElseIf Mid(mSendTo.Item(iSend), 1, 13) = "sckConnection" Then
'Check to see if it is to be sent to one of the connections to you, the server.
'Parse the string containing the name of the connection to determine which connection to send to.
iConnection = Mid(mSendTo.Item(iSend), 15, Len(mSendTo.Item(iSend)) - 15)
'Ensure that the connection is open.
If sckConnection(iConnection).State = sckConnected Then
'Send the data.
sckConnection(iConnection).SendData mSendList.Item(iSend) & vbCrLf
'Display sent data in tutorial section.
'Delete the data from the queue.
mSendTo.Remove iSend
mSendList.Remove iSend
'Something has been sent.
bSent = True
End If
End If
'Increment index variable.
iSend = iSend + 1
Loop
End Sub
Private Sub txtIP_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
'If enter was pressed in the text box that inputs an IP address to connect to, simulate the pressing of the Connect button.
cmdConnect_Click
'Make VB think nothing was pressed on the keyboard. This prevents it from making an annoying beep.
KeyAscii = 0
End If
End Sub
Private Sub txtMessage_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
'If enter was pressed in the text box that inputs a message to send, simulate the pressing of the Send button.
cmdSend_Click
'Clear the text box.
txtMessage.Text = ""
'Make VB think nothing was pressed on the keyboard. This prevents it from making an annoying beep.
KeyAscii = 0
End If
End Sub
Private Sub txtName_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
'If enter was pressed in the text box that inputs your name, update your name on your screen and on all other computers.
If mbServer Then
'If you are the server, update your name on your screen.
ChangeAddName SELF, txtName.Text
'Refresh name list on all connections.
SendPeopleList
Else
'Send new name to server.
SendToServer SCK_CODE_CHANGE_NAME & txtName.Text
End If
'Make VB think nothing was pressed on the keyboard. This prevents it from making an annoying beep.
KeyAscii = 0
End If
End Sub
Public Sub SendPeopleList()
'This is a procedure to refresh each user's connection list.
Dim i As Integer, j As Integer
'Cycle through all connections.
For i = 0 To lstConnections.ListCount - 1
'Do not send list to self.
If lstConnections.ItemData(i) <> SELF Then
'Send command to clear name list to user.
SendToPerson SCK_CODE_NEW_NAME_LIST, lstConnections.ItemData(i)
'Send the name for each user to each connection.
For j = 0 To lstConnections.ListCount - 1
SendToPerson SCK_CODE_PEOPLE & sFormatSend(lstConnections.ItemData(j)) & lstConnections.List(j), lstConnections.ItemData(i)
Next j
End If
Next i
End Sub
Public Sub ClearStuff()
'This procedure clears stuff out that is used during a chat room.
'It is used to reset stuff after a chat room is closed.
'Clear the data queue.
Set mSendList = Nothing
Set mSendTo = Nothing
'Hide the Kick button.
cmdKick.Visible = False
'Clear the connection list.
lstConnections.Clear
'Clear the dialog.
txtDialog.Text = ""
'Clear the drawing.
picDraw.Cls
End Sub
Public Function sParam(vsData As String, viNum As Integer) As String
'This function pulls the (viNum)th parameter from datastream vsData, which is being processed in the ProcessData procedure.
'This parameter is exactly PARAM_LEN characters long.
sParam = Mid(vsData, PARAM_LEN * (viNum - 1) + 1, PARAM_LEN)
End Function
Public Function sLongParam(vsData As String, viNum As Integer) As String
'This function pulls the (viNum)th parameter from datastream vsData, which is being processed in the ProcessData procedure.
'This parameter can be any length and is usually at the end of a command.
'This type of parameter usually contains a name and is therefore not a fixed length.
sLongParam = Mid(vsData, PARAM_LEN * (viNum - 1) + 1, Len(vsData))
End Function
Public Function sCurrentColor() As String
'This function checks to see which color button is selected for drawing.
'The color is returned formatted as a parameter so it can be transmitted.
Dim i As Integer
'Check all color buttons for the selected one.
For i = 0 To picSelColor.UBound
If picSelColor(i).BorderStyle = 1 Then
sCurrentColor = sFormatSend(picSelColor(i).BackColor)
Exit Function
End If
Next i
End Function
Public Function bConnected() As Boolean
'This function returns True if any connections are open.
'This is used to see if you are allowed to change port settings, host a chat room, or connect to a chat room.
Dim i As Integer
For i = 1 To miNumConnections
If sckConnection(i).State <> sckClosed Then
bConnected = True
Exit Function
End If
Next i
If sckConnect.State <> sckClosed Then
bConnected = True
End If
End Function
Public Sub GetPreferences()
'This procedure reads the user preferences from an INI file.
Const STR_LEN = 256
Dim lLen As Long
Dim sTemp As String * STR_LEN
'Get port preferences.
lLen = GetPrivateProfileString(App.Title, "Puerto", DEFAULT_PORT, sTemp, STR_LEN, INI_FILE)
glPort = Mid(sTemp, 1, lLen)
'Get tutorial preferences.
lLen = GetPrivateProfileString(App.Title, "Tutorial", "1", sTemp, STR_LEN, INI_FILE)
'Ensure height of form is correct.
End Sub
Public Sub WritePreferences()
'This procedure writes the user preferences to an INI file.
Dim lRetVal As Long
Dim sTemp As String
'Write port preferences.
lRetVal = WritePrivateProfileString(App.Title, "Puerto", CStr(glPort), INI_FILE)
End Sub
Public Sub AddName(viConnection As Integer, vsName As String)
'This procedure adds a name to the name list.
'viConnection = the connection the user is on
'vsName = the name of the person
Dim i As Integer
'Add the name to the connections list.
lstConnections.AddItem vsName
'Associate that item in the name list with this connection.
For i = 0 To lstConnections.ListCount - 1
If lstConnections.ItemData(i) = 0 Then
lstConnections.ItemData(i) = viConnection
Exit For
End If
Next i
End Sub
Public Sub ChangeAddName(viConnection As Integer, vsName As String)
'This procedure changes a name in the name list, or adds it if not found.
'viConnection = the connection the user is on
'vsName = the name of the person
Dim i As Integer, j As Integer
Dim bFound As Boolean
'Search for name corresponding to that connection, remove it, and re-add it.
'This ensures that the sorted list box remains sorted.
For i = 0 To lstConnections.ListCount - 1
If lstConnections.ItemData(i) = viConnection Then
'Remove the name.
lstConnections.RemoveItem i
'Add the name.
lstConnections.AddItem vsName
'Find which element in the list was just added and associate correct connection with it.
For j = 0 To lstConnections.ListCount - 1
'New element will have ItemData of 0.
If lstConnections.ItemData(j) = 0 Then
lstConnections.ItemData(j) = viConnection
Exit For
End If
Next j
bFound = True
Exit For
End If
Next i
If Not bFound Then
AddName viConnection, vsName
End If
End Sub
Public Sub RemoveName(viConnection As Integer)
'This procedure removes a name from the name list.
'viConnection = the connection the user is on
Dim i As Integer
For i = 0 To lstConnections.ListCount - 1
If lstConnections.ItemData(i) = viConnection Then
lstConnections.RemoveItem i
Exit For
End If
Next i
End Sub
Public Function sConnectionName(viConnection As Integer) As String
'This functions searches the list of connections for the name of a user.
'viConnection = the connection the user is on
Dim i As Integer
For i = 0 To lstConnections.ListCount - 1
If lstConnections.ItemData(i) = viConnection Then
sConnectionName = lstConnections.List(i)
Exit For
End If
Next i
End Function
Public Sub SendToAll(vsData As String, vbSelf As Boolean)
'Send vsData to all connections.
'vbSelf determine whether or not vsData is sent to yourself as well.
Dim i As Integer
'Cycle through connections and send data to each open connection.
For i = 1 To miNumConnections
If frmMain.sckConnection(i).State = sckConnected Then
SendToPerson vsData, i
End If
Next i
'Send to self if necessary.
If vbSelf Then
SendToSelf vsData
End If
End Sub
Public Sub SendToPerson(vsData As String, viConnection As Integer)
'Send vsData to viConnection.
mSendList.Add vsData
mSendTo.Add "sckConnection(" & viConnection & ")"
End Sub
Public Sub SendToSelf(vsData As String)
'Send vsData to yourself (the server).
'Just call ProcessData on vsData.
ProcessData vsData & vbCrLf, SELF
End Sub
Public Sub SendToServer(vsData As String)
'Send vsData to server.
mSendList.Add vsData
mSendTo.Add "sckConnect"
End Sub
Public Sub UpdateStatus(vsStatus As String)
'Add vsStatus to the chat room status.
txtStatus.Text = txtStatus.Text & vbCrLf & vsStatus
'Put the selection point at the end of the text box so you are seeing the most recent text.
txtStatus.SelStart = Len(txtStatus.Text)
'If there is a blank carriage return at the beginning, delete it.
If Mid(txtStatus.Text, 1, Len(vbCrLf)) = vbCrLf Then
txtStatus.Text = Mid(txtStatus.Text, Len(vbCrLf) + 1, Len(txtStatus.Text))
End If
End Sub
Public Sub UpdateDialog(vsDialog As String)
'Add vsDialog to the chat room dialog.
txtDialog.Text = txtDialog.Text & vbCrLf & vsDialog
'Put the selection point at the end of the text box so you are seeing the most recent text.
txtDialog.SelStart = Len(txtDialog.Text)
'If there is a blank carriage return at the beginning, delete it.
If Mid(txtDialog.Text, 1, Len(vbCrLf)) = vbCrLf Then
txtDialog.Text = Mid(txtDialog.Text, Len(vbCrLf) + 1, Len(txtDialog.Text))
End If
End Sub
Public Sub OpenConnection()
'Hide/show certain controls because a connection is being opened.
cmdHost.Visible = False
cmdConnect.Visible = False
cmdPorts.Visible = False
End Sub
Public Sub CloseConnection()
'Hide/show certain controls because a connection is being closed.
cmdHost.Visible = True
cmdConnect.Visible = True
cmdPorts.Visible = True
End Sub
Gracias y espero haber sido claro
Seeyou!