home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / networ1a / mail.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-07-16  |  8.6 KB  |  267 lines
  1. VERSION 5.00
  2. Object = "{FFACF7F3-B868-11CE-84A8-08005A9B23BD}#1.7#0"; "DSSOCK32.OCX"
  3. Begin VB.Form Form2 
  4.    BorderStyle     =   3  'Fixed Dialog
  5.    Caption         =   "SMTP Mail Example"
  6.    ClientHeight    =   3105
  7.    ClientLeft      =   3675
  8.    ClientTop       =   3375
  9.    ClientWidth     =   5430
  10.    LinkTopic       =   "Form2"
  11.    MaxButton       =   0   'False
  12.    MinButton       =   0   'False
  13.    PaletteMode     =   1  'UseZOrder
  14.    ScaleHeight     =   3105
  15.    ScaleWidth      =   5430
  16.    ShowInTaskbar   =   0   'False
  17.    Begin VB.CommandButton btnSend 
  18.       Caption         =   "send mail"
  19.       Height          =   255
  20.       Left            =   4200
  21.       TabIndex        =   16
  22.       Top             =   600
  23.       Width           =   975
  24.    End
  25.    Begin VB.TextBox txStatus 
  26.       Alignment       =   2  'Center
  27.       BackColor       =   &H00C0C0C0&
  28.       BorderStyle     =   0  'None
  29.       Height          =   285
  30.       Left            =   240
  31.       TabIndex        =   14
  32.       Top             =   2760
  33.       Width           =   4935
  34.    End
  35.    Begin VB.TextBox txMessage 
  36.       Height          =   1335
  37.       Left            =   120
  38.       MultiLine       =   -1  'True
  39.       ScrollBars      =   2  'Vertical
  40.       TabIndex        =   13
  41.       Top             =   1320
  42.       Width           =   5175
  43.    End
  44.    Begin VB.TextBox txSubject 
  45.       Height          =   285
  46.       Left            =   840
  47.       TabIndex        =   11
  48.       Text            =   "wow, the subject line       (how elite)"
  49.       Top             =   720
  50.       Width           =   3135
  51.    End
  52.    Begin VB.TextBox txFrom 
  53.       Height          =   285
  54.       Left            =   2400
  55.       TabIndex        =   9
  56.       Text            =   "omg@omg.net"
  57.       Top             =   360
  58.       Width           =   1575
  59.    End
  60.    Begin VB.TextBox txTo 
  61.       Height          =   285
  62.       Left            =   360
  63.       TabIndex        =   7
  64.       Text            =   "heh@umm.com"
  65.       Top             =   360
  66.       Width           =   1455
  67.    End
  68.    Begin VB.TextBox txPassword 
  69.       Height          =   285
  70.       IMEMode         =   3  'DISABLE
  71.       Left            =   4560
  72.       PasswordChar    =   "*"
  73.       TabIndex        =   5
  74.       Text            =   "password"
  75.       Top             =   0
  76.       Width           =   855
  77.    End
  78.    Begin VB.TextBox txUser 
  79.       Height          =   285
  80.       Left            =   2760
  81.       TabIndex        =   1
  82.       Text            =   "user"
  83.       Top             =   0
  84.       Width           =   855
  85.    End
  86.    Begin VB.TextBox txHost 
  87.       Height          =   285
  88.       Left            =   960
  89.       TabIndex        =   0
  90.       Text            =   "mail server"
  91.       Top             =   0
  92.       Width           =   1215
  93.    End
  94.    Begin dsSocketLib.dsSocket dsSocket1 
  95.       Height          =   420
  96.       Left            =   4320
  97.       TabIndex        =   15
  98.       Top             =   840
  99.       Width           =   420
  100.       _Version        =   65543
  101.       _ExtentX        =   741
  102.       _ExtentY        =   741
  103.       _StockProps     =   64
  104.       LocalPort       =   0
  105.       RemoteHost      =   ""
  106.       RemotePort      =   0
  107.       ServiceName     =   ""
  108.       RemoteDotAddr   =   ""
  109.       Linger          =   -1  'True
  110.       Timeout         =   10
  111.       LineMode        =   0   'False
  112.       EOLChar         =   10
  113.       BindConnect     =   0   'False
  114.       SocketType      =   0
  115.    End
  116.    Begin VB.Label Label7 
  117.       BackStyle       =   0  'Transparent
  118.       Caption         =   "message:"
  119.       Height          =   255
  120.       Left            =   120
  121.       TabIndex        =   12
  122.       Top             =   1080
  123.       Width           =   735
  124.    End
  125.    Begin VB.Label Label6 
  126.       BackStyle       =   0  'Transparent
  127.       Caption         =   "subject:"
  128.       Height          =   255
  129.       Left            =   120
  130.       TabIndex        =   10
  131.       Top             =   720
  132.       Width           =   735
  133.    End
  134.    Begin VB.Label Label5 
  135.       BackStyle       =   0  'Transparent
  136.       Caption         =   "from:"
  137.       Height          =   255
  138.       Left            =   1920
  139.       TabIndex        =   8
  140.       Top             =   360
  141.       Width           =   495
  142.    End
  143.    Begin VB.Label Label4 
  144.       BackStyle       =   0  'Transparent
  145.       Caption         =   "to:"
  146.       Height          =   255
  147.       Left            =   120
  148.       TabIndex        =   6
  149.       Top             =   360
  150.       Width           =   255
  151.    End
  152.    Begin VB.Label Label3 
  153.       BackStyle       =   0  'Transparent
  154.       Caption         =   "password:"
  155.       Height          =   255
  156.       Left            =   3720
  157.       TabIndex        =   4
  158.       Top             =   0
  159.       Width           =   855
  160.    End
  161.    Begin VB.Label Label2 
  162.       BackStyle       =   0  'Transparent
  163.       Caption         =   "user:"
  164.       Height          =   255
  165.       Left            =   2280
  166.       TabIndex        =   3
  167.       Top             =   0
  168.       Width           =   495
  169.    End
  170.    Begin VB.Label Label1 
  171.       BackStyle       =   0  'Transparent
  172.       Caption         =   "mail server:"
  173.       Height          =   255
  174.       Left            =   0
  175.       TabIndex        =   2
  176.       Top             =   0
  177.       Width           =   975
  178.    End
  179. Attribute VB_Name = "Form2"
  180. Attribute VB_GlobalNameSpace = False
  181. Attribute VB_Creatable = False
  182. Attribute VB_PredeclaredId = True
  183. Attribute VB_Exposed = False
  184. Private Sub btnSend_Click()
  185.     dsSocket1.RemotePort = 25 ' set port
  186.     dsSocket1.RemoteHost = txHost ' set mail server
  187.     dsSocket1.Connect  ' connect to server
  188. End Sub
  189. Private Sub dsSocket1_Receive(ReceiveData As String)
  190.     '   this is the main processing code for
  191.     '   sending an email message
  192.     '   the iState variable maintains the current
  193.     '   state of the protocol exchange so that we
  194.     '   know what to send next
  195.     Static iState       As Integer
  196.     Dim iMsgNum         As Integer
  197.     Dim szMsg           As String
  198.     Dim i               As Integer
  199.     iMsgNum = Val(Left(ReceiveData, InStr(ReceiveData, " ")))
  200.     Select Case iMsgNum
  201.         Case 220    '   initial message
  202.             dsSocket1.Send = "HELO " & txHost & vbCrLf
  203.             txStatus = "Mail Server is ready"
  204.             iState = 1
  205.             
  206.         Case 221
  207.             If iState = 999 Then
  208.                 txStatus = "Disconnected from mail server after error"
  209.             Else
  210.                 txStatus = "Disconnected from mail server"
  211.             End If
  212.             iState = 0
  213.             
  214.         Case 250
  215.             Select Case iState
  216.                 Case 1:
  217.                     dsSocket1.Send = "MAIL FROM:<" & txFrom & ">" & vbCrLf
  218.                     Debug.Print "MAIL FROM:<" & txFrom & ">" & vbCrLf
  219.                     txStatus = "Sending FROM tag"
  220.                     iState = 2
  221.                 
  222.                 Case 2:
  223.                     dsSocket1.Send = "RCPT TO:<" & txTo & ">" & vbCrLf
  224.                     Debug.Print "RCPT TO:<" & txTo & ">" & vbCrLf
  225.                     txStatus = "Sending RCPT tag"
  226.                     iState = 3
  227.                     
  228.                 Case 3:
  229.                     dsSocket1.Send = "DATA" & vbCrLf
  230.                     Debug.Print "DATA" & vbCrLf
  231.                     txStatus = "Sending DATA tag"
  232.                     iState = 4
  233.                     
  234.                 Case 5:
  235.                     dsSocket1.Send = "QUIT" & vbCrLf
  236.                     Debug.Print "QUIT" & vbCrLf
  237.                     txStatus = "Disconnecting from mail server"
  238.                     iState = 6
  239.                     
  240.                 End Select
  241.                 
  242.         Case 354
  243.             iState = 5
  244.             szMsg = txMessage
  245.             txStatus = "Sending mail message data"
  246.             dsSocket1.Send = "Subject: " & txSubject & vbCrLf
  247.             dsSocket1.Send = szMsg
  248.             'While szMsg <> ""
  249.                 'dsSocket1.Send = Left(szMsg, InStr(szMsg, Chr(10)))
  250.                 'Debug.Print "Sending:" & Left(szMsg, InStr(szMsg, Chr(10)))
  251.                 'szMsg = Mid(szMsg, InStr(szMsg, Chr(10)) + 1)
  252.                 'Wend
  253.             dsSocket1.Send = "." & vbCrLf
  254.             
  255.         Case 500 To 599
  256.             dsSocket1.Send = "QUIT" & vbCrLf
  257.             txStatus = "Error sending mail"
  258.             Debug.Print "Error sending mail.  Quitting"
  259.             iState = 999
  260.             
  261.         End Select
  262. End Sub
  263. Private Sub dsSocket1_SendReady()
  264.     '   the mail server connection is ready for data
  265.     txStatus = "Connected to mail server"
  266. End Sub
  267.