home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 4_2005-2006.ISO / data / Zips / im_MX_Reco1928578292005.psc / frmMXRecord.frm < prev    next >
Text File  |  2005-08-30  |  4KB  |  163 lines
  1. VERSION 5.00
  2. Begin VB.Form frmMXRecord 
  3.    BorderStyle     =   1  'Fixed Single
  4.    Caption         =   "InforMßs MXRecord Class Test"
  5.    ClientHeight    =   3612
  6.    ClientLeft      =   42
  7.    ClientTop       =   336
  8.    ClientWidth     =   5670
  9.    LinkTopic       =   "Form1"
  10.    MaxButton       =   0   'False
  11.    MinButton       =   0   'False
  12.    ScaleHeight     =   3612
  13.    ScaleWidth      =   5670
  14.    StartUpPosition =   3  'Windows Default
  15.    Begin VB.Frame Frame1 
  16.       Caption         =   "Enter email or Domain to search, press enter"
  17.       Height          =   795
  18.       Left            =   60
  19.       TabIndex        =   1
  20.       Top             =   60
  21.       Width           =   5535
  22.       Begin VB.TextBox txtDomain 
  23.          Height          =   315
  24.          Left            =   120
  25.          TabIndex        =   2
  26.          Text            =   "txtDomain"
  27.          Top             =   300
  28.          Width           =   5175
  29.       End
  30.    End
  31.    Begin VB.ListBox lstMXInfo 
  32.       Height          =   2576
  33.       IntegralHeight  =   0   'False
  34.       Left            =   60
  35.       TabIndex        =   0
  36.       Top             =   960
  37.       Width           =   5535
  38.    End
  39. End
  40. Attribute VB_Name = "frmMXRecord"
  41. Attribute VB_GlobalNameSpace = False
  42. Attribute VB_Creatable = False
  43. Attribute VB_PredeclaredId = True
  44. Attribute VB_Exposed = False
  45. Option Explicit
  46. '---------------------------------------------------------------------------------------
  47. ' Form          : frmMXRecord
  48. ' Date          : 29/Ago/2005 23:40
  49. ' Author        : Jorge Colaccini (JRC) <software(AT)informas.com>
  50. ' Purpose       : To test imMXRecord Class
  51. '---------------------------------------------------------------------------------------
  52. '
  53.  
  54. Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
  55.         (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
  56.         lParam As Any) As Long
  57.  
  58. Private Const LB_SETTABSTOPS = &H192
  59.  
  60. Private Sub Form_Load()
  61.  
  62.  
  63.     With Me
  64.         .Left = (Screen.Width - .Width) / 2
  65.         .Top = (Screen.Height - .Height) / 2
  66.         .txtDomain.Text = "elserver.com.ar" ' vbNullString
  67.         .lstMXInfo.Clear
  68.         .Show
  69.         .Refresh
  70.     End With
  71.     
  72.     
  73.     SetLBTabs lstMXInfo, 15, 64, 190
  74.     
  75.     txtDomain.SetFocus
  76.  
  77. End Sub
  78.  
  79.  
  80. Private Sub Form_Unload(Cancel As Integer)
  81.     Unload Me
  82. End Sub
  83.  
  84. Private Sub txtDomain_KeyPress(KeyAscii As Integer)
  85.  
  86.     Dim i   As Integer
  87.     Dim SMXdomain As String
  88.     Dim sAllMXDomains() As String
  89.     
  90.     On Error GoTo Err_MXQuery
  91.     
  92.     If KeyAscii <> 13 Then Exit Sub
  93.     KeyAscii = 0
  94.     
  95.  
  96.     lstMXInfo.Clear
  97.     Screen.MousePointer = vbHourglass
  98.     
  99.     Dim cMXRecord As imMXRecord
  100.     Set cMXRecord = New imMXRecord
  101.     
  102.     
  103.     If cMXRecord.Initialized Then
  104.         cMXRecord.Timeout = 1500 ' 1.5 seconds for timeout
  105.         'Retrieve the best MX Domain
  106.         SMXdomain = cMXRecord.MXRecord(txtDomain.Text)
  107.         lstMXInfo.AddItem "MXDomain: " & SMXdomain & " - IP: " & cMXRecord.GetIPfromHostname(SMXdomain)
  108.         lstMXInfo.AddItem ""
  109.         sAllMXDomains = cMXRecord.MXRecordList(txtDomain.Text)
  110.         
  111.         
  112.         If cMXRecord.Count > 0 Then
  113.           For i = 0 To cMXRecord.Count - 1
  114.             lstMXInfo.AddItem "MXDomain: (" & Format$(i, "00") & ") " & sAllMXDomains(0, i) & " - IP: " & cMXRecord.GetIPfromHostname(sAllMXDomains(0, i)) & " - pref: " & sAllMXDomains(1, i)
  115.           Next
  116.         End If
  117.     End If
  118. Exit_KeyPress:
  119.  
  120.     
  121.     Set cMXRecord = Nothing
  122.     
  123.     Screen.MousePointer = vbNormal
  124.  
  125.     Exit Sub
  126.  
  127. Err_MXQuery:
  128.  
  129.     Screen.MousePointer = vbNormal
  130.     MsgBox cMXRecord.LastErrorMsg   'Err.Description
  131.     GoTo Exit_KeyPress
  132. End Sub
  133.  
  134.  
  135. Private Sub SetLBTabs(LB As ListBox, ParamArray TabStops())
  136.  
  137.  
  138.     Dim aNewTabs()      As Long
  139.     Dim lCtr            As Long
  140.     Dim lTabs           As Long
  141.     Dim lRet            As Long
  142.  
  143.     On Local Error GoTo Err_LBTabs:
  144.  
  145.     ReDim aNewTabs(UBound(TabStops)) As Long
  146.  
  147.     For lCtr = 0 To UBound(TabStops)
  148.         aNewTabs(lCtr) = TabStops(lCtr)
  149.     Next
  150.  
  151.     lTabs = UBound(aNewTabs) + 1
  152.  
  153.     LB.SetFocus
  154.     
  155.     lRet = SendMessage(LB.hwnd, LB_SETTABSTOPS, lTabs, aNewTabs(0))
  156.   
  157.     Exit Sub
  158.  
  159. Err_LBTabs::
  160.  
  161. End Sub
  162.  
  163.