平时在做ASP.NET项目里经常使用的一些函数和方法

日期：2005-9-4 15:58:35     来源:eaglefly.cnblogs.com     作者：EagleFly    点击： 23

这是我平时在做ASP.NET项目里经常使用的一些函数和方法,把它们合到一个类中,希望对你们有用. 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), "&amp;")             TempStr = TempStr.Replace("<", "&lt;")             TempStr = TempStr.Replace(">", "&gt;")             TempStr = TempStr.Replace(Chr(32), "&nbsp;")             TempStr = TempStr.Replace(Chr(13), "<BR>") '回车             TempStr = TempStr.Replace(Chr(34), "&quot;") '双引号             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