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