随笔 - 3  文章 - 1 评论 - 21 trackbacks - 11

这是我平时在做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 = FalseAs 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 = FalseAs 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 StringByVal pageName As StringAs 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 StringAs 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 StringAs 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 StringByVal 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 StringAs 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 StringByVal 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 StringByVal Style As IntegerAs String
            
Dim GetInfo As String
            GetInfo 
= ""
            Select Case Style
                
Case 1 '得到操作系统
                    If (InStr(AgentStr, "NT 5.1"> 0Then
                        GetInfo 
= "操作系统:Windows XP"
                    ElseIf (InStr(AgentStr, "Tel"> 0Then
                        GetInfo 
= "操作系统:Telport"
                    ElseIf (InStr(AgentStr, "webzip"> 0Then
                        GetInfo 
= "操作系统:webzip"
                    ElseIf (InStr(AgentStr, "flashget"> 0Then
                        GetInfo 
= "操作系统:flashget"
                    ElseIf (InStr(AgentStr, "offline"> 0Then
                        GetInfo 
= "操作系统:offline"
                    ElseIf (InStr(AgentStr, "NT 5"> 0Then
                        GetInfo 
= "操作系统:Windows 2000"
                    ElseIf (InStr(AgentStr, "NT 4"> 0Then
                        GetInfo 
= "操作系统:Windows NT4"
                    ElseIf (InStr(AgentStr, "98"> 0Then
                        GetInfo 
= "操作系统:Windows 98"
                    ElseIf (InStr(AgentStr, "95"> 0Then
                        GetInfo 
= "操作系统:Windows 95"
                    Else
                        GetInfo 
= "操作系统:未知"
                    End If

                
Case 2 '得到浏览器

                    
If (InStr(AgentStr, "NetCaptor 6.5.0"> 0Then
                        GetInfo 
= "浏 览 器:NetCaptor 6.5.0"
                    ElseIf (InStr(AgentStr, "MyIe 3.1"> 0Then
                        GetInfo 
= "浏 览 器:MyIe 3.1"
                    ElseIf (InStr(AgentStr, "NetCaptor 6.5.0RC1"> 0Then
                        GetInfo 
= "浏 览 器:NetCaptor 6.5.0RC1"
                    ElseIf (InStr(AgentStr, "NetCaptor 6.5.PB1"> 0Then
                        GetInfo 
= "浏 览 器:NetCaptor 6.5.PB1"
                    ElseIf (InStr(AgentStr, "MSIE 6.0b"> 0Then
                        GetInfo 
= "浏 览 器:Internet Explorer 6.0b"
                    ElseIf (InStr(AgentStr, "MSIE 6.0"> 0Then
                        GetInfo 
= "浏 览 器:Internet Explorer 6.0"
                    ElseIf (InStr(AgentStr, "MSIE 5.5"> 0Then
                        GetInfo 
= "浏 览 器:Internet Explorer 5.5"
                    ElseIf (InStr(AgentStr, "MSIE 5.01"> 0Then
                        GetInfo 
= "浏 览 器:Internet Explorer 5.01"
                    ElseIf (InStr(AgentStr, "MSIE 5.0"> 0Then
                        GetInfo 
= "浏 览 器:Internet Explorer 5.0"
                    ElseIf (InStr(AgentStr, "MSIE 4.0"> 0Then
                        GetInfo 
= "浏 览 器:Internet Explorer 4.0"
                    Else
                        GetInfo 
= "浏 览 器:未知"
                    End If
            
End Select
            
Return GetInfo
        
End Function

        
'转义字符
        Public Shared Function TranStr(ByVal Tstr As StringAs 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 StringAs String
            
Dim KK As String
            KK 
= Format(Now, "yyyyMMddHHmmss")
            
Return Head & KK & Format(Now.Millisecond, "000")
        
End Function

        
'生成文件名
        Public Function MakeFileName(ByVal FileName As StringAs 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 StringAs 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 ObjectAs 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 StringAs 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 StringAs 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 StringAs 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

posted on 2005-09-03 17:08 鹰翔 阅读(...) 评论(...) 编辑 收藏