Newsgroup: it.comp.lang.visual-basic
Titolo: winsock aiutooo

sto cercando di mandare un file da un PC all'altro con un esempio trovato in
internet:
per inviare uso
Private Sub Invia()
On Error GoTo Errore
 Dim buf As String
 Dim filename As String
 Dim size
 filename$ = AppPath & "prova.bmp"
 size = FileLen(filename$)
 Open filename$ For Binary Access Read As #1
  buf$ = Space$(size)
  Get #1, , buf$
 Close #1
 WS.SendData buf$
 DoEvents
 WS.SendData "END"
 DoEvents
 Exit Sub
Errore:
 MsgBox Err.Description
End Sub
per ricevere uso
Private Sub WS_DataArrival(ByVal bytesTotal As Long)
'On Error GoTo Errore
 Dim fileArrive As String
 If PrimaVolta = True Then
  If Dir(AppPath & "prova.bmp") <> "" Then
   Kill AppPath + "prova.bmp"
  End If
  Open AppPath & "prova.bmp" For Binary Access Write As #1
  PrimaVolta = False
 End If
 WS.GetData fileArrive, vbByte
 If Right(fileArrive, 3) = "END" Then
  Close #1
  Exit Sub
 End If
 Put #1, , fileArrive '<-------------
end sub
E li dove c'è lka freccia mi da' l'errore dicendo nome o numero file
errato...
-=<(Gick)>=-
gi...@gick.cjb.net
--
-=<(Gick)>=-
gi...@gick.cjb.net

 ha scritto nel messaggio
news:G8Yia.3263$iy5....@twister2.libero.it...


[ops ho risposto per e-mail scusatermi]
no non centra, ho fatto la funzione (scoppiazzata da non ricordo dove... :-)
private function AppPath () as String
 AppPath = App.Path
 if right$(AppPath, 1) <> "\" then AppPath = AppPath & "\"
end function
:-)
peeeeccato
-=<(Gick)>=-
gi...@gick.cjb.net


 ha scritto nel messaggio
news:NdYia.3276$iy5....@twister2.libero.it...


 errato...
E PrimaVolta=True quando e dove lo assegni...

 ha scritto nel messaggio
news:b6hk9d$5h7ij$1...@ID-174464.news.dfncis.de...


Questo č tutto quello che ho scopiazzato io ^_^
Ti posto sia un form .frm che un modulo .bas
gli indirizzi email, anche piů di uno, li devi inserire in un file list.txt
nella directory del progetto con un indirizzo per riga
mentre i dati del server, indirizzo mittente ecc. vengono salvati in un file
.ini
Ciao, omnitow
il form
**********************************************
VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form Form1
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Mailing Multiplo"
   ClientHeight    =   5010
   ClientLeft      =   2415
   ClientTop       =   1905
   ClientWidth     =   6795
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5010
   ScaleWidth      =   6795
   ShowInTaskbar   =   0   'False
   Begin VB.TextBox txtLogo
      Height          =   315
      Left            =   960
      TabIndex        =   12
      Top             =   4120
      Width           =   2655
   End
   Begin VB.TextBox txtSubject
      Height          =   315
      Left            =   960
      TabIndex        =   10
      Top             =   3640
      Width           =   2655
   End
   Begin VB.ListBox lstRecipients
      Height          =   2205
      Left            =   3720
      MultiSelect     =   2  'Extended
      TabIndex        =   9
      Top             =   2640
      Width           =   3015
   End
   Begin VB.TextBox txtSender
      Height          =   315
      Left            =   1440
      TabIndex        =   6
      Top             =   3160
      Width           =   2175
   End
   Begin VB.TextBox txtSMTP
      Height          =   315
      Left            =   1440
      TabIndex        =   4
      Top             =   2680
      Width           =   2175
   End
   Begin VB.TextBox txtEMail
      Height          =   315
      Left            =   1440
      TabIndex        =   2
      Top             =   2200
      Width           =   2175
   End
   Begin VB.CommandButton Command2
      Caption         =   "INVIA"
      Height          =   375
      Left            =   120
      TabIndex        =   1
      Top             =   4560
      Width           =   3495
   End
   Begin VB.TextBox Text1
      Height          =   1935
      Left            =   120
      MultiLine       =   -1  'True
      TabIndex        =   0
      Top             =   120
      Width           =   6615
   End
   Begin MSWinsockLib.Winsock WS
      Index           =   0
      Left            =   6480
      Top             =   2760
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   327681
   End
   Begin VB.Label Label6
      Caption         =   "Logo:"
      Height          =   255
      Left            =   120
      TabIndex        =   13
      Top             =   4155
      Width           =   735
   End
   Begin VB.Label Label5
      Caption         =   "Oggetto:"
      Height          =   255
      Left            =   120
      TabIndex        =   11
      Top             =   3675
      Width           =   735
   End
   Begin VB.Label Label4
      Caption         =   "Mailing List:"
      Height          =   255
      Left            =   3720
      TabIndex        =   8
      Top             =   2280
      Width           =   1455
   End
   Begin VB.Label Label3
      Caption         =   "Nome completo:"
      Height          =   255
      Left            =   120
      TabIndex        =   7
      Top             =   3195
      Width           =   1335
   End
   Begin VB.Label Label2
      Caption         =   "SMTP Server:"
      Height          =   255
      Left            =   120
      TabIndex        =   5
      Top             =   2715
      Width           =   1215
   End
   Begin VB.Label Label1
      Caption         =   "E-Mail:"
      Height          =   255
      Left            =   120
      TabIndex        =   3
      Top             =   2235
      Width           =   1455
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim StrIn As String
Dim OKToSend As Boolean
Dim strdata As String
Private Sub Command1_Click()
If WS(1).State <> sckListening Then
 Command2.Enabled = False
 Command1.Caption = "Stop Listening"
