Option Explicit
Dim iConta As Integer
Dim X As Long
Dim Nick As String
Private Sub cmdconnetti_Click()
Static Stat As Boolean
Dim iPorta As Integer
'Carico i dati del formlogin
iPorta = frmLogin.txtPorta
If Stat = False Then
If Len(iPorta) > 0 Then
TCP.LocalPort = Val(iPorta)
TCP.Listen
cmdconnetti.Caption = "&Disconnetti"
'Imposto la caption del menų
mnuAscolta.Caption = "Disconnetti"
Stat = True
StatusBar1.Panels(1) = "Stato: " & "In ascolto"
Else
MsgBox "Manca la porta!", vbExclamation
End If
Else
TCP.Close
Stat = False
cmdInvia.Enabled = False
cmdTrillo.Enabled = False
txtInvia.Enabled = False
StatusBar1.Panels(1) = "Stato: " & "Disconnesso"
cmdconnetti.Caption = "&Ascolta"
'Imposto la caption del menų
mnuAscolta.Caption = "Ascolta"
'Azzero le Textbox del Nick
txtNick.Text = ""
txtMioNick.Text = ""
'Svuoto le textbox dei nick
txtNick.Text = ""
txtMioNick.Text = ""
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 cmdRiduci_Click()
End Sub
Private Sub cmdServer_Click()
frmLogin.Show vbModal
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 Form_Load()
'Imposto il valore 5 alla variabile iConta
iConta = 5
End Sub
Private Sub mnuHelpAggiornamenti_Click()
frmAggiornamenti.Show 1
End Sub
Private Sub mnuPierotofy_Click()
X = ShellExecute(hWnd, "Open", "http://www.pierotofy.it", vbNullString, vbNullString, SW_NORMAL)
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 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
frmServer.Show
frmServer.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()
'Visualizza frmAbout
frmAbout.Show
End Sub
Private Sub mnuAscolta_Click()
'Richiama l'evento Click del tasto connetti
cmdconnetti_Click
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
frmServer.Show
End If
End Sub
Private Sub mnuFileSalva_Click()
Dim NomeFile As String
Dim File As String
NomeFile = InputBox("Inserisci il nome del file da salvare", "NOME")
File = "C:/" & NomeFile & ".dat"
Open File For Output As #1
Write #1, txtChat.Text
Close #1
End Sub
Private Sub mnuModificaColorecarattere_Click()
dlgComune.ShowColor
txtChat.ForeColor = dlgComune.Color
End Sub
Private Sub mnuModificaDimensionecarattereAumenta_Click()
txtChat.FontSize = txtChat.FontSize + 1
If txtChat.FontSize >= 25 Then
txtChat.FontSize = 10
End If
End Sub
Private Sub mnuModificaDimensionecarattereDiminuisci_Click()
txtChat.FontSize = txtChat.FontSize - 1
If txtChat.FontSize <= 9 Then
txtChat.FontSize = 10
End If
End Sub
Private Sub mnuMostraIP_Click()
X = ShellExecute(hWnd, "Open", "http://www.ilmioip.it", vbNullString, vbNullString, SW_NORMAL)
End Sub
Private Sub mnuToolPortscan_Click()
'Visualizzo il Port Scan
frmPortScan.Show 1
End Sub
Private Sub mnuVisualizzaRiduci_Click()
nid.cbSize = Len(nid)
nid.hWnd = frmServer.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 mnuWebBug_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 TCP_ConnectionRequest(ByVal requestID As Long)
StatusBar1.Panels(1) = "Stato: " & "Richiesta di connessione"
If MsgBox("Accettare la connessione?", vbYesNo) = vbYes Then
TCP.Close
TCP.Accept requestID
' Richiede il Nickname personale dell'utente
' e poi lo invia
Nick = "- " & frmLogin.txtNick
TCP.SendData Nick
'Invio un suono per segnalare l'avvenuta connessione
PlaySound App.Path & "\notify.wav", 0, SND_FILENAME Or SND_SYNC
StatusBar1.Panels(1) = "Stato: " & "Connesso"
'Abilita il bottone Invia, Trillo e la Text invia
cmdInvia.Enabled = True
cmdTrillo.Enabled = True
txtInvia.Enabled = True
Else
TCP.Close
TCP.Listen
'Rifiuta la connessione
PlaySound App.Path & "\ir_inter.wav", 0, SND_FILENAME Or SND_SYNC
StatusBar1.Panels(1) = "Stato: " & "Connessione rifiutata"
End If
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"
'Svuoto le textbox dei nick
txtNick.Text = ""
txtMioNick.Text = ""
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.
frmServer.Caption = "New message!"
Timer1.Enabled = True
'Se ricevo un trillo allora riproduce il Beep
If Data = "Hai ricevuto un trillo!" Then Beep
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 e diventa vuota
'iConta ritorna al suo valore iniziale
'e il timer viene disattivato
iConta = iConta - 1
If iConta = 0 Then
frmServer.Caption = ""
iConta = 5
Timer1.Enabled = False
End If
'In caso la casella di testo txtMioNick rimanga vuota, questo codice
'la riempie con il nick
txtMioNick.Text = Nick
End Sub
