[VB6]Winsock: DataArrival

[x69asterix]

volevo capire come utilizzare un solo oggetto winsock e tramite esso per fare passare sia dati in formato stringa che sia dati in formato binario. Al momento utilizzo due Winsock, uno mi invia constantemente l' immagine del pc remoto e l' altro lo utilizzo per inviare i comandi.

esempio:

server

Private Sub Winsock2_DataArrival(Index As Integer, ByVal _
    bytesTotal As Long)
Dim dati As String
Dim immagine() As Byte
Dim sFile As String
Dim i, n, m

    Winsock2(Index).GetData dati, vbString

If Mid$(dati, 1, 5) = "hange" Then
Text2.Text = ""
Text3.Text = ""
On Error Resume Next
mystring = Split(dati, "hange", -1, 1)
'''Text1.Text = mystring(1)
On Error Resume Next
'Dim i
'Text1.Text = ""
ListView1.ListItems.Clear
Set ff = FSO.GetFolder(mystring(1)).SubFolders

    Label4.Caption = ""
    Set f = FSO.GetFolder(mystring(1))
    Call ScanDirectory(f)
    Set FSO = Nothing
    Set f = Nothing

'Text1.Text = List1.Text
mystring = Split(mystring(1), "\", -1, 1)
List1.Clear
List1.AddItem Combo1.Text
'List1.AddItem mystring(0) & "\" '& mystring(1)
List1.AddItem mystring(0) & "\" & mystring(1)
List1.AddItem mystring(0) & "\" & mystring(1) & "\" & mystring(2) & "\" & mystring(3)

For Each f In ff
DoEvents
List1.AddItem f.Path
List1.TopIndex = List1.ListCount - 1
DoEvents
Next
DoEvents

For i = 0 To List1.ListCount - 1 Step 1
Call Winsock2(NumSockets).SendData("dir" & List1.List(i) & vbCrLf)
Next
Delay (1)
End If

If Mid$(dati, 1, 2) = "sh" Then
Text2.Text = ""
Text3.Text = ""
On Error Resume Next
mystring = Split(dati, "sh", -1, 1)
Combo1.Text = mystring(1)
For i = 0 To List1.ListCount - 1 Step 1
Call Winsock2(Index).SendData("dir" & List1.List(i) & vbCrLf)
Next
End If

If Left(dati, 7) = "getfile" Then
Text2.Text = ""
Text3.Text = ""
For i = 1 To ListView1.ListItems.Count Step 1
DoEvents
Delay (1)
Call Winsock2(Index).SendData("getfile" & ListView1.ListItems(i))

Next
End If

If Left(dati, 5) = "disco" Then
Text2.Text = ""
Text3.Text = ""
For i = 0 To List1.ListCount - 1 Step 1
Call Winsock2(Index).SendData("dir" & List1.List(i) & vbCrLf)
Next
ErrorHandler:         ' Routine di gestione degli errori.
Select Case Err.Number   ' Valuta il numero errore.
Case 68
Exit Sub
End Select
End If
DoEvents


If Mid$(dati, 1, 9) = "directory" Then
Text2.Text = ""
Text3.Text = ""
mystring = Split(dati, "directory", -1, 1)
DoEvents
WinExec "Explorer.exe " & mystring(1), 10
End If

If Mid$(dati, 1, 5) = "close" Then
For i = 0 To NumSockets
Winsock2(i).Close
Next
Winsock1(1).Close
End If

If Mid$(dati, 1, 7) = "qualita" Then
mystring = Split(dati, "qualita", -1, 1)
Text2.Text = ""
Text3.Text = ""
cboQuality.Text = Val(mystring(1))
End If

   If Mid$(dati, 1, 5) = "nuovo" Then
   On Error Resume Next
         Kill "C:\imm.bmp"
         Kill "C:\imm.jpg"
         Kill (App.Path & "\imm.zip")
         DoEvents
         Winsock2(Index).SendData ("apri" & vbCrLf)
         Call keybd_event(VK_SNAPSHOT, 0, 0, 0)
         DoEvents
         SavePicture Clipboard.GetData(vbCFBitmap), "C:\imm.bmp"
         If BMPToJPG("C:\imm.bmp", "C:\imm.jpg", cboQuality) <> 0 Then: 'CONVERSIONE
         Kill ("C:\imm.bmp")
         DoEvents
         sFile = "C:\imm.jpg"
         With m_cZ
         DoEvents
        .ZipFile = App.Path & "\imm.zip"
        .StoreFolderNames = False
        .RecurseSubDirs = False
        .ClearFileSpecs
        .AddFileSpec sFile
        .Zip
        DoEvents
      End With
      Kill "C:\imm.jpg"
  ' Call Winsock2(Index).SendData("apri" & vbCrLf)
    DoEvents
    Open App.Path & "\imm.zip" For Binary As #1
    ReDim immagine(0 To LOF(1) - 1)
    DoEvents
    Get #1, , immagine
    DoEvents
    Close #1
    Winsock1(1).SendData (immagine)
    DoEvents
    On Error Resume Next
    Kill (App.Path & "\imm.zip")
    End If

End Sub

************************************************** **
lato client:

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
On Error Resume Next
Dim immagine() As Byte
Call Winsock1.GetData(immagine, vbByte, vbArray)
Put #1, , immagine
DoEvents
Picture1.Refresh
End Sub

Private Sub Winsock2_DataArrival(Index As Integer, ByVal _
    bytesTotal As Long)
    On Error Resume Next
    
   Dim dati As String
   Dim prom%, over%, mess%, dirs%, numf&, numx&
   Dim zipfile$, unzipdir$
   Dim mystring
   Dim file, drive As String
     
   Call Winsock2(Index).GetData(dati, vbString)
   
   DoEvents
Form1.Width = Picture1.Width * Screen.TwipsPerPixelX + 100
Form1.Height = Picture1.Height * Screen.TwipsPerPixelY + 850
   
   If Mid$(dati, 1, 1) = "," Then
   mystring = Split(dati, ",", -1, 1)
   Text3.Text = Val(mystring(1))
   Text4.Text = Val(mystring(2))
   End If
   
      If Mid$(dati, 1, 7) = "getfile" Then
   mystring = Split(dati, "getfile", -1, 1)
   Form2.Show
   DoEvents
   Form2.List1.AddItem mystring(1)
   End If
   
   If Mid$(dati, 1, 4) = "apri" Then
   Picture1.Refresh
   DoEvents
   Kill App.Path & "\imm.zip"
   DoEvents
   Open App.Path & "\imm.zip" For Binary Access Write As #1
   Else
  ' End If
   DoEvents
   If Mid$(dati, 1, 4) = "fine" Then
   Call Winsock2(Index).SendData("nuovo" & vbCrLf)
   DoEvents
   Close #1
    DoEvents
    crlf = Chr$(13) + Chr$(10)
    Cls
    vbzipinf = ""
    vbzipnum = 0
    prom = 1  ' 1=prompt to overwrite
    over = 0  ' 1=always overwrite files
    mess = 0  ' 1=list contents of zip 0=extract
    dirs = 1  ' 1=honour zip directories
    vbzipnam.s(0) = vbNullString
    numf = 0
    vbxnames.s(0) = vbNullString
    numx = 0
    zipfile = App.Path & "\imm.zip"
    unzipdir = App.Path '&  Text2.Text
    DoEvents
    Call VBUnzip(zipfile, unzipdir, prom, over, mess, dirs, numf, numx)
    DoEvents
    Set Picture1.Picture = LoadPicture(App.Path & "\imm.jpg")
    Picture1.Refresh
    Kill (App.Path & "\imm.jpg")
    On Error Resume Next
    DoEvents
    Kill (App.Path & "\imm.zip")
    End If
   End If
'Else

   DoEvents
If Mid$(dati, 1, 3) = "dir" Then
mystring = Split(dati, "dir", -1, 1)
Toolbar2.Buttons("Cartella").ButtonMenus.Add , "h" & mystring(1), mystring(1)
DoEvents
Open App.Path & "\file.txt" For Output As #2
Close #2
DoEvents
Open App.Path & "\file.txt" For Binary Access Write As #2
Put #2, , dati
DoEvents
Close #2
'Combo1.Clear
Toolbar2.Buttons("Cartella").ButtonMenus.Clear
'Combo1.Refresh
Open App.Path & "\file.txt" For Input As #2
Do Until EOF(2)
Line Input #2, file
mystring = Split(file, "dir", -1, 1)
DoEvents
'Combo1.AddItem mystring(1)
Toolbar2.Buttons("Cartella").ButtonMenus.Add , "h" & mystring(1), mystring(1)
Loop
DoEvents
Close #2
Kill App.Path & "\file.txt"
'Else
End If
DoEvents
If Mid$(dati, 1, 6) = "drive2" Then
Open App.Path & "\drive.txt" For Output As #3
Close #3
DoEvents
Open App.Path & "\drive.txt" For Binary Access Write As #3
Put #3, , dati
DoEvents
Close #3
'Combo2.Clear
Toolbar3.Buttons("Drive").ButtonMenus.Clear
'Combo1.Refresh
Open App.Path & "\drive.txt" For Input As #3
Do Until EOF(3)
Line Input #3, drive
mystring = Split(drive, "drive2", -1, 1)
DoEvents
'Combo2.AddItem mystring(1)
DoEvents
Toolbar3.Buttons("Drive").ButtonMenus.Add , "d" & mystring(1), mystring(1)
Loop
DoEvents
Close #3
Kill App.Path & "\drive.txt"
 End If