平时在做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