Spajanje 2 racunara pomocu winsock kontrola

[ Marko_L @ 15.06.2005. 17:25 ] @

Kada uspostaviš konekciju između dva kompa, fajl možeš poslati na sledeći način.Jedan komp je klijent, a drugi server...Kod za klijenta (treba ti jedna Winsock kontrola, nazovim je WskClient i jedan Command button, nazovimo ga cmdPosalji)

Code:
Dim SrcPath As String
Dim DstPath As String
Dim IsReceived As Boolean

Private Sub cmdPosalji_Click()
SrcPath = "C:\nesto.xxx" 'putanja do fajla koji se salje
DstPath = "C:\nesto.xxx" 'putanja na koju treba da se posalje fajl
WskClient.SendData "Msg_Dst_" & DstPath
End Sub

Dakle, sa ovim definišemo izvornu putanju fajla koji se šalje i destinaciju, tj. putanju na serveru gde će poslati fajl biti smešten i preko WinSock-a šaljemo zahtev.Zatim je potrebno obraditi DataArrival rutinu na klijentu

Code:
Private Sub WskClient_DataArrival(ByVal bytesTotal As Long)
    Dim recBuffer As String

    WskClient.GetData recBuffer

    Select Case Left(recBuffer, 7)
    Case "Msg_Rec"  'blok primljen
        IsReceived = True
    Case "Msg_OkS"  'sve je u redu i mozemo da zapocnemo slanje fajla
        SendFile 'pozivamo proceduru SendFile koja ce zapoceti slanje fajla ka serveru
    Case "Msg_Err"  'doslo je do greske
        MsgBox "Greska"
    End Select
End Sub

a zatim trebamo da napravimo proceduru SendFile

Code:
Private Sub SendFile()
    Dim BufFile As String
    Dim LnFile As Long
    Dim nLoop As Long
    Dim nRemain As Long
    Dim Cn As Long

    On Error GoTo error_hendler
    LnFile = FileLen(SrcPath) 'odredjujemo duzinu fajla
    If LnFile > 8192 Then 'ukoliko je duzina fajla veca od 8 kilobajta
        nLoop = Fix(LnFile / 8192) 'jedan korak jednak je ukupnoj duzini fajla podeljenim sa 8 kilobajta i dodeljujemo broj koraka promenljivoj nLoop

        nRemain = LnFile Mod 8192 'ukoliko posle deljenja ima ostatka dodljujemo ga promenljivoj nRemain
    Else 'u suprotnom
        nLoop = 0 'nema potrebe za koracima jer je fajl manji od 8 KB
        nRemain = LnFile 'ostatak je jednak celoj duzini fajla jer je fajl manji od 8 KB
    End If

    If LnFile = 0 Then 'ako nam je vracena duyina fajla 0, znaci da ne postoji fajl
        MsgBox "Nepostojeci fajl", vbCritical, "Poruka klijenta"
        Exit Sub
    End If

    Open SrcPath For Binary As #1 'otvaramo fajl
    If nLoop > 0 Then 'ako ima vise koraka
        For Cn = 1 To nLoop 'petlja koja se izvrsava onoliko puta koliko ima koraka
'procedura za slanje fajla
            BufFile = String(8192, " ")
            Get #1, , BufFile
            WskClient.SendData BufFile
            IsReceived = False
'ovde mozes da ubacis proceduru za popunjavanje progress bara ako zelis ili recimo da u nekoj labeli prikazes koliko je poslato
        While IsReceived = False
                DoEvents
            Wend
        Next
        If nRemain > 0 Then 'ako ima ostatka
'procedura za slanje ostatka
            BufFile = String(nRemain, " ")
            Get #1, , BufFile
            WskClient.SendData BufFile
            IsReceived = False
'procedura za pracenje, kao sto rekoh gore progressbar ili label ili...
            While IsReceived = False
                DoEvents
            Wend
        End If
    Else 'ukoliko je fajl koji saljemo manji od 8 KB, samo ce se ovo izvrsiti
        BufFile = String(nRemain, " ")
        Get #1, , BufFile
        WskClient.SendData BufFile
        IsReceived = False
        While IsReceived = False
            DoEvents
        Wend
    End If
    WskClient.SendData "Msg_Eof_" 'kraj fajla
    Close #1 'zatvori fajl
    Exit Sub
error_hendler:
    MsgBox Err.Description

End Sub

A sad treba da odradimo kod za server koji prima fajl.Na njemu ti treba jedna Winsock kontrola, nazovimo je WskServer

Code:
Private Sub WskServer_DataArrival(Index As Integer, ByVal bytesTotal As Long)
    Dim DstPath As String
    Dim BytesRec As Long
    Dim FL As Integer
    Dim RecBuffer As String
    Dim Ret As Integer

    On Error GoTo error_hendler

    WskServer.GetData RecBuffer
    Select Case Left(RecBuffer, 8)
        Case "Msg_Eof_" 'slucaj kada je kraj fajla
            Close #FL 'zatvori fajl
            MsgBox "Fajl primljen"
        Case "Msg_Dst_" 'slucaj kada je primljen primljen zahtev od klijenta (putanja)
            DstPath = Right(RecBuffer, Len(RecBuffer) - 8) 'primanje putanje za fajl od klijenta
            FL = FreeFile

            If Len(Dir(DstPath)) > 0 Then 'u slucaju da fajl vec postoji
                Ret = MsgBox("Ovaj fajl vec postoji!!!" & vbCrLf & " Da li zelite da ga prebrisete??", vbQuestion + vbYesNo, "TFTServer Message")
                If Ret = vbYes Then 'ako je odgovor da
                    Kill DstPath 'obrisi postojeci fajl
                Else 'a ako je ne
                    Exit Sub 'napusti proceduru
                End If
            End If
            Open DstPath For Binary As #FL 'otvori free fajl
            WskServer.SendData "Msg_OkS" 'posalji poruku klijentu da je sve ok i da slanje moze da zapocne

        Case Else 'slucaj drugi
            Put #FL, , RecBuffer 'kopiranje fajla iz bafera

            WskServer.SendData "Msg_Rec" 'posalji poruku serveru da je deo primljen i da moze sledeci ukoliko ga ima
    End Select

    Exit Sub
error_hendler:
    MsgBox Err.Description
End Sub

To je otprilike najjednostavniji način da se fajl pošalje.Naravno to sve može da se nadogradi kao što već rekoh progress barom koji će pokazivati koliki je deo fajla poslat\primljen i slični podaci.