Advertisement
2002VB String Manipulation #18690

A 'Parse' function.

To split a string into pieces using a certain character as a delimiter. I do not want to get messages saying, "use the Split() function" as this isn't present in VB5. Example of this is "hello to you", with the delimiter as " ". You'll get back 3 variables, one containing "hello", one containing "to" and one containing "you"

AI

Resumo por IA: This codebase represents a historical implementation of the logic described in the metadata. Our preservation engine analyzes the structure to provide context for modern developers.

Código fonte
original-source
Option Explicit
Private Sub Command1_Click()
 Dim A As Variant
 Dim i As Integer
 i = 1
 A = Parse("hello to you", " ")
 Do While A(i) <> ""
 MsgBox A(i)
 i = i + 1
 Loop
End Sub
Public Function Parse(sIn As String, sDel As String) As Variant
 Dim i As Integer, x As Integer, s As Integer, t As Integer
 i = 1: s = 1: t = 1: x = 1
 ReDim tArr(1 To x) As Variant
 If InStr(1, sIn, sDel) <> 0 Then
  Do
   ReDim Preserve tArr(1 To x) As Variant
   tArr(i) = Mid(sIn, t, InStr(s, sIn, sDel) - t)
   t = InStr(s, sIn, sDel) + Len(sDel)
   s = t
   If tArr(i) <> "" Then i = i + 1
   x = x + 1
  Loop Until InStr(s, sIn, sDel) = 0
  ReDim Preserve tArr(1 To x) As Variant
  tArr(i) = Mid(sIn, t, Len(sIn) - t + 1)
 Else
  tArr(1) = sIn
 End If
 Parse = tArr
End Function
<%
Function IsEmail(ByRef asString)
	Dim lsDomain
	Dim lsSubDomain
	Dim lsSubDomainArray
	Dim lbIsIPdomain
	Dim lnStart
	Dim lsUserName
	Dim lnOctect
	Dim lnOctect2
	Dim lnIndex
	Const lsDOMAIN_CHARACTERS = ".ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890-"
	' Must have at least 6 characters "[email protected]"
	If Len(asString) < 6 Then
		IsEmail = False
		Exit Function
	End If
	
	' Look for "@" delimiter
	If Not InStr(asString, "@") > 1 Then
		IsEmail = False
		Exit Function
	End If
	
	' Make sure characters exist after the "@"
	If Len(asString) = InStr(asString, "@") Then
		IsEmail = False
		Exit Function
	End If
	
	' Grab domain information "a.ru"
	lsDomain = UCase(Mid(asString, InStr(asString, "@") + 1))
	
	' Grab username information
	lsUserName = UCase(Left(asString, InStr(asString, "@") - 1))
	
	' Make sure at least 1 "." exists
	If InStr(lsDomain, ".") = 0 Then
		IsEmail = False
		Exit Function
	End If
	
	' Check for valid domain characters
	lnStart = 1
	Do While lnStart <= Len(lsDomain)
		If InStr(lsDOMAIN_CHARACTERS, Mid(lsDomain, lnStart, 1)) Then
			lnStart = lnStart + 1
		Else
			IsEmail = False
			Exit Function
		End If
	Loop
	
	' Split domains
	lsSubDomainArray = Split(lsDomain, ".")
	lbIsIPdomain = False
		
	' Loop through each domain
	For lnIndex = 0 To UBound(lsSubDomainArray, 1)
		lsSubDomain = lsSubDomainArray(lnIndex)
		If Len(lsSubDomain) = 0 Then
			IsEmail = False
			Exit Function
		End If
		
		' Check to see if the domain is an IP Address
		If lnIndex = 0 Then
			If IsNumeric(lsSubDomain) Then
				
				' Only IP Addresses can have only numbers in subdomain area
				lbIsIPDomain = True
				
				' Make sure 4 subdomains are present
				If Not UBound(lsSubDomainArray, 1) = 3 Then
					IsEmail = False
					Exit Function
				End If
			
			End If
		End If
		
		If lbIsIPDomain Then
			If Len(lsSubDomain) > 3 Then
				IsEmail = False
				Exit Function
			ElseIf Not InStr(lsSubDomain, "-") = 0 Then
				IsEmail = False
				Exit Function
			ElseIf Not IsNumeric(lsSubDomain)Then
				IsEmail = False
				Exit Function
			End If
			
			lnOctect = CInt(lsSubDomain)
			
			If lnOctect > 255 Then
				IsEmail = False
				Exit Function
			ElseIf lnOctect < 0 Then
				IsEmail = False
				Exit Function
			End If
			
			' Look for private network settings
			If lnIndex = 0 Then
			
				' Grab 2nd IP value
				lnOctect2 = lsSubDomainArray(1)
				
				If Len(lnOctect2) > 3 Then
					IsEmail = False
					Exit Function
				ElseIf Not IsNumeric(lnOctect2)Then
					IsEmail = False
					Exit Function
				End If
				
				lnOctect2 = CInt(lnOctect2)
				'	TCP/IP addresses reserved for 'private' networks are:
				'				
				'	10.0.0.0    to   10.255.255.255				
				'	172.16.0.0   to   172.31.255.255				
				'	192.168.0.0  to   192.168.255.255				
				
				Select Case lnOctect
					
					Case 10 ' Private Network
						IsEmail = False
						Exit Function
					
					Case 172
						If lnOctect2 => 16 And lnOctect2 =< 31 Then
							IsEmail = False
							Exit Function
						End If
					
					Case 192 ' Local Network
						If lnOctect2 = 168 Then
							IsEmail = False
							Exit Function
						End If
					
					Case 127 ' Local Machine
						IsEmail = False
						Exit Function				
				
				End Select
			
			End If
			' End 'private' network check					
		Else
			
			If lnIndex = UBound(lsSubDomainArray, 1) Then
				
				' Last domain can have 3 characters max
				If Len(lsSubDomain) > 3 Then
					IsEmail = False
					Exit Function
				ElseIf Not InStr(lsSubDomain, "-") = 0 Then
					IsEmail = False
					Exit Function
				End If
			
			Else
				' Domain, sub domain can only have 22 characters max
				If Len(lsSubDomain) > 22 Then
					IsEmail = False
					Exit Function
				End If
			End If
		End If
	Next
	
	' Check for valid characters in username
	lnStart = 1
	Do While lnStart <= Len(lsUserName)
		If InStr(lsDOMAIN_CHARACTERS, Mid(lsUserName, lnStart, 1)) Then
			lnStart = lnStart + 1
		Else
			IsEmail = False
			Exit Function
		End If
	Loop
	
	IsEmail = True
End Function
%>
Comentários originais (3)
Recuperado do Wayback Machine