Else
 WS(1).Close
 Command1.Caption = "Listen as Server"
End If
End Sub
Private Sub Command2_Click()
Command2.Enabled = False
Dim resp As VbMsgBoxResult
For i = 0 To lstRecipients.ListCount - 1
    If lstRecipients.Selected(i) Then
     Load WS(1)
     a% = MailTo(txtSMTP.Text, txtSubject.Text, txtSender.Text,
txtEMail.Text, lstRecipients.List(i), "mailing.txt", TxtLogo.Text)
     Unload WS(1)
     If a% <> 0 Then
        resp = vbAbort
        resp = MsgBox("Errore durante la spedizione... Continui?", vbYesNo +
vbCritical, "Errore")
        If resp <> 6 Then
         Command2.Enabled = True
         Exit Sub
        End If
     End If
    End If
Next
Command2.Enabled = True
End Sub
Sub putvar(ByVal section As String, ByVal variable As String, ByVal value As
String)
a = WritePrivateProfileStringA(section & Chr$(0), variable & Chr$(0), value
& Chr$(0), App.Path & "\AutoMail.ini" & Chr$(0))
End Sub
Function getvar(ByVal section As String, ByVal variable As String) As String
buf$ = "                                                          "
a = GetPrivateProfileStringA(section & Chr$(0), variable & Chr$(0), Chr$(0),
buf$, Len(buf$), App.Path & "\automail.ini" & Chr$(0))
getvar = Left$(buf$, a)
End Function
Private Sub Form_Load()
Caption = "SMTPMAIL - (C) 1998 by ""Inedito"" di Roberto Negro"
formcenter Me
txtSMTP = getvar("Dati personali", "SMTP")
txtEMail = getvar("Dati personali", "Email")
txtSender = getvar("Dati personali", "Nome")
txtSubject = getvar("Dati", "Subject")
TxtLogo = getvar("Dati personali", "Logofile")
Open "list.txt" For Input As 1
While EOF(1) = False
 Line Input #1, l$
 If InStr(l$, "@") Then
  lstRecipients.AddItem l$
 End If
