Visual Basic 6 - Chat in VB6

Forum - Visual Basic 6 - Chat in VB6 - Pagina 6

Pagine: [ 1 2 3 4 5 6 7 8 9 10 ]

jack1988 (Normal User)
Pro

Messaggi: 117
Iscritto: 27/02/2007

Postato alle 18:06
Giovedì, 08/03/2007

allora nel modulo Client ho inserito questo:

Option Explicit

Public Function GetWinSockState(WSCK As Winsock) As String
    Select Case WSCK.State
        Case sckClosed: GetWinSockState = "Chiuso"
        Case sckClosing: GetWinSockState = "In Chiusura"
        Case sckConnected: GetWinSockState = "Connesso"
        Case sckConnecting: GetWinSockState = "Connettendo"
        Case sckConnectionPending: GetWinSockState = "Connessione in attesa"
        Case sckError: GetWinSockState = "Errore"
        Case sckHostResolved: GetWinSockState = "Nome Host Risolto"
        Case sckListening: GetWinSockState = "In Ascolto"
        Case sckOpen: GetWinSockState = "Aperto"
        Case sckResolvingHost: GetWinSockState = "Risolvendo Host"
    End Select
End Function

invece nel form client quest'altro:

Option Explicit

Const Separatore = "Ø"
Const NuovoUtente = "10"
Const Testo = "20"
Const InfoUser = "30"
Const InfoServer = "40"
Const NickEsistente = "50"
Const Autenticato = "60"
Const DatiCorrotti = "70"
Const ListaUs = "80"

Dim State As Status
Dim Version As String
Dim Ind As Integer
Dim Nick As String
Enum Status
    Active = 1
    Closed = 0
End Enum

