In Open fname for binary as #2...
Scusa, lo posto per bene:
codice:
Dim fname As String
Dim fnamea As String
Private Const chunk = 8000
Dim sz
Dim size As Integer
Private Sub cmdBrowse_Click()
cd1.ShowOpen
If vbOK Then Text1 = cd1.FileName
End Sub
Private Sub cmdConnect_Click()
WS.Connect "192.168.0.3", 2000
End Sub
Private Sub cmdExit_Click()
Dim data As String
data = "LOGOUT¤¶£" & Chr(198) & txtUsername.Text
WS.SendData data
End Sub
Private Sub cmdSend_Click()
If Text1.Text = "" Then
MsgBox "Please type the file name!!!", , "Manjit"
Exit Sub
End If
fname = Text1.Text
'checking wether the file exists
If Dir(fname) = "" Then
MsgBox "File Does not exist Exists", , "manjit"
Exit Sub 'exiting sub it file does not exists
End If
fnamea = GetFileName(Text1.Text)
'sending file name of file
Dim temp2 As String
Text4.Text = fnamea
WS.SendData "RQST¤¶£" & Chr(198) & Text4.Text
End Sub
Private Sub Command1_Click()
End Sub
Private Sub lstUsers_DblClick()
txtTo.Text = lstUsers.SelectedItem.Text
WS.SendData "SENDTO¤¶£" & Chr(198) & txtTo.Text
End Sub
Private Sub WS_Connect()
Dim data As String
data = "LOGIN¤¶£" & Chr(198) & txtUsername.Text
WS.SendData data
lstUsers.Nodes.Add , , "MAIN", "Online - " & txtUsername.Text
lstUsers.Nodes.Item(1).Expanded = True
End Sub
Private Sub WS_DataArrival(ByVal bytesTotal As Long)
Dim temp As String
Dim Func As String
Dim Dat As String
Dim data4 As String
Dim data2 As String
Dim data3 As String
Dim data5 As String
Dim data6 As String
Dim data7 As String
Dim data8 As String
WS.GetData temp
Func$ = Split(temp$, "¤¶£" & Chr(198))(0)
Dat$ = Split(temp$, "¤¶£" & Chr(198))(1)
Select Case Func$
Case Is = "NICK"
lstUsers.Nodes.Add "MAIN", tvwChild, , (Dat$)
Case Is = "SENDTO"
Text2.Text = Dat$
If Dat$ = txtUsername.Text Then
txtNumber.Text = 1
Else
txtNumber.Text = 0
End If
Case Is = "RQST" 'file request arrives
Text3.Text = Dat$
data3 = Right(Dat$, Len(Dat$) - (4)) 'Get the file name
If txtNumber.Text = 1 Then
Dim msg1 As Integer 'Stores user's selection
msg1 = MsgBox(WS.RemoteHostIP & " wants to send you file " & data3 & " accept ? ", vbYesNo, "Manjit") 'msgbox displayed
If msg1 = 6 Then 'if user selects yes
WS.SendData "okay¤¶£" & Chr(198)
cd.FileName = data3
data5 = Split(data3, ".")(1)
data6 = "*." & data5
data7 = "Orignal extension (" & data6 & ") |All Files (*.*)|*.*"
cd.Filter = data7
cd.ShowSave
data4 = cd.FileName
Else
WS.SendData "deny¤¶£" & Chr(198)
Exit Sub
End If
End If
Case Is = "okay"
send fname
Case "deny"
MsgBox "Your request to send the file " & fname & " has been denied", , "manjit"
Case Is = "EnDf"
Label1.Caption = "File revieved.Size of file : " & sz & " Kb"
MsgBox "File recieved!!!", , "Manjit"
size = 0
sz = 0
Close #1
Case Else
size = size + 1
sz = size * 8
Label1.Caption = sz & "Kb Recieved"
Put #1, , data
End Select
End Sub
Function GetFileName(attach_str As String) As String
Dim s As Integer
Dim temp As String
s = InStr(1, attach_str, "\")
temp = attach_str
Do While s > 0
temp = Mid(temp, s + 1, Len(temp))
s = InStr(1, temp, "\")
Loop
GetFileName = temp
End Function
Private Sub send(fname As String)
Text1.Enabled = False
Dim data As String
Dim a As Long
Dim data1 As String
Dim data2 As String
Open fname For Binary As #2
Do While Not EOF(2)
data = Input(chunk, #2)
Winsock1.SendData data
DoEvents
Loop
Winsock1.SendData "EnDf"
Close #2
Command2.Enabled = True
Command3.Enabled = True
Text1.Enabled = True
End Sub
Non è che l'errore potrebbe essere dato dal fatto che lo stò provando in locale, cioè solo sul mio computer?
Rispondi quotando
