Option Explicit
Dim iConta As Integer
Dim X As Long
Dim Nick As String
Private Sub cmdConnetti_Click()
On Error GoTo errore
Static Stat As Boolean
Dim vIP As Variant
Dim iPorta As Integer
'Carico i dati del form Login
vIP = frmLogin.txtIP
iPorta = frmLogin.txtPorta
If Stat = False Then
'Se le caselle di testo txtIP e txtPorta hanno almeno pių di 0 caratteri
'Allora eseguo le seguenti istruzioni:
If Len(vIP) > 0 And Len(iPorta) > 0 Then
TCP.Connect vIP, Val(iPorta)
'Cambio la caption del CommandButton cmdConnetti
cmdConnetti.Caption = "Disconnetti"
'Cambio la caption del menų
mnuConnetti.Caption = "Disconnetti"
'Cambio la caption del pannello numero uno
StatusBar1.Panels(1) = "Disconnette il client"
'Imposto la variabile Stat a True
Stat = True
'Cambio la caption della statusbar
StatusBar1.Panels(1) = "Stato: " & "Connettendo"
Else
'Manda un MessageBox con un avviso di dati mancanti
MsgBox "Dati Mancanti!", vbExclamation
End If
Else
'Chiudo il socket
TCP.Close
'Imposto la variabile Stat a False
Stat = False
'Cambio la caption della statusbar
StatusBar1.Panels(1) = "Stato: " & "Chiudendo"
'Cambio la caption del CommandButton cmdConnetti
cmdConnetti.Caption = "Connetti"
'Cambio la caption del menų
mnuConnetti.Caption = "Connetti"
'Disattivo i due CommandButton e la TextBox txtInvia
cmdInvia.Enabled = False
cmdTrillo.Enabled = False
txtInvia.Enabled = False
'Svuoto le textbox dei nick
txtNick.Text = ""
txtMioNick.Text = ""
Exit Sub
errore:
MsgBox Err.Description, vbExclamation + vbOKOnly, "ERRORE"
End If
End Sub
Private Sub cmdInvia_Click()
If Len(txtInvia) > 0 Then
TCP.SendData txtInvia.Text
txtChat.Text = txtChat.Text & Time$ & Nick & ":" & vbCrLf & txtInvia.Text & vbCrLf
txtChat.SelStart = Len(txtChat.Text)
txtInvia.Text = vbNullString
StatusBar1.Panels(1) = "Stato: " & "Inviando " & LenB(txtInvia.Text) & "Bytes"
End If
End Sub
Private Sub cmdTrillo_Click()
Dim a As String
a = "Hai ricevuto un trillo!"
TCP.SendData a
txtChat.Text = txtChat.Text & "Hai inviato un trillo!" & vbCrLf
txtChat.SelStart = Len(txtChat.Text)
txtInvia.Text = vbNullString
StatusBar1.Panels(1) = "Nota: " & "E' Stato inviato un trillo!"
End Sub
Private Sub cmmLogin_Click()
frmLogin.Show vbModal
End Sub
Private Sub Form_Load()
'Imposto il valore alla variabile iConta
iConta = 5
'Visualizzo la schermata di connessione
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim msg As Long
msg = Me.ScaleX(X, Me.ScaleMode, vbPixels)
Select Case msg
Case WM_LBUTTONDBLCLK
frmClient.Show
frmClient.WindowState = 0
Shell_NotifyIcon NIM_DELETE, nid
End Select
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
'Forzo la chiusura del programma
End
End Sub
Private Sub mnuAbout_Click()
' Visualizzo le info sul prodotto
frmAbout.Show
End Sub
Private Sub mnuClientLogin_Click()
'Mostro il form Login
frmLogin.Show
End Sub
'Private Sub mnuClientAggiornamenti_Click()
' 'Richiamo l'evento Click del tasto aggiorna
' cmdSegnalazioneErrori_Click
'End Sub
Private Sub mnuConnetti_Click()
'Richiamo l'evento Click del tasto connetti
cmdConnetti_Click
End Sub
Private Sub mnuDimensionecarattereAumenta_Click()
txtChat.FontSize = txtChat.FontSize + 1
If txtChat.FontSize >= 25 Then
txtChat.FontSize = 10
End If
End Sub
Private Sub mnuDimensionecarattereDiminuisci_Click()
txtChat.FontSize = txtChat.FontSize - 1
If txtChat.FontSize <= 9 Then
txtChat.FontSize = 10
End If
End Sub
Private Sub mnuEsci_Click()
Dim Answer As String
Answer = MsgBox("Sei sicuro di voler terminare il programma?", vbExclamation + vbYesNo + vbDefaultButton2, "Termina programma")
If Answer = vbYes Then
End
Else
frmClient.Show
End If
End Sub
Private Sub mnuFileSalva_Click()
Dim NomeFile As String
Dim File As String
'Chiede il nome del file da salvare
NomeFile = InputBox("Inserisci il nome del file da salvare", "NOME")
File = "C:/" & NomeFile & ".txt"
Open File For Output As #1
'Salva il contenuto della TextBox Chat
Write #1, txtChat.Text
'Chiude
Close #1
End Sub
Private Sub mnuHelpAggiornamenti_Click()
frmAggiornamenti.Show 1
End Sub
Private Sub mnuHelpInfo_Click()
'Procura all'utente tutte le informazioni sulla connessione stabilita con il server
MsgBox "INFORMAZIONI CLIENT:" & vbCrLf & "Host : " & TCP.LocalHostName & vbCrLf & "IP : " & TCP.LocalIP _
& vbCrLf & "Porta : " & TCP.LocalPort & vbCrLf & "---------" & vbCrLf & "INFORMAZIONI SERVER:" _
& vbCrLf & "Host: " & TCP.RemoteHost & vbCrLf & "Host IP: " & TCP.RemoteHostIP & vbCrLf & "Porta: " _
& TCP.RemotePort, vbInformation + vbOKOnly, "INFORMAZIONI"
End Sub
Private Sub mnuModificaDimensionecarattereColorecarattere_Click()
dlgComune.ShowColor
txtChat.ForeColor = dlgComune.Color
End Sub
Private Sub mnuTipocarattereArial_Click()
'Imposto come tipo carattere Arial
txtChat.FontName = "Arial"
mnuTipocaratterePredefinito.Checked = False
mnuTipocarattereArial.Checked = True
mnuTipocarattereTimesnewroman.Checked = False
End Sub
Private Sub mnuTipocaratterePredefinito_Click()
'Imposto come tipo carattere Comic Sans MS
txtChat.FontName = "Comic Sans MS"
mnuTipocaratterePredefinito.Checked = True
mnuTipocarattereArial.Checked = False
mnuTipocarattereTimesnewroman.Checked = False
End Sub
Private Sub mnuTipocarattereTimesnewroman_Click()
'Imposto come tipo carattere Times New Roman
txtChat.FontName = "Times New Roman"
mnuTipocaratterePredefinito.Checked = False
mnuTipocarattereArial.Checked = False
mnuTipocarattereTimesnewroman.Checked = True
End Sub
Private Sub mnuToolPortScan_Click()
'Visualizzo il Port Scan
frmPortScan.Show 1
End Sub
Private Sub mnuVisualizzaRiduci_Click()
'Riduce in traybar il form
nid.cbSize = Len(nid)
nid.hWnd = frmClient.hWnd
nid.uId = 0
nid.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
nid.uCallBackMessage = WM_MOUSEMOVE
'nid.hIcon = cmdRiduci.Picture
Shell_NotifyIcon NIM_ADD, nid
Me.WindowState = vbMinimized
Me.Hide
End Sub
Private Sub mnuWebErrori_Click()
X = ShellExecute(hWnd, "Open", "http://otrebor6.altervista.org/bug.html", vbNullString, vbNullString, SW_NORMAL)
End Sub
Private Sub mnuWebHomepage_Click()
X = ShellExecute(hWnd, "Open", "http://otrebor6.altervista.org/chat.html", vbNullString, vbNullString, SW_NORMAL)
End Sub
Private Sub mnuWebPierotofy_Click()
X = ShellExecute(hWnd, "Open", "http://www.pierotofy.it", vbNullString, vbNullString, SW_NORMAL)
End Sub
Private Sub mnuWebShowIP_Click()
X = ShellExecute(hWnd, "Open", "http://www.ilmioip.it", vbNullString, vbNullString, SW_NORMAL)
End Sub
Private Sub TCP_Close()
TCP.Close
PlaySound App.Path & "\ir_inter.wav", 0, SND_FILENAME Or SND_SYNC
StatusBar1.Panels(1) = "Stato: " & "Disconnesso"
cmdInvia.Enabled = False
cmdTrillo.Enabled = False
txtInvia.Enabled = False
'Azzero le textbox dei nick
txtNick.Text = ""
txtMioNick.Text = ""
End Sub
Private Sub TCP_Connect()
StatusBar1.Panels(1) = "Stato: " & "Connesso"
cmdInvia.Enabled = True
cmdTrillo.Enabled = True
txtInvia.Enabled = True
'Invio un suono per segnalare l'avvenuta connessione
PlaySound App.Path & "\notify.wav", 0, SND_FILENAME Or SND_SYNC
' Richiede il Nickname personale dell'utente
' e poi lo invia
Nick = frmLogin.txtNick
TCP.SendData "- " & Nick
End Sub
Private Sub TCP_DataArrival(ByVal bytesTotal As Long)
Dim Data As String
TCP.GetData Data
'Quando ricevo Data la caption del form cambia
'in modo che se un utente ha ridotto ad icona il programma
'possa accorgersi del nuovo messaggio in arrivo.
'Dopodichč attivo il timer.
frmClient.Caption = "New message!"
Timer1.Enabled = True
' Se Data č uguale a: "Hai ricevuto un trillo" allora
' ricevi un segnale acustico
If Data = "Hai ricevuto un trillo!" Then Beep
' Restituisce i byte ricevuti
StatusBar1.Panels(1) = "Stato: " & "In arrivo " & bytesTotal & "Bytes"
txtChat.Text = txtChat.Text & Time$ & txtNick.Text & ":" & vbCrLf & Data & vbCrLf
txtChat.SelStart = Len(txtChat.Text)
' Se Data inizia con "- " allora vuol dire che il client
' Ha inviato il suo Nickname, per cui il valore di Data
' verrā salvato nella txtNick
If Left(Data, 2) = "- " Then
txtNick.Text = Data
txtMioNick.Text = Nick
End If
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
PlaySound App.Path & "\ir_inter.wav", 0, SND_FILENAME Or SND_SYNC
StatusBar1.Panels(1) = "Stato: " & "Errore IP" & Number
End Sub
Private Sub TCP_SendComplete()
StatusBar1.Panels(1) = "Nota: " & "Dati inviati con successo"
End Sub
Private Sub Timer1_Timer()
'Inizialmente ho dato ad iConta il valore di 5
'Ogni secondo il suo valore diminuisce.
'Una volta raggiunto il valore 0:
'La caption del form cambia
'iConta ritorna al suo valore iniziale
'e il timer viene disattivato
iConta = iConta - 1
If iConta = 0 Then
frmClient.Caption = ""
iConta = 5
Timer1.Enabled = False
End If
'In caso la textbox non si aggiorna, ci pensa il timer
txtMioNick.Text = Nick
End Sub
