[VB6]Winsock: DataArrival

**x69asterix** · 11-04-2007, 12:35

mi spiegate se questa procedura è corretta?
praticamente lato client:

codice:

 Private Sub Winsock2_DataArrival(Index As Integer, ByVal _
    bytesTotal As Long)

Dim dati As String
 Dim s() As Byte
   Call Winsock2(Index).GetData(dati)
  
   If Left(dati, 1) = "b" Then
   Open App.Path & "\toolbar.zip" For Binary Access Write As #4
      Put #4, , s
      End If

     If Left(dati, 1) = "f" Then
     Close #4
     End If
End Sub

**oregon** · 11-04-2007, 13:39

Cosi' come la presenti non ha senso ...

Utilizzi l'array s scrivendolo sul file ma non gli hai mai assegnato dei dati ...

**x69asterix** · 11-04-2007, 14:10

Private Sub Winsock2_DataArrival(Index As Integer, ByVal _
bytesTotal As Long)

Dim dati As String
Dim s() As Byte
Call Winsock2(Index).GetData(dati)

If Left(dati, 1) = "b" Then
Call Winsock2(Index).GetData(s)
Open App.Path & "\toolbar.zip" For Binary Access Write As #4
Put #4, , s
End If

If Left(dati, 1) = "f" Then
Close #4
End If
End Sub

sono in confusione

**xegallo** · 11-04-2007, 14:30

si ma quando hai fatto il primo getdata svuoti il buffer del socket è chiaro dento s() non mette niente

**oregon** · 11-04-2007, 14:54

Originariamente inviato da x69asterix
Private Sub Winsock2_DataArrival(Index As Integer, ByVal _
bytesTotal As Long)

Dim dati As String
Dim s() As Byte
Call Winsock2(Index).GetData(dati)

If Left(dati, 1) = "b" Then
Call Winsock2(Index).GetData(s)
Open App.Path & "\toolbar.zip" For Binary Access Write As #4
Put #4, , s
End If

If Left(dati, 1) = "f" Then
Close #4
End If
End Sub

sono in confusione

Come gia' detto da xegallo, se ricevi i dati nella stringa, la prossima GetData non ti dara' nulla ...

Purtroppo non ti posso "chiarire" la confusione che hai perche' tutto dipende dall'algoritmo che hai implementato tra il client e il server ...

**x69asterix** · 11-04-2007, 15:43

ma in questo caso, i dati come devono essere letti in stringa o in byte

**oregon** · 11-04-2007, 16:34

Ma "in questo caso" , "quale caso"? Ti ho detto che tutto dipende da

1) cosa vuoi fare

2) come lo fai lato client e lato server (ovvero, quale algoritmo hai pensato di implementare ...)

**x69asterix** · 12-04-2007, 08:15

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

codice:

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:

codice:

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

**oregon** · 12-04-2007, 09:03

E' sempre il solito problema di cui abbiamo discusso piu' e piu' volte ...

Ti avevo gia' risposto ... devi implementare un protocollo applicativo che permetta al server di stabilire sempre che tipo di dati sta ricevendo.

P.S. Questo programma somiglia ad un trojan ...

**alka** · 15-04-2007, 19:17

Si è già discusso ampiamente del problema in questa discussione. Inutile aprirne un'altra sullo stesso argomento.

Discussione: [VB6]Winsock: DataArrival

Strumenti discussione

Ricerca discussione

Visualizza

[VB6]Winsock: DataArrival

Moderazione

Permessi di invio