Título: Ayuda con Items de un ListBox vb6.0
Publicado por: Brian1511 en 18 Noviembre 2012, 03:32 am
Hola a todos como un Saludo de parte mia , espero que esten bien . 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 :D Garcias por Adelantado!: Capturas [IMG=http://img801.imageshack.us/img801/1121/68668029.jpg][/IMG] (http://imageshack.us/photo/my-images/801/68668029.jpg/) 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
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!
Título: Re: Ayuda con Items de un ListBox vb6.0
Publicado por: $Edu$ en 18 Noviembre 2012, 06:33 am
Deja solo la parte que te interesa, porque muchos, como yo, no leeremos tanto codigo pudiendo haber puesto solo lo principal.
Título: Re: Ayuda con Items de un ListBox vb6.0
Publicado por: Brian1511 en 18 Noviembre 2012, 19:39 pm
Ok amigo diculpa bueno aqui te lo dejare! Esta es la Captura!: (http://imageshack.us/a/img801/1121/68668029.th.jpg) (http://imageshack.us/photo/my-images/801/68668029.jpg/) Esta es la del Boton para crear la sala : 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 host's name in list of connections.
[b](AQUI QUIERO AGREGAR LO QUE LES DIJE)[/b]
lstConnections.AddItem txtName.Text lstConnections.ItemData(0) = SELF
'Show the Kick button. This is only available to the server. cmdKick.Visible = True End Sub
Este es para el boton desconectar si eres Host de la sala pues se borraria el item de este usuario pero si no eres host pues no se borraria nada.
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..."
'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
Ahhhh y tabien quisiara porfavor que en el Listbox se agregara el nombre o nick - la ip que eljio - Puerto Ejemplo: -------------------------------------------------------------------- Host IpHost PuertoHost -------------------------------------------------------------------- xxxUSERxxx 000.0.0.00 0000 -------------------------------------------------------------------- xxxUSER2xxx 001.0.0.00 0001 -------------------------------------------------------------------- Algo como eso si es posible hacerlo porfavor ayudenme!! PD: Si falta algun tipo de Info en los code que les deje pues me avisan :D ...
|