Private Sub Connetti_Click()
    Dim Temp As String
    Dim arr() As String
    If State = Closed Then
        arr() = Split(InputBox("Inserire il Server e la Porta separati dai due punti (

" & vbCrLf & "Server:Porta"), ":")
        If UBound(arr()) = 1 Then
            TCP.Connect arr(0), Val(arr(1))
        Else
            MsgBox "Dati non inseriti correttamente"
        End If
    Else
        If MsgBox("Disconnettersi?", vbYesNo, "Disconnessione") = vbYes Then
            TCP.Close
            TCP_Close
        End If
    End If
End Sub

Private Sub mnuEsci_Click()
Unload Me
End Sub
Private Sub Form_Load()
    Version = App.Major & "." & App.Minor & "." & App.Revision
    SetState Closed
End Sub
Sub AddText(Testo As String, Optional ACapo As Boolean = True)  ' Aggiunge testo alla
    txtChat.Text = txtChat.Text & Testo                         ' chat
    If ACapo Then txtChat.Text = txtChat.Text & vbCrLf
    txtChat.SelStart = Len(txtChat.Text)
    txtChat.Refresh
End Sub

Sub SetState(Stat As Status)    ' Imposta lo stato del Client
    Dim bOn As Boolean
    bOn = (Stat = Active)
    txtChat.Enabled = bOn
    txtInvia.Enabled = bOn
    InfoServ = bOn
    lstUtenti.Enabled = bOn
    If bOn Then
        Connetti.Caption = "Disconnetti"
    Else
        Connetti.Caption = "Connetti"
        lstUtenti.Clear
    End If
    'If Not bOn Then
    State = Stat
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Cancel = (MsgBox("Uscire?", vbYesNo, "Uscita") = vbNo)
End Sub

Private Sub InfoServ_Click()
    TCP.SendData InfoServer
End Sub

Private Sub lstUtenti_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim Nick As String
    If Button = vbRightButton And lstUtenti.ListCount > 0 Then
        Nick = lstUtenti.List(lstUtenti.ListIndex)
        TCP.SendData InfoUser & Separatore & Nick
        AddText "Richiesta Info su " & Nick & " inoltrata"
    End If
End Sub

Private Sub Service_Timer()
    lblStato.Caption = "Stato: " & GetWinSockState(TCP())
End Sub

Private Sub TCP_Close()
    TCP.Close
    AddText "Connessione Chiusa al Server"
    SetState Closed
    Me.Caption = "Client Chat"
End Sub

Sub Pulisci(ByRef Stringa As String)
    Stringa = Replace(Trim$(Stringa), vbCrLf, vbNullString)
End Sub

Private Sub TCP_Connect()
    Dim Descr As String
    SetState Active     ' Attiva i controlli
    Do
        Nick = InputBox("Inserisci il Nick, al massimo 10 caratteri", "Nick")
        Call Pulisci(Nick)
        If Len(Nick) = 0 Or Len(Nick) > 10 Then
            If MsgBox("Chiudere la connessione?", vbYesNo) = vbYes Then
                TCP_Close
                Exit Sub
            End If
        Else
            Exit Do
        End If
    Loop
    Descr = InputBox("Inserisci una tua descrizione")
    If Len(Descr) = 0 Then Descr = "Nessuna Descrizione"
    AddText "Connesso a " & TCP.RemoteHostIP & " con successo"
    TCP.SendData NuovoUtente & Separatore & Nick & Separatore & Descr & Separatore & Version & _
    Separatore & Environ$("OS")

End Sub

Private Sub TCP_DataArrival(ByVal bytesTotal As Long)
    Dim data As String
    Dim arr() As String
    Dim n As Integer
    Dim UB As Integer
    Dim arry() As String
    TCP.GetData data
    arr() = Split(data, Separatore)

    Select Case arr(0)
        Case ListaUs       ' Lista degli utenti
            arry() = Split(arr(1), "|")
            UB = UBound(arry())
            lstUtenti.Clear
            For n = 0 To UB
                lstUtenti.AddItem arry(n)
            Next
        Case Testo   ' Testo da aggiungere alla chat
            AddText arr(1)
        Case InfoServer   ' Risposta info server
            MsgBox arr(1)
        Case InfoUser   ' Risposta info utente (WhoIs)
            MsgBox arr(1)
        Case NickEsistente   ' In caso di nick già esistente
            MsgBox "Nick rifiutato perchè già esistente, reinserire i dati", vbInformation
            TCP_Connect
        Case Autenticato   ' Autenticazione al server completata
            AddText "Autenticazione completata"
            Me.Caption = "Client Chat -> " & Nick
        Case DatiCorrotti   ' Autenticazione sbagliata
            AddText "Autenticazione sbagliata"
            TCP_Connect
    End Select
End Sub

Private Sub TCP_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
    TCP.Close
    AddText "Si è verificato l'errore " & Number & ": " & Description & vbCrLf & "Connessione Persa"
    TCP_Close
End Sub

Sub SendText(Text As String)
    TCP.SendData Testo & Separatore & Text
End Sub

Private Sub txtInvia_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn And Len(txtInvia.Text) > 0 Then
        TCP.SendData Testo & Separatore & txtInvia.Text
        txtInvia.Text = vbNullString
    End If
End Sub

dv è il problema?... :k:

jack1988 (Normal User)
Pro

Messaggi: 117
Iscritto: 27/02/2007

Postato alle 18:09
Giovedì, 08/03/2007

il modulo e il form del CLient fanno parte dello stesso progetto... :k:

jack1988 (Normal User)
Pro

Messaggi: 117
Iscritto: 27/02/2007

Postato alle 20:58
Giovedì, 08/03/2007

mica devo kiamare in nome specifico sia la form del client sia il modulo del client?...nn credo,vero?

cmq lo stesso problema me lo da anke sul form del Server e sul modulo del Server...xkè?...risp.

grazie!!!!! :k:

jack1988 (Normal User)
Pro

Messaggi: 117
Iscritto: 27/02/2007

Postato alle 11:15
Domenica, 11/03/2007

c.ronaldo xkè nn risp +?...t prego mi serve ancora un piccolo aiutino...Grazie!!!!

c.ronaldo (Normal User)
Expert

Messaggi: 577
Iscritto: 01/02/2007

Postato alle 13:45
Domenica, 11/03/2007

Ok
Scusa ma nn è che avevo molto tempo..
Che c'è? :k:

jack1988 (Normal User)
Pro

Messaggi: 117
Iscritto: 27/02/2007

Postato alle 21:09
Domenica, 11/03/2007

il problema sulla funzione Winsock...ricordi?

allora nel modulo Client ho inserito questo:

Option Explicit

Public Function GetWinSockState(WSCK As Winsock) As String
Select Case WSCK.State
Case sckClosed: GetWinSockState = "Chiuso"
Case sckClosing: GetWinSockState = "In Chiusura"
Case sckConnected: GetWinSockState = "Connesso"
Case sckConnecting: GetWinSockState = "Connettendo"
Case sckConnectionPending: GetWinSockState = "Connessione in attesa"
Case sckError: GetWinSockState = "Errore"
Case sckHostResolved: GetWinSockState = "Nome Host Risolto"
Case sckListening: GetWinSockState = "In Ascolto"
Case sckOpen: GetWinSockState = "Aperto"
Case sckResolvingHost: GetWinSockState = "Risolvendo Host"
End Select
End Function

invece nel form client quest'altro:

Option Explicit

Const Separatore = "Ø"
Const NuovoUtente = "10"
Const Testo = "20"
Const InfoUser = "30"
Const InfoServer = "40"
Const NickEsistente = "50"
Const Autenticato = "60"
Const DatiCorrotti = "70"
Const ListaUs = "80"

Dim State As Status
Dim Version As String
Dim Ind As Integer
Dim Nick As String
Enum Status
Active = 1
Closed = 0
End Enum

Private Sub Connetti_Click()
Dim Temp As String
Dim arr() As String
If State = Closed Then
arr() = Split(InputBox("Inserire il Server e la Porta separati dai due punti (" & vbCrLf & "Server:Porta"), ":")
If UBound(arr()) = 1 Then
TCP.Connect arr(0), Val(arr(1))
Else
MsgBox "Dati non inseriti correttamente"
End If
Else
If MsgBox("Disconnettersi?", vbYesNo, "Disconnessione") = vbYes Then
TCP.Close
TCP_Close
End If
End If
End Sub

Private Sub mnuEsci_Click()
Unload Me
End Sub
Private Sub Form_Load()
Version = App.Major & "." & App.Minor & "." & App.Revision
SetState Closed
End Sub
Sub AddText(Testo As String, Optional ACapo As Boolean = True) ' Aggiunge testo alla
txtChat.Text = txtChat.Text & Testo ' chat
If ACapo Then txtChat.Text = txtChat.Text & vbCrLf
txtChat.SelStart = Len(txtChat.Text)
txtChat.Refresh
End Sub

Sub SetState(Stat As Status) ' Imposta lo stato del Client
Dim bOn As Boolean
bOn = (Stat = Active)
txtChat.Enabled = bOn
txtInvia.Enabled = bOn
InfoServ = bOn
lstUtenti.Enabled = bOn
If bOn Then
Connetti.Caption = "Disconnetti"
Else
Connetti.Caption = "Connetti"
lstUtenti.Clear
End If
'If Not bOn Then
State = Stat
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Cancel = (MsgBox("Uscire?", vbYesNo, "Uscita") = vbNo)
End Sub

Private Sub InfoServ_Click()
TCP.SendData InfoServer
End Sub

Private Sub lstUtenti_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim Nick As String
If Button = vbRightButton And lstUtenti.ListCount > 0 Then
Nick = lstUtenti.List(lstUtenti.ListIndex)
TCP.SendData InfoUser & Separatore & Nick
AddText "Richiesta Info su " & Nick & " inoltrata"
End If
End Sub

Private Sub Service_Timer()
lblStato.Caption = "Stato: " & GetWinSockState(TCP())
End Sub

Private Sub TCP_Close()
TCP.Close
AddText "Connessione Chiusa al Server"
SetState Closed
Me.Caption = "Client Chat"
End Sub

Sub Pulisci(ByRef Stringa As String)
Stringa = Replace(Trim$(Stringa), vbCrLf, vbNullString)
End Sub

Private Sub TCP_Connect()
Dim Descr As String
SetState Active ' Attiva i controlli
Do
Nick = InputBox("Inserisci il Nick, al massimo 10 caratteri", "Nick")
Call Pulisci(Nick)
If Len(Nick) = 0 Or Len(Nick) > 10 Then
If MsgBox("Chiudere la connessione?", vbYesNo) = vbYes Then
TCP_Close
Exit Sub
End If
Else
Exit Do
End If
Loop
Descr = InputBox("Inserisci una tua descrizione")
If Len(Descr) = 0 Then Descr = "Nessuna Descrizione"
AddText "Connesso a " & TCP.RemoteHostIP & " con successo"
TCP.SendData NuovoUtente & Separatore & Nick & Separatore & Descr & Separatore & Version & _
Separatore & Environ$("OS")

End Sub

Private Sub TCP_DataArrival(ByVal bytesTotal As Long)
Dim data As String
Dim arr() As String
Dim n As Integer
Dim UB As Integer
Dim arry() As String
TCP.GetData data
arr() = Split(data, Separatore)

Select Case arr(0)
Case ListaUs ' Lista degli utenti
arry() = Split(arr(1), "|")
UB = UBound(arry())
lstUtenti.Clear
For n = 0 To UB
lstUtenti.AddItem arry(n)
Next
Case Testo ' Testo da aggiungere alla chat
AddText arr(1)
Case InfoServer ' Risposta info server
MsgBox arr(1)
Case InfoUser ' Risposta info utente (WhoIs)
MsgBox arr(1)
Case NickEsistente ' In caso di nick già esistente
MsgBox "Nick rifiutato perchè già esistente, reinserire i dati", vbInformation
TCP_Connect
Case Autenticato ' Autenticazione al server completata
AddText "Autenticazione completata"
Me.Caption = "Client Chat -> " & Nick
Case DatiCorrotti ' Autenticazione sbagliata
AddText "Autenticazione sbagliata"
TCP_Connect
End Select
End Sub

Private Sub TCP_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
TCP.Close
AddText "Si è verificato l'errore " & Number & ": " & Description & vbCrLf & "Connessione Persa"
TCP_Close
End Sub

Sub SendText(Text As String)
TCP.SendData Testo & Separatore & Text
End Sub

Private Sub txtInvia_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn And Len(txtInvia.Text) > 0 Then
TCP.SendData Testo & Separatore & txtInvia.Text
txtInvia.Text = vbNullString
End If
End Sub

dv è il problema?...
cmq mi da l'errore su questa porzione d codice:
-Public Function GetWinSockState(WSCK As Winsock)

mica devo kiamare il modulo e il form client in nomi specifici?...io nn credo.risp.

Grazie!!!!! :k:

c.ronaldo (Normal User)
Expert

Messaggi: 577
Iscritto: 01/02/2007

Postato alle 7:29
Lunedì, 12/03/2007

Scusami tanto ma non sò...
A me và benissimo...
Rifai il progetto e aggiungi il modulo!
Se vuoi qualche altro sorgente di chat multi utente dimmelo! :k:

Ultima modifica effettuata da c.ronaldo il 12/03/2007 alle 7:36

jack1988 (Normal User)
Pro

Messaggi: 117
Iscritto: 27/02/2007

Postato alle 14:37
Mercoledì, 14/03/2007

ok...riproverò a rifarlo...grazie!!!
cmq si dammi qualke altro sorgente d chat multiutente...saresti gentilissimo!!!Grazie d nuovo!!!

Pagine: [ 1 2 3 4 5 6 7 8 9 10 ]