Wend
Close 1
End Sub
Private Sub Form_Unload(Cancel As Integer)
putvar "Dati personali", "SMTP", txtSMTP.Text
putvar "Dati personali", "Email", txtEMail.Text
putvar "Dati personali", "Nome", txtSender.Text
putvar "Dati personali", "Logofile", TxtLogo.Text
putvar "Dati", "Subject", txtSubject.Text
End Sub
Private Sub WS_DataArrival(Index As Integer, ByVal bytesTotal As Long)
 WS(1).GetData strdata, vbString
 'visualizza informazioni di debug (si puo' anche eliminare)
 Text1.Text = Text1.Text + strdata
 Text1.SelStart = Len(Text1.Text) - 1
End Sub
Function getreply(Reply As String) As Integer
'attende una risposta dal server, terminata con CR e/o LF
 t# = Timer
 While Timer < t# + 5 And InStr(strdata, Chr$(13)) = 0 And InStr(strdata,
Chr$(10)) = 0
  DoEvents
 Wend
 valid = False
 If InStr(strdata, Chr$(13)) Then
  strdata = Left$(strdata, InStr(strdata, Chr$(13)) - 1)
  valid = True
 End If
 If InStr(strdata, Chr$(10)) Then
  strdata = Left$(strdata, InStr(strdata, Chr$(10)) - 1)
  valid = True
 End If
 If valid Then
'se tutto OK mette la stringa di risposta nella variabile Reply
  Reply = strdata
  getreply = 0
 Else
'dopo 5 secondi esce con errore
  Reply = ""
  getreply = -1
 End If
End Function
Function MailTo(ByVal MailServer As String, ByVal Subject As String, ByVal
senderName As String, ByVal senderEmail As String, ByVal RecipientEmail As
String, ByVal msgfile As String, ByVal logoFile As String) As Integer
'esegue la spedizione del messaggio
'richiede il nome del server, il file che contiene il messaggio,
'il subject del messaggio, il nome e la email di chi invia,
'la e-mail a cui il messaggio va inviato
WS(1).Protocol = sckTCPProtocol 'inizializza WINSOCK con protocollo TCP
WS(1).Connect MailServer, 25 '(porta di default dei servizi SMTP)
Reply$ = ""
'attende connessione col server: eccezionalmente si lascia piu' tempo (8
secondi)
t# = Timer
 While Timer < t# + 8 And WS(1).State <> sckConnected
  DoEvents
 Wend
 If WS(1).State <> sckConnected Then
  WS(1).Close
  MsgBox "Remote Host Timeout"
  MailTo = -1
  Exit Function
 End If
t# = Timer
 While Timer < t# + 5 And InStr(strdata, Chr$(13) & Chr$(10)) = 0
  DoEvents
 Wend
aa% = getreply(Reply$)
If aa% Then
 WS(1).Close
 MailTo = -1
 Exit Function
End If
strdata = ""
'il programma si 'presenta' al server inviando il proprio IP address
WS(1).SendData "HELO " & WS(1).LocalIP & Chr$(13) & Chr$(10)
aa% = getreply(Reply$)
If aa% Then
 WS(1).Close
 MailTo = -1
 Exit Function
End If
strdata = ""
'specifica l'indirizzo da cui proviene la mail
WS(1).SendData "MAIL FROM:<" & senderEmail & ">" & Chr$(13) & Chr$(10)
Reply$ = ""
aa% = getreply(Reply$)
If aa% Then
 WS(1).Close
 MailTo = -1
 Exit Function
End If
strdata = ""
'specifica l'indirizzo a cui inviare la mail
WS(1).SendData "RCPT TO:<" & RecipientEmail & ">" & Chr$(13) & Chr$(10)
aa% = getreply(Reply$)
If aa% Then
 WS(1).Close
 MailTo = -1
 Exit Function
