WRITING YOUR OWN SMTP GATEWAY
by John Rodriguez (john-r@vbonline.com)
November, 1995
Type HostDataType
sName As String * 64
sIPAddr As String * 15
lTTL As Long
End Type
Type MXRecordType
uHostInfo As HostDataType
iMXPrec As Integer
End Type
Type NSRecordType
uHostInfo As HostDataType
bTried As Integer
End Type
Type OtherRecordType
uHostInfo As HostDataType
sExtra As String * 64
End Type
Type SearchType
sQHostID As String * 64 'Query Host ID
sDNSaddr As String * 15 'DNS IP Address
iRType As Integer 'RR Type
End Type
Global gUDPBuffer$ 'Buffer for the UDP control
Dim mauMXRecords() As MXRecordType
Dim mauNSRecords() As NSRecordType
Dim mauHostRecords() As HostDataType
Global Const DNS_ERR_OK = -1
Global Const DNS_ERR_NORECORDS = 0
Global Const DNS_ERR_TIMEOUT = 1
Global Const DNS_ERR_NONAMESERVERS = 2
Global Const DNS_ERR_OTHER = 3
Procedures
Function GetHostLabel (psDataGram$, piStartPnt%, psLabel$) As Integer
Dim sLabel$, iDone%, iLabelCnt%, iCurPos%, iLabelPtr%, iInPtr%
'psDataGram$ is the DataGram
'piStartPnt% is the Starting Point in the DataGram, is updated after processing
iCurPos% = piStartPnt%
'This is for our pointer in the datagram which can be moved due to compression...
iLabelCnt% = piStartPnt%
iDone% = False
While Not iDone%
'Get the count of our label
iLabelPtr% = Asc(Mid$(psDataGram$, iLabelCnt%, 1))
'Is it 0?
If iLabelPtr% = 0 Then
'Yes, if we arent in a pointed to label then increment our rRecord pointer
'to point to one past this label
If Not iInPtr% Then iCurPos% = iLabelCnt% + 1
'We're done...
iDone% = True
Else
'Is this a pointer?
If (iLabelPtr% And 192) = 192 Then
'Yes, so set our inpointer flag
If Not iInPtr% Then
iInPtr% = True
iCurPos% = iLabelCnt% + 2
End If
'If we have part of a label, append a dot
'Our pointer can only point to null terminated labels so
'our datagram pointer for the next field is 2 bytes past this pointer
'Now set our pointer to the place where the rest of the label is
iLabelCnt% = ((iLabelPtr% And 63) * 256) + Asc(Mid$(psDataGram$, iLabelCnt% + 1, 1)) + 1
Else
'Is this count below 64 characters
If iLabelPtr% < 65 Then
'If we already have a part of the label then add a dot
If sLabel$ <> "" Then sLabel$ = sLabel$ + "."
'add the characters into the field
sLabel$ = sLabel$ + Mid$(psDataGram$, iLabelCnt% + 1, iLabelPtr%)
'Increment our pointer by the number of characters we read...
iLabelCnt% = iLabelCnt% + iLabelPtr% + 1
Else
'An error because we have more characters than we are supposed to
'have for this label.. (64 characters)
GetHostLabel = DNS_ERR_OTHER
Exit Function
End If
End If
End If
Wend
piStartPnt% = iCurPos%
psLabel$ = sLabel$
GetHostLabel = True
End Function
Function GetHostsFromDNS (ctrlUDP As Control, ByVal piRecType%, ByVal psHostID$, pasDNSHost$(),
pauHostInfo() As OtherRecordType) As Integer
'Comments:
' This function retrieves the DNS records for the data I request based on the
' Type of records that I want...
Dim iNSCnt%, iMXCnt%, iCnt%, iHostCnt%, iRecCnt%, iSuc%
Dim uSearch As SearchType
On Local Error Resume Next
'Load up our DNS records...
iNSCnt% = UBound(pasDNSHost$)
If iNSCnt% = 0 Then
GetHostsFromDNS = DNS_ERR_NONAMESERVERS
Exit Function
End If
'Set up the name server array...
Erase mauNSRecords
ReDim mauNSRecords(iNSCnt%)
For iCnt% = 1 To iNSCnt%
mauNSRecords(iCnt%).uHostInfo.sIPAddr = pasDNSHost$(iCnt%)
Next
Erase mauMXRecords
Erase mauHostRecords
'Now let's do the lookup search, set our search options..
uSearch.sQHostID = LCase$(psHostID$)
uSearch.iRType = piRecType% And 255
iNSCnt% = 1
Do
'Place a DNS host in our search
uSearch.sDNSaddr = mauNSRecords(iNSCnt%).uHostInfo.sIPAddr
'Remark out this line in your application unless you wish
'to use this functionality.
PostStatusMessage "Searching from [" + RTrim$(mauNSRecords(iNSCnt%).uHostInfo.sIPAddr) + "]
for host: " + RTrim$(psHostID$)
'Get DNS Records
iSuc% = SearchDNS(ctrlUDP, uSearch)
If iSuc% = DNS_ERR_OK Then
Select Case piRecType%
Case 1, 12
iHostCnt% = UBound(mauHostRecords)
ReDim pauHostInfo(iHostCnt%)
If iHostCnt% > 0 Then
'Ok, now we need to return the host info back to the array...
For iCnt% = 1 To iHostCnt%
pauHostInfo(iCnt%).uHostInfo.sName = mauHostRecords(iCnt%).sName
pauHostInfo(iCnt%).uHostInfo.sIPAddr = mauHostRecords(iCnt%).sIPAddr
pauHostInfo(iCnt%).uHostInfo.lTTL = mauHostRecords(iCnt%).lTTL
Next
Exit Do
Else
Erase mauHostRecords
End If
Case 15
iMXCnt% = UBound(mauMXRecords)
If iMXCnt% > 0 Then
ReDim pauHostInfo(iMXCnt%)
For iCnt% = 1 To iMXCnt%
pauHostInfo(iCnt%).uHostInfo.sName = mauMXRecords(iCnt%).uHostInfo.sName
pauHostInfo(iCnt%).uHostInfo.sIPAddr = mauMXRecords(iCnt%).uHostInfo.sIPAddr
pauHostInfo(iCnt%).uHostInfo.lTTL = mauMXRecords(iCnt%).uHostInfo.lTTL
pauHostInfo(iCnt%).sExtra = Trim$(Str$(mauMXRecords(iCnt%).iMXPrec%))
Next
Exit Do
Else
Erase mauMXRecords
End If
End Select
Else
Select Case iSuc%
Case DNS_ERR_TIMEOUT
PostStatusMessage "Timeout waiting for packet response from [" + RTrim$
(mauNSRecords(iNSCnt%).uHostInfo.sIPAddr) + "]"
Case DNS_ERR_NORECORDS
PostStatusMessage "No Records from [" + RTrim$(mauNSRecords(iNSCnt%).uHostInfo.
sIPAddr) + "]"
Case DNS_ERR_OTHER
PostStatusMessage "Bad packet response from [" + RTrim$(mauNSRecords(iNSCnt%)
.uHostInfo.sIPAddr) + "]"
End Select
End If
iNSCnt% = iNSCnt% + 1
'If we don't have any left, then exit
If iNSCnt% > UBound(mauNSRecords) Then Exit Do
Loop
'Returns the count of the records in the array back to the user..
iRecCnt% = UBound(pauHostInfo)
If iRecCnt% > 0 Then GetHostsFromDNS = True
End Function
Function GetQRdata (psDataGram$, puQData As HostDataType, piDGPos%) As Integer
Dim icp%, iLabelCnt%, iDone%, sQName$
'First get the label information
icp% = piDGPos%
'We aren't done
iDone% = False
While Not iDone%
iLabelCnt% = Asc(Mid$(psDataGram$, icp%, 1))
If iLabelCnt% = 0 Then
icp% = icp% + 1
iDone% = True
Else
'Add a period to the end of the
If sQName$ <> "" Then sQName$ = sQName$ + "."
'add the characters into the field
sQName$ = sQName$ + Mid$(psDataGram$, icp% + 1, iLabelCnt%)
icp% = icp% + iLabelCnt% + 1
End If
Wend
'We can add four to the count since we have passes the QRData.
icp% = icp% + 4
piDGPos% = icp%
puQData.sName = sQName$
puQData.sIPAddr = " "
GetQRdata = True
End Function
Function GetRRData (psDataGram$, piDGPos%) As Integer
Dim sLabel$, iRType%, iGotOne%, iClass%, lTTL&, sRData$, sHostName$
Dim iCurPos%, iRDLen%, iCnt%, sPrec$, lTL1&, lTL2&, iGotIt%, sThisIP$
Dim iHostCnt%, iMXCnt%, iNSCnt%, iSuc%
On Local Error Resume Next
iHostCnt% = UBound(mauHostRecords)
iMXCnt% = UBound(mauMXRecords)
iNSCnt% = UBound(mauNSRecords)
'First get the label information - isn't important unless it is a Type A Record...
'in which we match it up with record information already in the system...
'We need this as a temporary pointer and we modify it at the end
iCurPos% = piDGPos%
'Now go after the label for this record
iSuc% = GetHostLabel(psDataGram$, iCurPos%, sLabel$)
If iSuc% <> DNS_ERR_OK Then
GetRRData = iSuc%
Exit Function
End If
'Now we need to check the type of the record
iRType% = (Asc(Mid$(psDataGram$, iCurPos%, 1)) * 256) + Asc(Mid$(psDataGram$, iCurPos% + 1, 1))
'Move us over two places
iCurPos% = iCurPos% + 2
'Get the class
iClass% = (Asc(Mid$(psDataGram$, iCurPos%, 1)) * 256) + Asc(Mid$(psDataGram$, iCurPos% + 1, 1))
'Move us over two more places
iCurPos% = iCurPos% + 2
'Get the Time to Live of the record
lTTL& = ((Asc(Mid$(psDataGram$, iCurPos%, 1)) * 256&) + Asc(Mid$(psDataGram$, iCurPos% + 1, 1))) * 65536
lTTL& = lTTL& + (Asc(Mid$(psDataGram$, iCurPos% + 2, 1)) * 256&) + Asc(Mid$(psDataGram$, iCurPos% + 3, 1))
'Now move over four places...
iCurPos% = iCurPos% + 4
' Grab the length of the RData field
iRDLen% = (Asc(Mid$(psDataGram$, iCurPos%, 1)) * 256&) + Asc(Mid$(psDataGram$, iCurPos% + 1, 1))
'Go past the RData length
iCurPos% = iCurPos% + 2
'Now get the RData itself for processing...
sRData$ = Mid$(psDataGram$, iCurPos%, iRDLen%)
'Now that we have the information set our pointer past the rData so that we can process this
Select Case iRType%
Case 1
'This is an A type record which means we have a host address for a record and
'we need to marry it up with the record that pertains to it..
'So first, we need to find the record
If Len(sRData$) = 4 Then
sThisIP$ = Trim$(Str$(Asc(Mid$(sRData$, 1, 1)))) + "."
sThisIP$ = sThisIP$ + Trim$(Str$(Asc(Mid$(sRData$, 2, 1)))) + "."
sThisIP$ = sThisIP$ + Trim$(Str$(Asc(Mid$(sRData$, 3, 1)))) + "."
sThisIP$ = sThisIP$ + Trim$(Str$(Asc(Mid$(sRData$, 4, 1))))
'Check Name Servers....
For iCnt% = 1 To iNSCnt%
If LCase$(RTrim$(mauNSRecords(iCnt%).uHostInfo.sName)) = LCase$(sLabel$) Then
If RTrim$(mauNSRecords(iCnt%).uHostInfo.sIPAddr) = "" Then
iGotOne% = iCnt%
Exit For
End If
End If
Next
If iGotOne% <> 0 Then
mauNSRecords(iGotOne%).uHostInfo.sIPAddr = sThisIP$
Else
'If we don't have a name server host, then check the MX records for
'this record.
For iCnt% = 1 To iMXCnt%
If LCase$(RTrim$(mauMXRecords(iCnt%).uHostInfo.sName)) = LCase$(sLabel$) Then
If RTrim$(mauMXRecords(iCnt%).uHostInfo.sIPAddr) = "" Then
iGotOne% = iCnt%
Exit For
End If
End If
Next
If iGotOne% <> 0 Then
'Since we got one, add the IP address to the record
mauMXRecords(iGotOne%).uHostInfo.sIPAddr = sThisIP$
Else
'If we don't have a host, then check the other records for
'this record.
For iCnt% = 1 To iHostCnt%
If LCase$(RTrim$(mauHostRecords(iCnt%).sName)) = LCase$(sLabel$) Then
If RTrim$(mauHostRecords(iCnt%).sIPAddr) = "" Then
iGotOne% = iCnt%
Exit For
End If
End If
Next
If iGotOne% <> 0 Then
'Since we got one, add the IP address to the record
mauHostRecords(iGotOne%).sIPAddr = sThisIP$
Else
'If we don't have a host for this IP address, then
'use the label sent with the record and use this
'IP address for the record and add to the host list
If iHostCnt% = 0 Then
iHostCnt% = iHostCnt% + 1
ReDim Preserve mauHostRecords(iHostCnt%)
mauHostRecords(iHostCnt%).sName = sLabel$
mauHostRecords(iHostCnt%).sIPAddr = sThisIP$
mauHostRecords(iHostCnt%).lTTL = lTTL&
End If
End If
End If
End If
iCurPos% = iCurPos% + iRDLen%
Else
GetRRData = DNS_ERR_OTHER
Exit Function
End If
Case 2
'This is a name server that we add to the list of information...
'The name server adds a name to the entry
iSuc% = GetHostLabel(psDataGram$, iCurPos%, sHostName$)
If iSuc% = DNS_ERR_OK Then
iGotIt% = False
For iCnt% = 1 To iNSCnt%
If LCase$(RTrim$(mauNSRecords(iCnt%).uHostInfo.sName)) = LCase$(sHostName$) Then
iGotIt% = True
Exit For
End If
Next
If Not iGotIt% Then
'We need to add one to the record type
iNSCnt% = iNSCnt% + 1
ReDim Preserve mauNSRecords(iNSCnt%)
mauNSRecords(iNSCnt%).uHostInfo.sName = sHostName$
mauNSRecords(iNSCnt%).uHostInfo.sIPAddr = " "
mauNSRecords(iNSCnt%).uHostInfo.lTTL = lTTL&
End If
Else
GetRRData = DNS_ERR_OTHER
Exit Function
End If
Case 5, 12
iSuc% = GetHostLabel(psDataGram$, iCurPos%, sHostName$)
If iSuc% = DNS_ERR_OK Then
iGotIt% = False
For iCnt% = 1 To iHostCnt%
If LCase$(RTrim$(mauHostRecords(iCnt%).sName)) = LCase$(sHostName$) Then
iGotIt% = True
Exit For
End If
Next
If Not iGotIt% Then
iHostCnt% = iHostCnt% + 1
ReDim Preserve mauHostRecords(iHostCnt%)
mauHostRecords(iHostCnt%).sName = sHostName$
mauHostRecords(iHostCnt%).sIPAddr = " "
mauHostRecords(iHostCnt%).lTTL = lTTL&
End If
Else
GetRRData = DNS_ERR_OTHER
Exit Function
End If
Case 15
'This is an MX record and so we need to indicate this...
sPrec$ = Mid$(psDataGram$, iCurPos%, 2)
iCurPos% = iCurPos% + 2
iSuc% = GetHostLabel(psDataGram$, iCurPos%, sHostName$)
If iSuc% = DNS_ERR_OK Then
'We need to add one to the record type
iMXCnt% = iMXCnt% + 1
ReDim Preserve mauMXRecords(iMXCnt%)
mauMXRecords(iMXCnt%).uHostInfo.sName = sHostName$
mauMXRecords(iMXCnt%).uHostInfo.sIPAddr = " "
mauMXRecords(iMXCnt%).uHostInfo.lTTL = lTTL&
mauMXRecords(iMXCnt%).iMXPrec = (Asc(Left$(sPrec$, 1)) * 256) + Asc(Right$(sPrec$, 1))
Else
GetRRData = DNS_ERR_OTHER
Exit Function
End If
End Select
piDGPos% = iCurPos%
GetRRData = True
End Function
Function ParseDataGram (psDataGram$, piRecType%) As Integer
'This procedure parses the datagram into its component parts
Dim iQdCount%, iAnCount%, iNsCount%, iArCount%
Dim iDone%, iCurPnt%, iLabelCnt%, sTemp$, iLabelpnt%
Dim iCnt%, iSuc%
Dim uQHostRecord() As HostDataType
iQdCount% = (Asc(Mid$(psDataGram$, 5, 1)) * 256) + Asc(Mid$(psDataGram$, 6, 1))
iAnCount% = (Asc(Mid$(psDataGram$, 7, 1)) * 256) + Asc(Mid$(psDataGram$, 8, 1))
iNsCount% = (Asc(Mid$(psDataGram$, 9, 1)) * 256) + Asc(Mid$(psDataGram$, 10, 1))
iArCount% = (Asc(Mid$(psDataGram$, 11, 1)) * 256) + Asc(Mid$(psDataGram$, 12, 1))
iCurPnt% = 13
If iQdCount% > 0 Then
'Let's get the question data from each record...
For iCnt% = 1 To iQdCount%
ReDim Preserve uQHostRecord(iCnt%)
If Not GetQRdata(psDataGram$, uQHostRecord(iCnt%), iCurPnt%) Then
ParseDataGram = DNS_ERR_OTHER
Exit Function
End If
Next
End If
'Now get the Answer Data...
If iAnCount% > 0 Then
For iCnt% = 1 To iAnCount%
If Not GetRRData(psDataGram$, iCurPnt%) Then
ParseDataGram = DNS_ERR_OTHER
Exit Function
End If
Next
End If
If iNsCount% > 0 Then
For iCnt% = 1 To iNsCount%
If Not GetRRData(psDataGram$, iCurPnt%) Then
ParseDataGram = DNS_ERR_OTHER
Exit Function
End If
Next
End If
If iArCount% > 0 Then
For iCnt% = 1 To iArCount%
If Not GetRRData(psDataGram$, iCurPnt%) Then
ParseDataGram = DNS_ERR_OTHER
Exit Function
End If
Next
End If
ParseDataGram = DNS_ERR_OK
End Function
Function SearchDNS (ctrlUDP As Control, search As SearchType) As Integer
Dim sLabels$(), iLblCnt%
Dim sdatagram$
Dim iDot%, done%, lTimeOut&, suc%, iCnt%
Dim xTries%, sMsgType$
Dim sID$, sHostID$
'Let's get the host ID information..
sHostID$ = RTrim$(search.sQHostID)
'Create Datagram ... does recursion by default...
sdatagram$ = Chr$(1) + String$(2, 0) + Chr$(1) + String$(6, 0)
'Ok, now parse the host information...
While InStr(sHostID$, ".") > 0
iDot% = InStr(sHostID$, ".")
iLblCnt% = iLblCnt% + 1
ReDim Preserve sLabels(iLblCnt%)
sLabels(iLblCnt%) = Left$(sHostID$, iDot% - 1)
sHostID$ = Mid$(sHostID$, iDot% + 1)
Wend
If Len(sHostID$) > 0 Then
iLblCnt% = iLblCnt% + 1
ReDim Preserve sLabels(iLblCnt%)
sLabels(iLblCnt%) = sHostID$
End If
'Now prep the host string for use in the search...
Select Case search.iRType
Case 12
If Not (iLblCnt% > 0 And iLblCnt% < 5) Then Exit Function
For iCnt% = iLblCnt% To 1 Step -1
sdatagram$ = sdatagram$ + Chr$(Len(sLabels(iCnt%))) + sLabels(iCnt%)
Next
sdatagram$ = sdatagram$ + Chr$(7) + "IN-ADDR" + Chr$(4) + "ARPA"
Case Else
For iCnt% = 1 To iLblCnt%
sdatagram$ = sdatagram$ + Chr$(Len(sLabels(iCnt%))) + sLabels(iCnt%)
Next
End Select
sdatagram$ = sdatagram$ + Chr$(0)
sdatagram$ = sdatagram$ + Chr$(0) + Chr$(search.iRType) + Chr$(0) + Chr$(1)
'Datagram is completed
sID$ = Chr$(Int(Rnd * 255)) + Chr$(Int(Rnd * 255))
Err = 0
ctrlUDP.RemoteHost = RTrim$(search.sDNSaddr)
ctrlUDP.RemotePort = 53
'ctrlUDP.LocalPort = 53
ctrlUDP.Active = True
ctrlUDP.DataToSend = sID$ + sdatagram$
If Err <> 0 Then Exit Function
lTimeOut& = glTicks& + 10
gUDPBuffer$ = " "
While Not Left$(gUDPBuffer$, 2) = sID$
If glTicks& > lTimeOut& Then
SearchDNS = DNS_ERR_TIMEOUT
Exit Function
End If
DoEvents
Wend
ctrlUDP.Active = False
If RTrim$(gUDPBuffer$) <> "" Then
'SaveDataGram
If ((Asc(Mid$(gUDPBuffer$, 3, 1)) And 128) <> 128) And ((Asc(Mid$(gUDPBuffer$, 4, 1))
And 15) <> 0) Then
SearchDNS = DNS_ERR_OTHER
Exit Function
End If
sdatagram$ = gUDPBuffer$
If ParseDataGram(sdatagram$, search.iRType) = DNS_ERR_OK Then
If search.iRType = 15 Then SortMXRecords
SearchDNS = True
End If
End If
End Function
Sub SortMXRecords ()
Dim TempRec As MXRecordType
Dim iRecCnt%, bFlip%, iCnt%
On Local Error Resume Next
'Get the array count
iRecCnt% = UBound(mauMXRecords)
'If we don't have at least two, then it does us no good
If iRecCnt% < 2 Then Exit Sub
'Set our flip to force the loop
bFlip% = True
While bFlip%
'Ok, now reset the flip for the comparison
bFlip% = False
'Loop through the records
For iCnt% = 1 To iRecCnt% - 1
'If this records MX Prec is greater than the next...
If mauMXRecords(iCnt%).iMXPrec > mauMXRecords(iCnt% + 1).iMXPrec Then
'Copy the next record's data into the temp record
TempRec = mauMXRecords(iCnt% + 1)
'Copy this record into the next record
mauMXRecords(iCnt% + 1) = mauMXRecords(iCnt%)
'Copy the temp record into this record
mauMXRecords(iCnt%) = TempRec
'Now Set our flip to true
bFlip% = True
End If
'Do it again
Next
Wend
'We're done!
End Sub
The UDPPORT.VBX is made by DevSoft, Inc. You can register the UDPPORT.VBX on CompuServe's
Shareware Registration forum, or by calling PSL. The nag screens that appear are because you
do not have a license file and I am not providing mine because I am not selling the product
VBCTL3D.VBX is made by Simplex Solutions. You can register this control on CompuServe's
Shareware Registration forum. The control provides 3D appearances to controls and forms.
Also included is a file called VBEXIT3D.EXE which is a file that does a clean removal of the
VBX in design mode. You do not need it for the finished EXE - it's just used in the design
mode.
Send e-mail to me at john-r@vbonline.com
Click here to go back to the November '95 Article Index