home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / internet / vbipsmtp / brainded.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1996-03-09  |  10.3 KB  |  322 lines
  1. VERSION 4.00
  2. Begin VB.Form frmBrainDead 
  3.    Caption         =   "Brain Dead SMTP Example"
  4.    ClientHeight    =   5700
  5.    ClientLeft      =   885
  6.    ClientTop       =   840
  7.    ClientWidth     =   7680
  8.    Height          =   6105
  9.    Icon            =   "brainded.frx":0000
  10.    Left            =   825
  11.    LinkTopic       =   "Form1"
  12.    MaxButton       =   0   'False
  13.    ScaleHeight     =   5700
  14.    ScaleWidth      =   7680
  15.    Top             =   495
  16.    Width           =   7800
  17.    Begin VB.TextBox txtSubject 
  18.       BeginProperty Font 
  19.          name            =   "MS Sans Serif"
  20.          charset         =   0
  21.          weight          =   400
  22.          size            =   9.75
  23.          underline       =   0   'False
  24.          italic          =   0   'False
  25.          strikethrough   =   0   'False
  26.       EndProperty
  27.       Height          =   420
  28.       Left            =   1935
  29.       TabIndex        =   10
  30.       Top             =   1800
  31.       Width           =   5595
  32.    End
  33.    Begin VB.TextBox txtTo 
  34.       BeginProperty Font 
  35.          name            =   "MS Sans Serif"
  36.          charset         =   0
  37.          weight          =   400
  38.          size            =   9.75
  39.          underline       =   0   'False
  40.          italic          =   0   'False
  41.          strikethrough   =   0   'False
  42.       EndProperty
  43.       Height          =   420
  44.       Left            =   1935
  45.       TabIndex        =   8
  46.       Top             =   1260
  47.       Width           =   3750
  48.    End
  49.    Begin VB.TextBox txtFrom 
  50.       BeginProperty Font 
  51.          name            =   "MS Sans Serif"
  52.          charset         =   0
  53.          weight          =   400
  54.          size            =   9.75
  55.          underline       =   0   'False
  56.          italic          =   0   'False
  57.          strikethrough   =   0   'False
  58.       EndProperty
  59.       Height          =   420
  60.       Left            =   1935
  61.       TabIndex        =   6
  62.       Top             =   720
  63.       Width           =   3750
  64.    End
  65.    Begin VB.TextBox txtServer 
  66.       BeginProperty Font 
  67.          name            =   "MS Sans Serif"
  68.          charset         =   0
  69.          weight          =   400
  70.          size            =   9.75
  71.          underline       =   0   'False
  72.          italic          =   0   'False
  73.          strikethrough   =   0   'False
  74.       EndProperty
  75.       Height          =   420
  76.       Left            =   1935
  77.       TabIndex        =   3
  78.       Top             =   180
  79.       Width           =   3750
  80.    End
  81.    Begin VB.TextBox Text1 
  82.       BeginProperty Font 
  83.          name            =   "MS Sans Serif"
  84.          charset         =   0
  85.          weight          =   400
  86.          size            =   9.75
  87.          underline       =   0   'False
  88.          italic          =   0   'False
  89.          strikethrough   =   0   'False
  90.       EndProperty
  91.       Height          =   3120
  92.       Left            =   135
  93.       MultiLine       =   -1  'True
  94.       ScrollBars      =   2  'Vertical
  95.       TabIndex        =   2
  96.       Top             =   2430
  97.       Width           =   7440
  98.    End
  99.    Begin VB.CommandButton btnSend 
  100.       Caption         =   "&Send"
  101.       BeginProperty Font 
  102.          name            =   "MS Sans Serif"
  103.          charset         =   0
  104.          weight          =   400
  105.          size            =   9.75
  106.          underline       =   0   'False
  107.          italic          =   0   'False
  108.          strikethrough   =   0   'False
  109.       EndProperty
  110.       Height          =   735
  111.       Left            =   5985
  112.       TabIndex        =   1
  113.       Top             =   180
  114.       Width           =   1545
  115.    End
  116.    Begin VB.Label Label1 
  117.       Alignment       =   1  'Right Justify
  118.       Caption         =   "Subject:"
  119.       BeginProperty Font 
  120.          name            =   "MS Sans Serif"
  121.          charset         =   0
  122.          weight          =   400
  123.          size            =   9.75
  124.          underline       =   0   'False
  125.          italic          =   0   'False
  126.          strikethrough   =   0   'False
  127.       EndProperty
  128.       Height          =   300
  129.       Index           =   3
  130.       Left            =   90
  131.       TabIndex        =   9
  132.       Top             =   1845
  133.       Width           =   1785
  134.    End
  135.    Begin VB.Label Label1 
  136.       Alignment       =   1  'Right Justify
  137.       Caption         =   "To:"
  138.       BeginProperty Font 
  139.          name            =   "MS Sans Serif"
  140.          charset         =   0
  141.          weight          =   400
  142.          size            =   9.75
  143.          underline       =   0   'False
  144.          italic          =   0   'False
  145.          strikethrough   =   0   'False
  146.       EndProperty
  147.       Height          =   300
  148.       Index           =   2
  149.       Left            =   90
  150.       TabIndex        =   7
  151.       Top             =   1305
  152.       Width           =   1785
  153.    End
  154.    Begin VB.Label Label1 
  155.       Alignment       =   1  'Right Justify
  156.       Caption         =   "From:"
  157.       BeginProperty Font 
  158.          name            =   "MS Sans Serif"
  159.          charset         =   0
  160.          weight          =   400
  161.          size            =   9.75
  162.          underline       =   0   'False
  163.          italic          =   0   'False
  164.          strikethrough   =   0   'False
  165.       EndProperty
  166.       Height          =   300
  167.       Index           =   1
  168.       Left            =   90
  169.       TabIndex        =   5
  170.       Top             =   765
  171.       Width           =   1785
  172.    End
  173.    Begin VB.Label Label1 
  174.       Alignment       =   1  'Right Justify
  175.       Caption         =   "SMTP Gateway:"
  176.       BeginProperty Font 
  177.          name            =   "MS Sans Serif"
  178.          charset         =   0
  179.          weight          =   400
  180.          size            =   9.75
  181.          underline       =   0   'False
  182.          italic          =   0   'False
  183.          strikethrough   =   0   'False
  184.       EndProperty
  185.       Height          =   300
  186.       Index           =   0
  187.       Left            =   90
  188.       TabIndex        =   4
  189.       Top             =   225
  190.       Width           =   1770
  191.    End
  192.    Begin dsSocketLib.dsSocket DSSocket1 
  193.       Height          =   420
  194.       Left            =   6885
  195.       TabIndex        =   0
  196.       Top             =   1125
  197.       Width           =   420
  198.       _version        =   65542
  199.       _extentx        =   741
  200.       _extenty        =   741
  201.       _stockprops     =   64
  202.       localport       =   0
  203.       remotehost      =   ""
  204.       remoteport      =   0
  205.       servicename     =   ""
  206.       remotedotaddr   =   ""
  207.       linger          =   -1  'True
  208.       timeout         =   10
  209.       linemode        =   0   'False
  210.       eolchar         =   10
  211.       bindconnect     =   0   'False
  212.       sockettype      =   0
  213.    End
  214. Attribute VB_Name = "frmBrainDead"
  215. Attribute VB_Creatable = False
  216. Attribute VB_Exposed = False
  217. Option Explicit
  218. '---------------------------------------------------
  219. 'BRAINDED.FRM
  220. 'Copyright 1996 by Carl Franklin
  221. 'Unauthorized reproduction in any medium of this
  222. 'source code is strictly prohibited without written
  223. 'permission from the author and John Wiley & Sons.
  224. '---------------------------------------------------
  225. Dim nConnected As Integer
  226. Const SOCK_ACTION_CONNECT = 2
  227. Const SOCK_ACTION_CLOSE = 1
  228. Private Sub btnSend_Click()
  229.     '-- Temporarily disable the button
  230.     Screen.MousePointer = vbHourglass
  231.     btnSend.Enabled = False
  232.     '-- SMTP uses port 25
  233.     DSSocket1.RemotePort = 25
  234.     '-- Is this a DOT address?
  235.     If IsDotAddress(Text1) Then
  236.         '-- Yes. Use the RemoteDotAddr property
  237.         DSSocket1.RemoteDotAddr = txtServer
  238.     Else
  239.         '-- No. Use the RemoteHost property
  240.         DSSocket1.RemoteHost = txtServer
  241.     End If
  242.     '-- Try to connect
  243.     nConnected = False
  244.     On Error Resume Next
  245.     DSSocket1.Action = SOCK_ACTION_CONNECT
  246.     If Err Then
  247.         '-- Error!
  248.         MsgBox Error, vbInformation
  249.     Else
  250.         '-- Wait until we've connected
  251.         Do
  252.             DoEvents
  253.         Loop Until nConnected
  254.         '-- Send the email
  255.         SendBrainDead DSSocket1, (txtFrom), (txtTo), (txtSubject), (Text1)
  256.         '-- Close the port and beep as an indicator
  257.         DSSocket1.Action = SOCK_ACTION_CLOSE
  258.         Beep
  259.     End If
  260.     '-- Re-enable stuff
  261.     Screen.MousePointer = vbNormal
  262.     btnSend.Enabled = True
  263. End Sub
  264. Function IsDotAddress(szAddress As String) As Integer
  265.     '-- This function determines if a string is an IP address like
  266.     '   199.200.199.120 or not
  267.     Dim nPos As Integer
  268.     Dim nIndex As Integer
  269.     Dim szSection As String
  270.     Dim szTemp As String
  271.     szTemp = szAddress
  272.     szAddress = Trim$(szAddress)
  273.     For nIndex = 1 To 3
  274.         nPos = InStr(szAddress, ".")
  275.         If nPos Then
  276.             szSection = Left$(szAddress, nPos - 1)
  277.             If Len(szSection) = 0 Then
  278.                 Exit Function
  279.             ElseIf Trim$(Str$(Val(szSection))) <> szSection Then
  280.                 Exit Function
  281.             ElseIf Val(szSection) > 255 Then
  282.                 Exit Function
  283.             ElseIf Val(szSection) < 0 Then
  284.                 Exit Function
  285.             End If
  286.             szAddress = Mid$(szAddress, nPos + 1)
  287.         Else
  288.             Exit Function
  289.         End If
  290.     Next
  291.     If Len(szAddress) = 0 Then
  292.         Exit Function
  293.     ElseIf Trim$(Str$(Val(szAddress))) <> szAddress Then
  294.         Exit Function
  295.     ElseIf Val(szAddress) > 255 Then
  296.         Exit Function
  297.     ElseIf Val(szAddress) < 0 Then
  298.         Exit Function
  299.     End If
  300.     szAddress = szTemp
  301.     IsDotAddress = True
  302. End Function
  303. Private Sub DSSocket1_Connect()
  304.     nConnected = True
  305. End Sub
  306. Sub SendBrainDead(DSSock As Control, szFrom As String, szTo As String, szSubject As String, szMsg As String)
  307. '-- This routine sends an email message via an SMTP gateway.
  308.     Dim szCRLF As String
  309.     Dim szCompleteMsg As String
  310.     '-- All lines end with a CR/LF Pair
  311.     szCRLF = Chr$(13) & Chr$(10)
  312.     szCompleteMsg = "MAIL FROM: <" & szFrom & ">" & szCRLF _
  313.        & "RCPT TO: <" & szTo & ">" & szCRLF _
  314.        & "DATA" & szCRLF _
  315.        & "DATE: " & Format$(Now, "dd mmm yy ttttt") & szCRLF _
  316.        & "FROM: " & szFrom & szCRLF _
  317.        & "TO: " & szTo & szCRLF _
  318.        & "SUBJECT: " & szSubject & szCRLF & szCRLF _
  319.        & szMsg & szCRLF & "." & szCRLF
  320.     DSSock.Send = szCompleteMsg
  321. End Sub
  322.