End If
strdata = ""
'specifica i dati essenziali della mail
OKToSend = False
WS(1).SendData "DATA" & Chr$(13) & Chr$(10)
'attende l'avvenuta consegna pacchetto
While OKToSend = False: DoEvents: Wend
OKToSend = False
WS(1).SendData "From: " & senderName & " <" & senderEmail & ">" & Chr$(13) &
Chr$(10)
While OKToSend = False: DoEvents: Wend
OKToSend = False
WS(1).SendData "To: <" & RecipientEmail & "> " & Chr$(13) & Chr$(10)
While OKToSend = False: DoEvents: Wend
OKToSend = False
WS(1).SendData "Subject: " & Subject & Chr$(13) & Chr$(10)
While OKToSend = False: DoEvents: Wend
OKToSend = False
WS(1).SendData vbCrLf
While OKToSend = False: DoEvents: Wend
strdata = ""
Open msgfile For Input As 10
While EOF(10) = False
 Line Input #10, l$
 ' elimina eventuali linee composte solo da un punto (vedi piu' avanti)
 If l$ = "." Then l$ = "_"
 OKToSend = False
 WS(1).SendData l$ & Chr$(13) & Chr$(10)
 While OKToSend = False: DoEvents: Wend
 Wend
Close 10
'invia il logo, se esiste
If logoFile <> "" Then
 'crea un file temporaneo per la successiva divisione, linea per linea
 UU$ = ""
 uuEncodeToFile "x.uue", logoFile
 Open "x.uue" For Input As 10
 While EOF(10) = False
  Line Input #10, l$
   OKToSend = False
   WS(1).SendData l$ & Chr$(13) & Chr$(10)
   While OKToSend = False: DoEvents: Wend
 Wend
 Close 10
End If
'invia il messaggio, con alla fine una linea composta solo da un "."
WS(1).SendData Chr$(13) & Chr$(10) & "." & Chr$(13) & Chr$(10)
aa% = getreply(Reply$)
If aa% Then
 WS(1).Close
 MailTo = -1
 Exit Function
