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.
-Odracuonogakomijedrpiorazmaknicu.
-Ne rxdi mi txstxturx, kxd god hocu dx
ukucxm "x" onx ukucx "x".
-Ko kaaz e da ja neuummem da kuuca
m.
-Piše "Insert disk 3", a jedva sam i ova
dva ugurao u drajv
-Postoje samo dve osobe kojima
verujem, jedna sam ja, a druga nisi ti