Imports System.Web
Imports System.Web.UI
Imports System.Web.UI.HtmlControls
Imports System.Web.UI.WebControls
Namespace Webs
Public Class WebUtils
Private Shared m_sScriptPath As String
Public Sub SetFormFocus(ByVal control As Control)
If Not control.Page Is Nothing And control.Visible Then
If control.Page.Request.Browser.JavaScript = True Then
' Create JavaScript
Dim sb As New System.Text.StringBuilder
sb.Append("<SCRIPT LANGUAGE='JavaScript'>")
sb.Append("<!--")
sb.Append(ControlChars.Lf)
sb.Append("function SetInitialFocus() {")
sb.Append(ControlChars.Lf)
sb.Append(" document.")
' Find the Form
Dim objParent As Control = control.Parent
While Not TypeOf objParent Is System.Web.UI.HtmlControls.HtmlForm
objParent = objParent.Parent
End While
sb.Append(objParent.ClientID)
sb.Append("['")
sb.Append(control.UniqueID)
sb.Append("'].focus(); }")
sb.Append("window.onload = SetInitialFocus;")
sb.Append(ControlChars.Lf)
sb.Append("// -->")
sb.Append(ControlChars.Lf)
sb.Append("</SCRIPT>")
' Register Client Script
control.Page.RegisterClientScriptBlock("InitialFocus", sb.ToString())
End If
End If
End Sub
Public Shared Function GetSelectedString(ByVal ddl As System.Web.UI.WebControls.ListControl, Optional ByVal ExcludeFirstSelection As Boolean = False) As String
Dim leastSelection As Int32 = 0
If ddl.SelectedIndex < leastSelection Then
Return ""
Else
Return ddl.SelectedItem.Value
End If
End Function
Public Shared Function GetSelectedInt(ByVal ddl As System.Web.UI.WebControls.ListControl, Optional ByVal ExcludeFirstSelection As Boolean = False) As Int32
Dim str As String = GetSelectedString(ddl, ExcludeFirstSelection)
Return General.Utils.ParseInt(str)
End Function
Public Shared Sub SetSelectedValue(ByVal ddl As ListControl, ByVal value As Object)
Dim index As Int32 = ddl.Items.IndexOf(ddl.Items.FindByValue(value.ToString()))
If index >= 0 Then
ddl.SelectedIndex = index
Else
ddl.SelectedIndex = 0
End If
End Sub
Public Shared Sub PostBackToNewWindow(ByVal control As WebControl)
control.Attributes.Add("onclick", "javascript:document.forms(0).target='_new';" + control.Page.GetPostBackEventReference(control) + ";document.forms(0).target='_self';return false")
End Sub
Public Shared Sub BindDropdownWithDefault(ByVal ddl As ListControl, ByVal datasource As Object)
ddl.DataSource = datasource
ddl.DataBind()
ddl.Items.Insert(0, "")
ddl.SelectedIndex = 0
End Sub
Public Shared Function AddPage(ByVal path As String, ByVal pageName As String) As String
Dim friendlyPath As String = path
If (friendlyPath.EndsWith("/")) Then
friendlyPath = friendlyPath & pageName
Else
friendlyPath = friendlyPath & "/" & pageName
End If
Return friendlyPath
End Function
''' -----------------------------------------------------------------------------
''' <summary>
''' Searches control hierarchy from top down to find a control matching the passed in name
''' </summary>
''' <param name="objParent">Root control to begin searching</param>
''' <param name="strControlName">Name of control to look for</param>
''' <returns></returns>
''' <remarks>
''' This differs from FindControlRecursive in that it looks down the control hierarchy, whereas, the
''' FindControlRecursive starts at the passed in control and walks the tree up. Therefore, this function is
''' more a expensive task.
''' </remarks>
''' -----------------------------------------------------------------------------
Public Shared Function FindControlRecursive(ByVal objParent As Control, ByVal strControlName As String) As Control
Dim objCtl As Control
Dim objChild As Control
objCtl = objParent.FindControl(strControlName)
If objCtl Is Nothing Then
For Each objChild In objParent.Controls
If objChild.HasControls Then objCtl = FindControlRecursive(objChild, strControlName)
If Not objCtl Is Nothing Then Exit For
Next
End If
Return objCtl
End Function
Public Shared Function GetAttribute(ByVal objControl As Control, ByVal strAttr As String) As String
Select Case True
Case TypeOf objControl Is WebControl
Return CType(objControl, WebControl).Attributes(strAttr)
Case TypeOf objControl Is HtmlControl
Return CType(objControl, HtmlControl).Attributes(strAttr)
Case Else
'throw error?
End Select
End Function
Public Shared Sub SetAttribute(ByVal objControl As Control, ByVal strAttr As String, ByVal strValue As String)
Dim strOrigVal As String = GetAttribute(objControl, strAttr)
If Len(strOrigVal) > 0 Then strValue = strOrigVal & strValue
Select Case True
Case TypeOf objControl Is WebControl
Dim objCtl As WebControl = CType(objControl, WebControl)
If objCtl.Attributes(strAttr) Is Nothing Then
objCtl.Attributes.Add(strAttr, strValue)
Else
objCtl.Attributes(strAttr) = strValue
End If
Case TypeOf objControl Is HtmlControl
Dim objCtl As HtmlControl = CType(objControl, HtmlControl)
If objCtl.Attributes(strAttr) Is Nothing Then
objCtl.Attributes.Add(strAttr, strValue)
Else
objCtl.Attributes(strAttr) = strValue
End If
Case Else
'throw error?
End Select
End Sub
Public Shared Sub AddButtonConfirm(ByVal objButton As WebControl, ByVal strText As String)
objButton.Attributes.Add("onClick", "javascript:return confirm('" & GetSafeJSString(strText) & "');")
End Sub
Public Shared Function GetSafeJSString(ByVal strString As String) As String
If Len(strString) > 0 Then
Return System.Text.RegularExpressions.Regex.Replace(strString, "(['""])", "\$1")
Else
Return strString
End If
End Function
Public Shared Property ScriptPath() As String
Get
If Len(m_sScriptPath) > 0 Then
Return m_sScriptPath
ElseIf Not System.Web.HttpContext.Current Is Nothing Then
If System.Web.HttpContext.Current.Request.ApplicationPath.EndsWith("/") Then
Return System.Web.HttpContext.Current.Request.ApplicationPath & "js/"
Else
Return System.Web.HttpContext.Current.Request.ApplicationPath & "/js/"
End If
End If
End Get
Set(ByVal Value As String)
m_sScriptPath = Value
End Set
End Property
Public Shared Sub FocusControlOnPageLoad(ByVal ControlID As String, ByVal FormPage As System.Web.UI.Page)
Dim JSStr As String
JSStr = "<script>" & vbCrLf
JSStr &= "function ScrollView() {" & vbCrLf
JSStr &= "var el = document.getElementById('" & ControlID & "');" & vbCrLf
JSStr &= "if (el != null) {" & vbCrLf
JSStr &= "el.scrollIntoView();" & vbCrLf
JSStr &= "el.focus();" & vbCrLf
JSStr &= "}" & vbCrLf & "}" & vbCrLf
JSStr &= "window.onload = ScrollView;" & vbCrLf
JSStr &= " </script>" & vbCrLf
FormPage.RegisterClientScriptBlock("CtrlFocus", JSStr)
End Sub
'得到操作系统和游览器信息
Public Shared Function GetBrowserInfo(ByVal AgentStr As String, ByVal Style As Integer) As String
Dim GetInfo As String
GetInfo = ""
Select Case Style
Case 1 '得到操作系统
If (InStr(AgentStr, "NT 5.1") > 0) Then
GetInfo = "操作系统：Windows XP"
ElseIf (InStr(AgentStr, "Tel") > 0) Then
GetInfo = "操作系统：Telport"
ElseIf (InStr(AgentStr, "webzip") > 0) Then
GetInfo = "操作系统：webzip"
ElseIf (InStr(AgentStr, "flashget") > 0) Then
GetInfo = "操作系统：flashget"
ElseIf (InStr(AgentStr, "offline") > 0) Then
GetInfo = "操作系统：offline"
ElseIf (InStr(AgentStr, "NT 5") > 0) Then
GetInfo = "操作系统：Windows 2000"
ElseIf (InStr(AgentStr, "NT 4") > 0) Then
GetInfo = "操作系统：Windows NT4"
ElseIf (InStr(AgentStr, "98") > 0) Then
GetInfo = "操作系统：Windows 98"
ElseIf (InStr(AgentStr, "95") > 0) Then
GetInfo = "操作系统：Windows 95"
Else
GetInfo = "操作系统：未知"
End If
Case 2 '得到浏览器
If (InStr(AgentStr, "NetCaptor 6.5.0") > 0) Then
GetInfo = "浏 览 器：NetCaptor 6.5.0"
ElseIf (InStr(AgentStr, "MyIe 3.1") > 0) Then
GetInfo = "浏 览 器：MyIe 3.1"
ElseIf (InStr(AgentStr, "NetCaptor 6.5.0RC1") > 0) Then
GetInfo = "浏 览 器：NetCaptor 6.5.0RC1"
ElseIf (InStr(AgentStr, "NetCaptor 6.5.PB1") > 0) Then
GetInfo = "浏 览 器：NetCaptor 6.5.PB1"
ElseIf (InStr(AgentStr, "MSIE 6.0b") > 0) Then
GetInfo = "浏 览 器：Internet Explorer 6.0b"
ElseIf (InStr(AgentStr, "MSIE 6.0") > 0) Then
GetInfo = "浏 览 器：Internet Explorer 6.0"
ElseIf (InStr(AgentStr, "MSIE 5.5") > 0) Then
GetInfo = "浏 览 器：Internet Explorer 5.5"
ElseIf (InStr(AgentStr, "MSIE 5.01") > 0) Then
GetInfo = "浏 览 器：Internet Explorer 5.01"
ElseIf (InStr(AgentStr, "MSIE 5.0") > 0) Then
GetInfo = "浏 览 器：Internet Explorer 5.0"
ElseIf (InStr(AgentStr, "MSIE 4.0") > 0) Then
GetInfo = "浏 览 器：Internet Explorer 4.0"
Else
GetInfo = "浏 览 器：未知"
End If
End Select
Return GetInfo
End Function
'转义字符
Public Shared Function TranStr(ByVal Tstr As String) As String 'HTML TO TXT
Dim TempStr As String
If Tstr = "" Then Return ""
TempStr = Tstr.Replace(Chr(38), "&")
TempStr = TempStr.Replace("<", "<")
TempStr = TempStr.Replace(">", ">")
TempStr = TempStr.Replace(Chr(32), " ")
TempStr = TempStr.Replace(Chr(13), "<BR>") '回车
TempStr = TempStr.Replace(Chr(34), """) '双引号
Return TempStr
End Function
'生成唯一系统编号
Public Shared Function MakeSerial(ByVal Head As String) As String
Dim KK As String
KK = Format(Now, "yyyyMMddHHmmss")
Return Head & KK & Format(Now.Millisecond, "000")
End Function
'生成文件名
Public Function MakeFileName(ByVal FileName As String) As String
Dim NewFN, LastName As String : Dim Pos As Integer
Pos = FileName.LastIndexOf(".")
If Pos > 0 Then
LastName = FileName.Substring(Pos)
End If
NewFN = Now.Year & Now.Month & Now.Day & Now.Hour & Now.Minute & Now.Second & LastName
Return NewFN
End Function
' format an email address including link
Public Function FormatEmail(ByVal Email As String) As String
If Not Email.Length = 0 Then
If Trim(Email) <> "" Then
If Email.IndexOf("@") <> -1 Then
FormatEmail = "<a href=""mailto:" & Email & """>" & Email & "</a>"
Else
FormatEmail = Email
End If
End If
End If
Return CloakText(FormatEmail)
End Function
' format a domain name including link
Public Function FormatWebsite(ByVal Website As Object) As String
If Not IsDBNull(Website) Then
If Trim(Website.ToString()) <> "" Then
If Convert.ToBoolean(InStr(1, Website.ToString(), ".")) Then
FormatWebsite = "<a href=""" & IIf(Convert.ToBoolean(InStr(1, Website.ToString(), "://")), "", "http://").ToString & Website.ToString() & """>" & Website.ToString() & "</a>"
Else
FormatWebsite = Website.ToString()
End If
End If
End If
End Function
' obfuscate sensitive data to prevent collection by robots and spiders and crawlers
Public Function CloakText(ByVal PersonalInfo As String) As String
If Not PersonalInfo Is Nothing Then
Dim sb As New System.Text.StringBuilder
' convert to ASCII character codes
sb.Remove(0, sb.Length)
Dim StringLength As Integer = PersonalInfo.Length - 1
For i As Integer = 0 To StringLength
sb.Append(Asc(PersonalInfo.Substring(i, 1)).ToString)
If i < StringLength Then
sb.Append(",")
End If
Next
' build script block
Dim sbScript As New System.Text.StringBuilder
sbScript.Append(vbCrLf & "<script language=""javascript"">" & vbCrLf)
sbScript.Append("<!-- " & vbCrLf)
sbScript.Append(" document.write(String.fromCharCode(" & sb.ToString & "))" & vbCrLf)
sbScript.Append("// -->" & vbCrLf)
sbScript.Append("</script>" & vbCrLf)
Return sbScript.ToString
Else : Return ""
End If
End Function
Public Function AddHTTP(ByVal strURL As String) As String
If strURL <> "" Then
If InStr(1, strURL, "://") = 0 And InStr(1, strURL, "~") = 0 And InStr(1, strURL, "\\") = 0 Then
If HttpContext.Current.Request.IsSecureConnection Then
strURL = "https://" & strURL
Else
strURL = "http://" & strURL
End If
End If
End If
Return strURL
End Function
Public Function HTTPPOSTEncode(ByVal strPost As String) As String
strPost = Replace(strPost, "\", "")
strPost = System.Web.HttpUtility.UrlEncode(strPost)
strPost = Replace(strPost, "%2f", "/")
HTTPPOSTEncode = strPost
End Function
Public Function GetAbsoluteServerPath(ByVal Request As HttpRequest) As String
Dim strServerPath As String
strServerPath = Request.MapPath(Request.ApplicationPath)
If Not strServerPath.EndsWith("\") Then
strServerPath += "\"
End If
GetAbsoluteServerPath = strServerPath
End Function
End Class
End Namespace
Imports System.Web.UI
Imports System.Web.UI.HtmlControls
Imports System.Web.UI.WebControls
Namespace Webs
Public Class WebUtils
Private Shared m_sScriptPath As String
Public Sub SetFormFocus(ByVal control As Control)
If Not control.Page Is Nothing And control.Visible Then
If control.Page.Request.Browser.JavaScript = True Then
' Create JavaScript
Dim sb As New System.Text.StringBuilder
sb.Append("<SCRIPT LANGUAGE='JavaScript'>")
sb.Append("<!--")
sb.Append(ControlChars.Lf)
sb.Append("function SetInitialFocus() {")
sb.Append(ControlChars.Lf)
sb.Append(" document.")
' Find the Form
Dim objParent As Control = control.Parent
While Not TypeOf objParent Is System.Web.UI.HtmlControls.HtmlForm
objParent = objParent.Parent
End While
sb.Append(objParent.ClientID)
sb.Append("['")
sb.Append(control.UniqueID)
sb.Append("'].focus(); }")
sb.Append("window.onload = SetInitialFocus;")
sb.Append(ControlChars.Lf)
sb.Append("// -->")
sb.Append(ControlChars.Lf)
sb.Append("</SCRIPT>")
' Register Client Script
control.Page.RegisterClientScriptBlock("InitialFocus", sb.ToString())
End If
End If
End Sub
Public Shared Function GetSelectedString(ByVal ddl As System.Web.UI.WebControls.ListControl, Optional ByVal ExcludeFirstSelection As Boolean = False) As String
Dim leastSelection As Int32 = 0
If ddl.SelectedIndex < leastSelection Then
Return ""
Else
Return ddl.SelectedItem.Value
End If
End Function
Public Shared Function GetSelectedInt(ByVal ddl As System.Web.UI.WebControls.ListControl, Optional ByVal ExcludeFirstSelection As Boolean = False) As Int32
Dim str As String = GetSelectedString(ddl, ExcludeFirstSelection)
Return General.Utils.ParseInt(str)
End Function
Public Shared Sub SetSelectedValue(ByVal ddl As ListControl, ByVal value As Object)
Dim index As Int32 = ddl.Items.IndexOf(ddl.Items.FindByValue(value.ToString()))
If index >= 0 Then
ddl.SelectedIndex = index
Else
ddl.SelectedIndex = 0
End If
End Sub
Public Shared Sub PostBackToNewWindow(ByVal control As WebControl)
control.Attributes.Add("onclick", "javascript:document.forms(0).target='_new';" + control.Page.GetPostBackEventReference(control) + ";document.forms(0).target='_self';return false")
End Sub
Public Shared Sub BindDropdownWithDefault(ByVal ddl As ListControl, ByVal datasource As Object)
ddl.DataSource = datasource
ddl.DataBind()
ddl.Items.Insert(0, "")
ddl.SelectedIndex = 0
End Sub
Public Shared Function AddPage(ByVal path As String, ByVal pageName As String) As String
Dim friendlyPath As String = path
If (friendlyPath.EndsWith("/")) Then
friendlyPath = friendlyPath & pageName
Else
friendlyPath = friendlyPath & "/" & pageName
End If
Return friendlyPath
End Function
''' -----------------------------------------------------------------------------
''' <summary>
''' Searches control hierarchy from top down to find a control matching the passed in name
''' </summary>
''' <param name="objParent">Root control to begin searching</param>
''' <param name="strControlName">Name of control to look for</param>
''' <returns></returns>
''' <remarks>
''' This differs from FindControlRecursive in that it looks down the control hierarchy, whereas, the
''' FindControlRecursive starts at the passed in control and walks the tree up. Therefore, this function is
''' more a expensive task.
''' </remarks>
''' -----------------------------------------------------------------------------
Public Shared Function FindControlRecursive(ByVal objParent As Control, ByVal strControlName As String) As Control
Dim objCtl As Control
Dim objChild As Control
objCtl = objParent.FindControl(strControlName)
If objCtl Is Nothing Then
For Each objChild In objParent.Controls
If objChild.HasControls Then objCtl = FindControlRecursive(objChild, strControlName)
If Not objCtl Is Nothing Then Exit For
Next
End If
Return objCtl
End Function
Public Shared Function GetAttribute(ByVal objControl As Control, ByVal strAttr As String) As String
Select Case True
Case TypeOf objControl Is WebControl
Return CType(objControl, WebControl).Attributes(strAttr)
Case TypeOf objControl Is HtmlControl
Return CType(objControl, HtmlControl).Attributes(strAttr)
Case Else
'throw error?
End Select
End Function
Public Shared Sub SetAttribute(ByVal objControl As Control, ByVal strAttr As String, ByVal strValue As String)
Dim strOrigVal As String = GetAttribute(objControl, strAttr)
If Len(strOrigVal) > 0 Then strValue = strOrigVal & strValue
Select Case True
Case TypeOf objControl Is WebControl
Dim objCtl As WebControl = CType(objControl, WebControl)
If objCtl.Attributes(strAttr) Is Nothing Then
objCtl.Attributes.Add(strAttr, strValue)
Else
objCtl.Attributes(strAttr) = strValue
End If
Case TypeOf objControl Is HtmlControl
Dim objCtl As HtmlControl = CType(objControl, HtmlControl)
If objCtl.Attributes(strAttr) Is Nothing Then
objCtl.Attributes.Add(strAttr, strValue)
Else
objCtl.Attributes(strAttr) = strValue
End If
Case Else
'throw error?
End Select
End Sub
Public Shared Sub AddButtonConfirm(ByVal objButton As WebControl, ByVal strText As String)
objButton.Attributes.Add("onClick", "javascript:return confirm('" & GetSafeJSString(strText) & "');")
End Sub
Public Shared Function GetSafeJSString(ByVal strString As String) As String
If Len(strString) > 0 Then
Return System.Text.RegularExpressions.Regex.Replace(strString, "(['""])", "\$1")
Else
Return strString
End If
End Function
Public Shared Property ScriptPath() As String
Get
If Len(m_sScriptPath) > 0 Then
Return m_sScriptPath
ElseIf Not System.Web.HttpContext.Current Is Nothing Then
If System.Web.HttpContext.Current.Request.ApplicationPath.EndsWith("/") Then
Return System.Web.HttpContext.Current.Request.ApplicationPath & "js/"
Else
Return System.Web.HttpContext.Current.Request.ApplicationPath & "/js/"
End If
End If
End Get
Set(ByVal Value As String)
m_sScriptPath = Value
End Set
End Property
Public Shared Sub FocusControlOnPageLoad(ByVal ControlID As String, ByVal FormPage As System.Web.UI.Page)
Dim JSStr As String
JSStr = "<script>" & vbCrLf
JSStr &= "function ScrollView() {" & vbCrLf
JSStr &= "var el = document.getElementById('" & ControlID & "');" & vbCrLf
JSStr &= "if (el != null) {" & vbCrLf
JSStr &= "el.scrollIntoView();" & vbCrLf
JSStr &= "el.focus();" & vbCrLf
JSStr &= "}" & vbCrLf & "}" & vbCrLf
JSStr &= "window.onload = ScrollView;" & vbCrLf
JSStr &= " </script>" & vbCrLf
FormPage.RegisterClientScriptBlock("CtrlFocus", JSStr)
End Sub
'得到操作系统和游览器信息
Public Shared Function GetBrowserInfo(ByVal AgentStr As String, ByVal Style As Integer) As String
Dim GetInfo As String
GetInfo = ""
Select Case Style
Case 1 '得到操作系统
If (InStr(AgentStr, "NT 5.1") > 0) Then
GetInfo = "操作系统：Windows XP"
ElseIf (InStr(AgentStr, "Tel") > 0) Then
GetInfo = "操作系统：Telport"
ElseIf (InStr(AgentStr, "webzip") > 0) Then
GetInfo = "操作系统：webzip"
ElseIf (InStr(AgentStr, "flashget") > 0) Then
GetInfo = "操作系统：flashget"
ElseIf (InStr(AgentStr, "offline") > 0) Then
GetInfo = "操作系统：offline"
ElseIf (InStr(AgentStr, "NT 5") > 0) Then
GetInfo = "操作系统：Windows 2000"
ElseIf (InStr(AgentStr, "NT 4") > 0) Then
GetInfo = "操作系统：Windows NT4"
ElseIf (InStr(AgentStr, "98") > 0) Then
GetInfo = "操作系统：Windows 98"
ElseIf (InStr(AgentStr, "95") > 0) Then
GetInfo = "操作系统：Windows 95"
Else
GetInfo = "操作系统：未知"
End If
Case 2 '得到浏览器
If (InStr(AgentStr, "NetCaptor 6.5.0") > 0) Then
GetInfo = "浏 览 器：NetCaptor 6.5.0"
ElseIf (InStr(AgentStr, "MyIe 3.1") > 0) Then
GetInfo = "浏 览 器：MyIe 3.1"
ElseIf (InStr(AgentStr, "NetCaptor 6.5.0RC1") > 0) Then
GetInfo = "浏 览 器：NetCaptor 6.5.0RC1"
ElseIf (InStr(AgentStr, "NetCaptor 6.5.PB1") > 0) Then
GetInfo = "浏 览 器：NetCaptor 6.5.PB1"
ElseIf (InStr(AgentStr, "MSIE 6.0b") > 0) Then
GetInfo = "浏 览 器：Internet Explorer 6.0b"
ElseIf (InStr(AgentStr, "MSIE 6.0") > 0) Then
GetInfo = "浏 览 器：Internet Explorer 6.0"
ElseIf (InStr(AgentStr, "MSIE 5.5") > 0) Then
GetInfo = "浏 览 器：Internet Explorer 5.5"
ElseIf (InStr(AgentStr, "MSIE 5.01") > 0) Then
GetInfo = "浏 览 器：Internet Explorer 5.01"
ElseIf (InStr(AgentStr, "MSIE 5.0") > 0) Then
GetInfo = "浏 览 器：Internet Explorer 5.0"
ElseIf (InStr(AgentStr, "MSIE 4.0") > 0) Then
GetInfo = "浏 览 器：Internet Explorer 4.0"
Else
GetInfo = "浏 览 器：未知"
End If
End Select
Return GetInfo
End Function
'转义字符
Public Shared Function TranStr(ByVal Tstr As String) As String 'HTML TO TXT
Dim TempStr As String
If Tstr = "" Then Return ""
TempStr = Tstr.Replace(Chr(38), "&")
TempStr = TempStr.Replace("<", "<")
TempStr = TempStr.Replace(">", ">")
TempStr = TempStr.Replace(Chr(32), " ")
TempStr = TempStr.Replace(Chr(13), "<BR>") '回车
TempStr = TempStr.Replace(Chr(34), """) '双引号
Return TempStr
End Function
'生成唯一系统编号
Public Shared Function MakeSerial(ByVal Head As String) As String
Dim KK As String
KK = Format(Now, "yyyyMMddHHmmss")
Return Head & KK & Format(Now.Millisecond, "000")
End Function
'生成文件名
Public Function MakeFileName(ByVal FileName As String) As String
Dim NewFN, LastName As String : Dim Pos As Integer
Pos = FileName.LastIndexOf(".")
If Pos > 0 Then
LastName = FileName.Substring(Pos)
End If
NewFN = Now.Year & Now.Month & Now.Day & Now.Hour & Now.Minute & Now.Second & LastName
Return NewFN
End Function
' format an email address including link
Public Function FormatEmail(ByVal Email As String) As String
If Not Email.Length = 0 Then
If Trim(Email) <> "" Then
If Email.IndexOf("@") <> -1 Then
FormatEmail = "<a href=""mailto:" & Email & """>" & Email & "</a>"
Else
FormatEmail = Email
End If
End If
End If
Return CloakText(FormatEmail)
End Function
' format a domain name including link
Public Function FormatWebsite(ByVal Website As Object) As String
If Not IsDBNull(Website) Then
If Trim(Website.ToString()) <> "" Then
If Convert.ToBoolean(InStr(1, Website.ToString(), ".")) Then
FormatWebsite = "<a href=""" & IIf(Convert.ToBoolean(InStr(1, Website.ToString(), "://")), "", "http://").ToString & Website.ToString() & """>" & Website.ToString() & "</a>"
Else
FormatWebsite = Website.ToString()
End If
End If
End If
End Function
' obfuscate sensitive data to prevent collection by robots and spiders and crawlers
Public Function CloakText(ByVal PersonalInfo As String) As String
If Not PersonalInfo Is Nothing Then
Dim sb As New System.Text.StringBuilder
' convert to ASCII character codes
sb.Remove(0, sb.Length)
Dim StringLength As Integer = PersonalInfo.Length - 1
For i As Integer = 0 To StringLength
sb.Append(Asc(PersonalInfo.Substring(i, 1)).ToString)
If i < StringLength Then
sb.Append(",")
End If
Next
' build script block
Dim sbScript As New System.Text.StringBuilder
sbScript.Append(vbCrLf & "<script language=""javascript"">" & vbCrLf)
sbScript.Append("<!-- " & vbCrLf)
sbScript.Append(" document.write(String.fromCharCode(" & sb.ToString & "))" & vbCrLf)
sbScript.Append("// -->" & vbCrLf)
sbScript.Append("</script>" & vbCrLf)
Return sbScript.ToString
Else : Return ""
End If
End Function
Public Function AddHTTP(ByVal strURL As String) As String
If strURL <> "" Then
If InStr(1, strURL, "://") = 0 And InStr(1, strURL, "~") = 0 And InStr(1, strURL, "\\") = 0 Then
If HttpContext.Current.Request.IsSecureConnection Then
strURL = "https://" & strURL
Else
strURL = "http://" & strURL
End If
End If
End If
Return strURL
End Function
Public Function HTTPPOSTEncode(ByVal strPost As String) As String
strPost = Replace(strPost, "\", "")
strPost = System.Web.HttpUtility.UrlEncode(strPost)
strPost = Replace(strPost, "%2f", "/")
HTTPPOSTEncode = strPost
End Function
Public Function GetAbsoluteServerPath(ByVal Request As HttpRequest) As String
Dim strServerPath As String
strServerPath = Request.MapPath(Request.ApplicationPath)
If Not strServerPath.EndsWith("\") Then
strServerPath += "\"
End If
GetAbsoluteServerPath = strServerPath
End Function
End Class
End Namespace