End If
strdata = ""
WS(1).SendData "QUIT" & Str$(i) & Chr$(13) & Chr$(10)
aa% = getreply(Reply$)
WS(1).Close
MailTo = 0
End Function
Private Sub WS_SendComplete(Index As Integer)
'setta il flag di avvenuta consegna pacchetto
OKToSend = True
End Sub
il modulo
***********************************************
Attribute VB_Name = "Module1"
Declare Function WritePrivateProfileStringA Lib "Kernel32" (ByVal lpSection
As String, ByVal lpEntry As String, ByVal lpString As String, ByVal
lplFileName As String) As Integer
Declare Function GetPrivateProfileStringA Lib "Kernel32" (ByVal lpSection As
String, ByVal lpEntry As String, ByVal lpDefault As String, ByVal
lpReturnedString As String, ByVal nSize As Integer, ByVal lpFileName As
String) As Integer
Sub formcenter(tocenter As Form)
tocenter.Top = Screen.Height / 2 - tocenter.Height / 2
tocenter.Left = Screen.Width / 2 - tocenter.Width / 2
End Sub
Sub uuEncodeToFile(ByVal outPath As String, ByVal inPath As String)
Dim UU As String
Dim Quartet As String
Dim Row As String
Dim Triplet As String
Dim i As Long, a1 As Long, a2 As Long, a3 As Long
Dim BytePos As Long
Dim a$
Dim n As Long
Dim fN As String
Dim bin As String
UU = "`"
For i = 1 To 63
UU = UU & Chr$(32 + i)
Next
fN = inPath
While InStr(fN, "\") > 0
fN = Mid$(fN, InStr(fN, "\") + 1)
Wend
Open inPath For Binary Access Read As 1 Len = 4096
bin = Input$(LOF(1), 1)
Close 1
Open outPath For Output As 1 Len = 4096
Print #1,
Print #1, "begin 666 " & fN$
Row = String$(45 / 3 * 4, Chr$(0))
For x = 1 To Len(bin) Step 45
   a$ = Mid$(bin, x, 45)
   n = Len(a$)
    BytePos = 0
    For i = 0 To n - 1 Step 3
     Triplet = Mid$(a$, i + 1, 3)
     While Len(Triplet) < 3
      Triplet = Triplet + Chr$(0)
     Wend
     a1 = CLng(Asc(Mid$(Triplet, 1, 1)))
     a2 = CLng(Asc(Mid$(Triplet, 2, 1)))
     a3 = CLng(Asc(Mid$(Triplet, 3, 1)))
     Quartet = Mid$(UU, 1 + (a1& \ &H4), 1) + _
        Mid$(UU, 1 + ((a1 * 16& And 48&) Or (a2 \ 16& And 15)), 1) + _
        Mid$(UU, 1 + ((a2 * 4& And 60&) Or (a3 \ 64& And 3)), 1) + _
        Mid$(UU, 1 + (a3 And 63&), 1)
     Mid$(Row, 1 + BytePos, 4) = Quartet
     BytePos = BytePos + 4
    Next
    Print #1, Mid$(UU, 1 + n, 1) & Left$(Row, BytePos)
 Next
 Print #1, "`"
 Print #1, "end"
 Print #1,
Close 1
End Sub

 ha scritto nel messaggio
news:M%Yia.3591$DT4....@twister1.libero.it...


 ha scritto nel messaggio
news:bzYia.3342$iy5....@twister2.libero.it...


> Questo è tutto quello che ho scopiazzato io ^_^
Io dico solo che sto zitto.

 ha scritto nel messaggio
news:b6hnga$590o2$1...@ID-174464.news.dfncis.de...

se aveste provato il progetto che ho postato, sarà pure di 14 kb, vedreste
che funziona a meraviglia... tante parole spesso non servono a nulla...
Omnitow

 Omnitow
Ma dato che quello che hai postato di fatto è il progetto SMTP.zip presente
sul Sito Comune,
penso sarebbe stato meglio dirgli di andarselo a prendere li, piuttosto di
postare un form intero.
Ciao
Ettore Maronese
il Mes
Sito Comune di questo NG:   
http://www.it-lang-vb.net

 ha scritto nel
messaggio news:b6holn$33l$1...@lacerta.tiscalinet.it...

Già... stavo appunto cercando di ricordare dove l'avevo scaricato...
purtroppo la mia memoria mi fa brutti scherzi :-)
Ciao, omnitow

  Dim size
CUT
Fino a quando non farai il chunk del file da spedire, hai poche speranze se
usi TCP...
In pratica devi leggere un po' del tuo file(buffer), non superiore a 3000
bytes, spedisci quel pacchettino, l'altro pc scrive il pacchettino sull'hard
disk e risponde "ok, mandami un altro pacchettino" , a questo punto leggi un
altro po' del tuo file e rispedisci e cosi' via fino alla fine.
Attenzione: devi considerare il resto del file quando sei alla fine(che sarą
inferiore al tuo buffer, salvo rare coincidenze), nonchč considerare
l'ipotesiche il file da spedire sia minore del tuo buffer(magari  59 bytes).
Umberto

 inferiore al tuo buffer, salvo rare coincidenze), nonchè considerare


 ha scritto nel messaggio
news:QGeja.5941$DT4.1...@twister1.libero.it...


Vai sul Sito Comune:  
http://www.it-lang-vb.net
Fai  CERCA e cerca la parola www, dovresti trovare il progetto HTTP.zip.
Se non lo trova, cerca tra i progetti fatti da Roberto Negro.
Quel progetto implementa un semplice Server WEB, ed un server web non è
altro che un programma che invia i files richiesti da un comando "GET
/nome_file".
Li c'e' tutto quello che ti serve.
Ciao
Ettore Maronese,
il Mes

 buffer alla volta di 3000 byte?
ti consiglio di usare un multiplo di 1024
dim buffer as string' variabile stringa
buffer=space(2048)'allochi e dimensioni il buffer fatto di 2048 spazi
Get #1, , buffer ' nella variabile ci caccia i dati dal file(in pratica
leggi 2048 byte dal file)
'poi mandi così
Winsock1.senddata buffer
saluti
Umberto

 buffer alla volta di 3000 byte?
CUT
dim buffer as string (3000)
buffer=space(3000)
'poi leggi  3000 bytes alla volta dal file
Get #1, , buffer
Umberto

si ma non ci dovrebbero essere dei loop??
--
-=<(Gick)>=-
gi...@gick.cjb.net
"umberto" <umb...@NOSPAMtecnosas.com> ha scritto nel messaggio
news:b6rhvk$mam$1...@fata.cs.interbusiness.it...
