这是我平时在做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
),
"
&
"
)
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