Note: This is not the complete source code--just the main source file.
You can download the full source (with include files) from our sample code archive by clicking on the diskette icons.
VERSION 5.00
Begin VB.Form frmMain
BorderStyle = 3 'Fixed Dialog
Caption = "Hexillion ValidateEmail sample"
ClientHeight = 7176
ClientLeft = 48
ClientTop = 336
ClientWidth = 9384
ClipControls = 0 'False
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 7176
ScaleWidth = 9384
StartUpPosition = 1 'CenterOwner
Begin VB.CheckBox chkVrfy
Caption = "Try VRFY and EXPN"
Height = 495
Left = 7800
TabIndex = 31
Top = 3720
Width = 1455
End
Begin VB.TextBox txtTimeoutSmtp
Height = 285
Left = 7800
TabIndex = 27
Top = 5400
Width = 1335
End
Begin VB.TextBox txtTimeoutDns
Height = 285
Left = 7800
TabIndex = 26
Top = 4680
Width = 1335
End
Begin VB.TextBox txtMx
Height = 735
Left = 120
Locked = -1 'True
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 22
TabStop = 0 'False
Top = 2040
Width = 7215
End
Begin VB.CheckBox chkMx
Caption = "Require MX record"
Height = 495
Left = 7800
TabIndex = 7
Top = 3120
Width = 1455
End
Begin VB.CheckBox chkDomainDot
Caption = "Don't require domain dot"
Height = 375
Left = 7800
TabIndex = 6
Top = 2640
Width = 1455
End
Begin VB.ComboBox cboLevel
Height = 315
ItemData = "Main.frx":0000
Left = 7800
List = "Main.frx":000D
Style = 2 'Dropdown List
TabIndex = 5
Top = 1200
Width = 1215
End
Begin VB.CheckBox chkDomainLiterals
Caption = "Disallow domain literals"
Height = 495
Left = 7800
TabIndex = 4
Top = 2040
Width = 1455
End
Begin VB.CheckBox chkExtraText
Caption = "Allow extra text"
Height = 255
Left = 7800
TabIndex = 3
Top = 1680
Width = 1455
End
Begin VB.CommandButton cmd
Caption = "Validate"
Default = -1 'True
Height = 375
Left = 7800
TabIndex = 1
Top = 360
Width = 1215
End
Begin VB.TextBox txtIn
Height = 285
Left = 120
TabIndex = 0
Text = "test@hotmail.com"
Top = 360
Width = 7215
End
Begin VB.TextBox txtSmtp
Height = 2895
Left = 120
Locked = -1 'True
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 2
TabStop = 0 'False
Top = 3240
Width = 7215
End
Begin VB.Label Label1
Caption = "Level"
Height = 255
Index = 10
Left = 7800
TabIndex = 30
Top = 960
Width = 1455
End
Begin VB.Line Line2
BorderColor = &H80000014&
X1 = 7575
X2 = 7575
Y1 = 360
Y2 = 6120
End
Begin VB.Line Line1
BorderColor = &H80000010&
X1 = 7560
X2 = 7560
Y1 = 360
Y2 = 6120
End
Begin VB.Label Label1
Caption = "SMTP timeout (ms)"
Height = 255
Index = 9
Left = 7800
TabIndex = 29
Top = 5160
Width = 1455
End
Begin VB.Label Label1
Caption = "DNS timeout (ms)"
Height = 255
Index = 8
Left = 7800
TabIndex = 28
Top = 4440
Width = 1455
End
Begin VB.Label Label1
Caption = "Email address"
Height = 255
Index = 7
Left = 120
TabIndex = 25
Top = 120
Width = 1455
End
Begin VB.Label Label1
Caption = "SMTP session"
Height = 255
Index = 6
Left = 120
TabIndex = 24
Top = 3000
Width = 1455
End
Begin VB.Label Label1
Caption = "MX records"
Height = 255
Index = 5
Left = 120
TabIndex = 23
Top = 1800
Width = 1455
End
Begin VB.Label lblError
Height = 255
Left = 1560
TabIndex = 21
Top = 1200
Width = 2535
End
Begin VB.Label lblLevel
Height = 255
Left = 1560
TabIndex = 20
Top = 840
Width = 2535
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
Caption = "Error:"
Height = 255
Index = 4
Left = 120
TabIndex = 19
Top = 1200
Width = 1335
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
Caption = "Confidence level:"
Height = 255
Index = 3
Left = 120
TabIndex = 18
Top = 840
Width = 1335
End
Begin VB.Label Label4
BackStyle = 0 'Transparent
Caption = "HexValidEmail"
BeginProperty Font
Name = "MS Sans Serif"
Size = 7.8
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 0
Left = 120
TabIndex = 17
Top = 6360
Width = 1335
End
Begin VB.Label lblVersion
BackStyle = 0 'Transparent
Caption = "version"
Height = 255
Index = 0
Left = 1440
TabIndex = 16
Top = 6360
Width = 2655
End
Begin VB.Label lblLicenseA
BackStyle = 0 'Transparent
Caption = "licenseA"
Height = 255
Index = 0
Left = 1440
TabIndex = 15
Top = 6600
Width = 2655
End
Begin VB.Label lblLicenseB
BackStyle = 0 'Transparent
Caption = "licenseB"
Height = 255
Index = 0
Left = 1440
TabIndex = 14
Top = 6840
Width = 2655
End
Begin VB.Label lblDomain
Height = 255
Left = 5280
TabIndex = 13
Top = 1200
Width = 2055
End
Begin VB.Label lblLocalPart
Height = 255
Left = 5280
TabIndex = 12
Top = 840
Width = 2055
End
Begin VB.Label lblExtraText
Height = 255
Left = 5280
TabIndex = 11
Top = 1560
Width = 2055
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
Caption = "Domain:"
Height = 255
Index = 2
Left = 4200
TabIndex = 10
Top = 1200
Width = 975
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
Caption = "Local part:"
Height = 255
Index = 1
Left = 4200
TabIndex = 9
Top = 840
Width = 975
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
Caption = "Extra text:"
Height = 255
Index = 0
Left = 4200
TabIndex = 8
Top = 1560
Width = 975
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private m_oVE As HexValidEmailLib.Connection
Private Sub cmd_Click()
Dim ValidLevel As HexValidEmailLevel
Screen.MousePointer = vbHourglass
'// Clear outputs
lblLevel = ""
lblError = ""
lblLocalPart = ""
lblDomain = ""
lblExtraText = ""
txtMx = ""
txtSmtp = ""
DoEvents
'// Identify yourself for SMTP (use your own information here)
'// See http://www.hexillion.com/docs/guides/HexValidEmail/concepts/polite_usage.htm
m_oVE.FromDomain = "hexillion.com" '// The domain name of your machine
m_oVE.FromEmail = "HexValidEmail@hexillion.com" '// Email address of technical contact person
'// Set timeouts
m_oVE.Timeouts(hexVeTimeoutDnsTotal) = CLng(txtTimeoutDns)
m_oVE.Timeouts(hexVeTimeoutSmtpTotal) = CLng(txtTimeoutSmtp)
'// Set options
m_oVE.Options = IIf(chkExtraText, hexVeOptionAllowExtraText, 0) Or _
IIf(chkDomainLiterals, hexVeOptionDisallowDomainLiterals, 0) Or _
IIf(chkDomainDot, hexVeOptionDontRequireDomainDot, 0) Or _
IIf(chkMx, hexVeOptionRequireMx, 0) Or _
IIf(chkVrfy, hexVeOptionTryVrfyAndExpn, 0)
'// Do the validation
ValidLevel = m_oVE.Validate(txtIn, cboLevel.ItemData(cboLevel.ListIndex))
'// Set outputs
lblLevel = ValidLevel & " - " & GetVeLevelString(ValidLevel)
lblError = GetVeErrorString(m_oVE.Error)
lblLocalPart = m_oVE.LocalPart
lblDomain = m_oVE.Domain
lblExtraText = m_oVE.ExtraText
Dim s As String
Dim oMxRec As HexValidEmailLib.MxRec
Dim l As Long, lMax As Long
lMax = m_oVE.MxRecs.Count
For l = 1 To lMax
Set oMxRec = m_oVE.MxRecs(l)
s = s & oMxRec.Preference & ": " & oMxRec.Exchange & " [" & m_oVE.AddrToString(oMxRec.Addr) & "]" & vbCrLf
Next
txtMx = s
txtSmtp = m_oVE.SmtpSession
Screen.MousePointer = vbNormal
End Sub
Private Sub Form_Initialize()
Set m_oVE = New HexValidEmailLib.Connection
End Sub
Private Sub Form_Load()
cboLevel.ListIndex = 2
txtTimeoutDns = m_oVE.Timeouts(hexVeTimeoutDnsTotal)
txtTimeoutSmtp = m_oVE.Timeouts(hexVeTimeoutSmtpTotal)
'// Display version and license information
lblVersion(0) = m_oVE.Version
If hexVeErrSuccess <> m_oVE.Error Then
lblLicenseA(0) = GetLicenseErrorString(m_oVE.Error)
lblLicenseB(0) = "Evaluation expires " & m_oVE.Expires
ElseIf 0 = m_oVE.LicensedProcessors Then
lblLicenseA(0) = "Runtime license"
lblLicenseB(0) = ""
Else
lblLicenseA(0) = GetLicenseType(m_oVE.LicensedProcessors) & " license"
lblLicenseB(0) = m_oVE.LicensedUser
End If
End Sub
Private Sub Form_Terminate()
Set m_oVE = Nothing
End Sub