Vbscript Asp unicode编码转汉字

作者:admin 日期:2019-01-04

自己写的代码：

ASP/Visual Basic代码

Function unicodetostr(text)
unicodetostr=text
if instr(text,"&#")>0 then
str=split(text,"&#")
for i=1 to ubound(str)
str1=mid(str(i),1,instr(str(i),";")-1)
'response.write(str1&"<br/>")
unicodetostr=replace(unicodetostr,"&#"&str1&";",chrw(str1))
next
end if
end function

参考资料：https://zhidao.baidu.com/question/41686234.html

用Chr()函数把ascii码转化成汉字

用ChrW()函数把Unicode码转化成汉字

（还有之前说的AscW()函数返回值为负的时候，应加上65536 才得到汉字实际的Unicode码）

求汉字的Unicode代码用AscW()函数

AscW("汉")=27721

求汉字的ASCII码用Asc()函数返回一个负数值

如Asc("汉")=-17734

Tags: asp vb

分类:技术文章 | 固定链接 | 评论: 0 | 引用: 0 | 查看次数: 386

asp之字符串操作函数

作者:admin 日期:2015-05-22

asp之字符串函数示例

用字符串函数对字符串进行截头去尾、大小写替换等操作。

函数	语法	功能
Len	Len(string\|varname)	返回字符串内字符的数目，或是存储一变量所需的字节数。
Trim	Trim(string)	将字符串前后的空格去掉
Ltrim	Ltrim(string)	将字符串前面的空格去掉
Rtrim	Rtrim(string)	将字符串后面的空格去掉
Mid	Mid(string,start,length)	从string字符串的start字符开始取得length长度的字符串，如果省略第三个参数表示从start字符开始到字符串结尾的字符串
Left	Left(string,length)	从string字符串的左边取得length长度的字符串
Right	Right(string,length)	从string字符串的右边取得length长度的字符串
LCase	LCase(string)	将string字符串里的所有大写字母转化为小写字母
UCase	UCase(string)	将string字符串里的所有大写字母转化为大写字母
StrComp	StrComp(string1,string2[，compare])	返回string1字符串与string2字符串的比较结果，如果两个字符串相同，则返回0，如果小于则返回-1，如果大于则返回1
InStr	InStr(string1,string2[, compare])	返回string1字符串在string2字符串中第一次出现的位置
Split	Split(string1,delimiter[, count[, start]])	将字符串根据delimiter拆分成一维数组，其中delimiter用于标识子字符串界限。如果省略，使用空格("")作为分隔符。 count 返回的子字符串数目，-1 指示返回所有子字符串。 start为 1 执行文本比较；如果为 0 或者省略执行二进制比较。
Replace	Replace(expression, find, replacewith[, compare[, count[, start]]])	返回字符串，其中指定数目的某子字符串(find)被替换为另一个子字符串(replacewith)。

Tags: asp

分类:技术文章 | 固定链接 | 评论: 0 | 引用: 0 | 查看次数: 1932

asp如何取得新插入记录的ID(ACCESS库和MSSQL方法不同)

作者:admin 日期:2015-05-20

ACCESS库可以这样书写:

ASP/Visual Basic代码

set rs = server.createobject("adodb.recordset")
sql = "select * from table
rs.addnew
rs("title") = "title"
rs("content") = "content"
rs.update
newid = rs("id")
rs.close

SQLSERVER用上面的方法不行,必须在Update后多加一句,rs.movelast.

ASP/Visual Basic代码

set rs = server.createobject("adodb.recordset")
sql = "select * from table
rs.addnew
rs("title") = "title"
rs("content") = "content"
rs.update
rs.movelast
newid = rs("id")
rs.close

SqlServer中的自增的ID的最后的值:

Select SCOPE_IDENTITY() --返回插入到同一作用域中的 IDENTITY 列内的最后一个 IDENTITY 值。
Select @@IDENTITY --返回插入到当前会话中任何作用域内的最后一个 IDENTITY 列值
Select IDENT_CURRENT('TbName')--不受作用域和会话的限制，而受限于指定的表。
IDENT_CURRENT 返回为任何会话和作用域中的特定表所生成的值。

Tags: asp

分类:技术文章 | 固定链接 | 评论: 0 | 引用: 0 | 查看次数: 3074

asp返回404错误状态码

作者:admin 日期:2013-11-07

ASP/Visual Basic代码

<%
Response.Status = "404 Not Found"
%>

Tags: asp

分类:技术文章 | 固定链接 | 评论: 1 | 引用: 0 | 查看次数: 2569

Asp读取调用纯真IP数据库

作者:admin 日期:2013-09-23

ASP/Visual Basic代码

<%
'文件名:ip.asp 与QQwry.dat放在一个文件夹下面
'使用:在要用到的查询ip的asp页面中最前面加入
'然后可以用address(getIP())获得请求的地理位置
'=========================================================
' IP物理定位搜索类 Version 3.0.0
' QQWry.DAT 利用程序修改自互联网流传代码
' 本类在ASP环境中使用纯真版QQWry.dat通过完美测试
' 如果您的服务器环境不支持ADodb.Stream，将无法使用此程序
' 推荐使用纯真数据库，更新也方便
' ========================================================
' ============================================
' 返回IP信息
' 如address("127.0.0.1")
' 返回值为:"本机地址 CZ88.NET"
' ============================================
Function address(sip)
Dim Wry, IPType
Set Wry = New TQQWry
IPType = Wry.QQWry(sip)
address=""&Wry.Country & " " & Wry.LocalStr &""
End Function
'获得请求的实际IP地址
Function getIP()
Dim strIPAddr
If Request.ServerVariables("HTTP_X_FORWARDED_FOR") = "" OR InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), "unknown") > 0 Then
strIPAddr = Request.ServerVariables("REMOTE_ADDR")
ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",") > 0 Then
strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",")-1)
ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";") > 0 Then
strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";")-1)
Else
strIPAddr = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
End If
getIP = Trim(Mid(strIPAddr, 1, 30))
End Function
Function Look_Ip(IP)
Dim Wry, IPType, QQWryVersion, IpCounter
' 设置类对象
Set Wry = New TQQWry
' 开始搜索，并返回搜索结果
' 您可以根据 QQWry(IP) 返回值来判断该IP地址在数据库中是否存在，如果不存在可以执行其他的一些操作
' 比如您自建一个数据库作为追捕等，这里我就不详细说明了
IPType = Wry.QQWry(IP)
' Country：国家地区字段
' LocalStr：省市及其他信息字段
Look_Ip = Wry.Country & " " & Wry.LocalStr
End Function
' ============================================
' 返回IP信息 JS调用
' ============================================
Function GetIpInfoAv(IP, sType)
Dim Wry, IPType
Set Wry = New TQQWry
IPType = Wry.QQWry(IP)
Select Case sType
Case 1 GetIpInfoAv = "document.write(""" & IP & """);"
Case 2 GetIpInfoAv = "document.write(""" & Wry.Country & """);"
Case 3 GetIpInfoAv = "document.write(""" & Wry.LocalStr & """);"
Case Else GetIpInfoAv = "document.write(""您来自：" & IP & " 所在区域：" & Wry.Country & " " & Wry.LocalStr & """);"
End Select
End Function
' ============================================
' 返回QQWry信息
' ============================================
Function WryInfo()
Dim Wry, IPType, QQWry(1)
' 设置类对象
Set Wry = New TQQWry
IPType = Wry.QQWry("255.255.255.255")
' 读取数据库版本信息
QQWry(0) = Wry.Country & " " & Wry.LocalStr
' 读取数据库IP地址数目
QQWry(1) = Wry.RecordCount + 1
WryInfo = QQWry
End Function
' ============================================
' 爱雪儿IP物理定位搜索类
' ============================================
Class TQQWry
' ============================================
' 变量声名
' ============================================
Dim Country, LocalStr, Buf, OffSet
Private StartIP, EndIP, CountryFlag
Public QQWryFile
Public FirstStartIP, LastStartIP, RecordCount
Private Stream, EndIPOff
' ============================================
' 类模块初始化
' ============================================
Private Sub Class_Initialize
Country = ""
LocalStr = ""
StartIP = 0
EndIP = 0
CountryFlag = 0
FirstStartIP = 0
LastStartIP = 0
EndIPOff = 0
QQWryFile = Server.MapPath("QQWry.dat") 'QQ IP库路径，要转换成物理路径
End Sub
' ============================================
' IP地址转换成整数
' ============================================
Function IPToInt(IP)
Dim IPArray, i
IPArray = Split(IP, ".", -1)
FOr i = 0 to 3
If Not IsNumeric(IPArray(i)) Then IPArray(i) = 0
If CInt(IPArray(i)) < 0 Then IPArray(i) = Abs(CInt(IPArray(i)))
If CInt(IPArray(i)) > 255 Then IPArray(i) = 255
Next
IPToInt = (CInt(IPArray(0))*256*256*256) + (CInt(IPArray(1))*256*256) + (CInt(IPArray(2))*256) + CInt(IPArray(3))
End Function
' ============================================
' 整数逆转IP地址
' ============================================
Function IntToIP(IntValue)
p4 = IntValue - Fix(IntValue/256)*256
IntValue = (IntValue-p4)/256
p3 = IntValue - Fix(IntValue/256)*256
IntValue = (IntValue-p3)/256
p2 = IntValue - Fix(IntValue/256)*256
IntValue = (IntValue - p2)/256
p1 = IntValue
IntToIP = Cstr(p1) & "." & Cstr(p2) & "." & Cstr(p3) & "." & Cstr(p4)
End Function
' ============================================
' 获取开始IP位置
' ============================================
Private Function GetStartIP(RecNo)
OffSet = FirstStartIP + RecNo * 7
Stream.Position = OffSet
Buf = Stream.Read(7)
EndIPOff = AscB(MidB(Buf, 5, 1)) + (AscB(MidB(Buf, 6, 1))*256) + (AscB(MidB(Buf, 7, 1))*256*256)
StartIP = AscB(MidB(Buf, 1, 1)) + (AscB(MidB(Buf, 2, 1))*256) + (AscB(MidB(Buf, 3, 1))*256*256) + (AscB(MidB(Buf, 4, 1))*256*256*256)
GetStartIP = StartIP
End Function
' ============================================
' 获取结束IP位置
' ============================================
Private Function GetEndIP()
Stream.Position = EndIPOff
Buf = Stream.Read(5)
EndIP = AscB(MidB(Buf, 1, 1)) + (AscB(MidB(Buf, 2, 1))*256) + (AscB(MidB(Buf, 3, 1))*256*256) + (AscB(MidB(Buf, 4, 1))*256*256*256)
CountryFlag = AscB(MidB(Buf, 5, 1))
GetEndIP = EndIP
End Function
' ============================================
' 获取地域信息，包含国家和和省市
' ============================================
Private Sub GetCountry(IP)
If (CountryFlag = 1 Or CountryFlag = 2) Then
Country = GetFlagStr(EndIPOff + 4)
If CountryFlag = 1 Then
LocalStr = GetFlagStr(Stream.Position)
' 以下用来获取数据库版本信息
If IP >= IPToInt("255.255.255.0") And IP <= IPToInt("255.255.255.255") Then
LocalStr = GetFlagStr(EndIPOff + 21)
Country = GetFlagStr(EndIPOff + 12)
End If
Else
LocalStr = GetFlagStr(EndIPOff + 8)
End If
Else
Country = GetFlagStr(EndIPOff + 4)
LocalStr = GetFlagStr(Stream.Position)
End If
' 过滤数据库中的无用信息
Country = Trim(Country)
LocalStr = Trim(LocalStr)
If InStr(Country, "CZ88.NET") Then Country = "114XP.CN"
If InStr(LocalStr, "CZ88.NET") Then LocalStr = "114XP.CN"
End Sub
' ============================================
' 获取IP地址标识符
' ============================================
Private Function GetFlagStr(OffSet)
Dim Flag
Flag = 0
Do While (True)
Stream.Position = OffSet
Flag = AscB(Stream.Read(1))
If(Flag = 1 Or Flag = 2 ) Then
Buf = Stream.Read(3)
If (Flag = 2 ) Then
CountryFlag = 2
EndIPOff = OffSet - 4
End If
OffSet = AscB(MidB(Buf, 1, 1)) + (AscB(MidB(Buf, 2, 1))*256) + (AscB(MidB(Buf, 3, 1))*256*256)
Else
Exit Do
End If
Loop
If (OffSet < 12 ) Then
GetFlagStr = ""
Else
Stream.Position = OffSet
GetFlagStr = GetStr()
End If
End Function
' ============================================
' 获取字串信息
' ============================================
Private Function GetStr()
Dim c
GetStr = ""
Do While (True)
c = AscB(Stream.Read(1))
If (c = 0) Then Exit Do
'如果是双字节，就进行高字节在结合低字节合成一个字符
If c > 127 Then
If Stream.EOS Then Exit Do
GetStr = GetStr & Chr(AscW(ChrB(AscB(Stream.Read(1))) & ChrB(C)))
Else
GetStr = GetStr & Chr(c)
End If
Loop
End Function
' ============================================
' 核心函数，执行IP搜索
' ============================================
Public Function QQWry(DotIP)
Dim IP, nRet
Dim RangB, RangE, RecNo
IP = IPToInt (DotIP)
Set Stream = CreateObject("ADodb.Stream")
Stream.Mode = 3
Stream.Type = 1
Stream.Open
Stream.LoadFromFile QQWryFile
Stream.Position = 0
Buf = Stream.Read(8)
FirstStartIP = AscB(MidB(Buf, 1, 1)) + (AscB(MidB(Buf, 2, 1))*256) + (AscB(MidB(Buf, 3, 1))*256*256) + (AscB(MidB(Buf, 4, 1))*256*256*256)
LastStartIP = AscB(MidB(Buf, 5, 1)) + (AscB(MidB(Buf, 6, 1))*256) + (AscB(MidB(Buf, 7, 1))*256*256) + (AscB(MidB(Buf, 8, 1))*256*256*256)
RecordCount = Int((LastStartIP - FirstStartIP)/7)
' 在数据库中找不到任何IP地址
If (RecordCount <= 1) Then
Country = "未知"
QQWry = 2
Exit Function
End If
RangB = 0
RangE = RecordCount
Do While (RangB < (RangE - 1))
RecNo = Int((RangB + RangE)/2)
Call GetStartIP (RecNo)
If (IP = StartIP) Then
RangB = RecNo
Exit Do
End If
If (IP > StartIP) Then
RangB = RecNo
Else
RangE = RecNo
End If
Loop
Call GetStartIP(RangB)
Call GetEndIP()
If (StartIP <= IP) And ( EndIP >= IP) Then
' 没有找到
nRet = 0
Else
' 正常
nRet = 3
End If
Call GetCountry(IP)
QQWry = nRet
End Function
' ============================================
' 类终结
' ============================================
Private Sub Class_Terminate
On ErrOr Resume Next
Stream.Close
If Err Then Err.Clear
Set Stream = Nothing
End Sub
End Class
%>

Tags: asp

分类:技术文章 | 固定链接 | 评论: 0 | 引用: 0 | 查看次数: 2894

Asp截取中文字符

作者:admin 日期:2013-09-21

ASP/Visual Basic代码

Function GetStringLength(txt,length)
dim i
i=1
y=0
txt=trim(txt)
for i=1 to len(txt)
j=mid(txt,i,1)
if asc(j)>=0 and asc(j)<=127 then '汉字外的其他符号,如:!@#,数字,大小写英文字母
y=y+0.5
else '汉字
y=y+1
end if
if -int(-y) >= length then '截取长度
txt = left(txt,i)
exit for
end if
next
GetStringLength=txt
End Function

Tags: asp

分类:技术文章 | 固定链接 | 评论: 0 | 引用: 0 | 查看次数: 2883

[私密日志]

作者:admin 日期:2013-05-15

该日志是私密日志，只有博主或发布者可以查看！

分类:技术文章 | 固定链接 | 评论: 0 | 引用: 0 | 查看次数: 1460

[私密日志]

作者:admin 日期:2013-05-15

该日志是私密日志，只有博主或发布者可以查看！

分类:技术文章 | 固定链接 | 评论: 0 | 引用: 0 | 查看次数: 1287

在英文版的sqlserver下用LIKE语句不能查询中文

作者:admin 日期:2013-04-13

中文版正常是：select * from table1 where field1 like '%王%'
英文版要加上N：select * from table1 where field1 like N'%王%'

Tags: asp sqlserver

分类:技术文章 | 固定链接 | 评论: 0 | 引用: 0 | 查看次数: 3113

Asp防刷新代码

作者:admin 日期:2013-02-24

内容来源于网络，代码为测试，谨慎使用。

1.在要保护的页面顶部加如对AntiRefresh.asp文件的引用如：

2.接着添加调用代码
<%
Const VarNameDateArr="www_domai_net_App_DataArr" '队列名称
Const VarNameIPArr="www_domai_net_App_IPArr"    '队列名称
Dim objAntiRefresh
Set objAntiRefresh= new AntiRefresh
objAntiRefresh.BufferSize=100 '队列大小
objAntiRefresh.CacheItemAvailTime=2 '间隔时间
If Not objAntiRefresh.IsValidAccess() Then
   Set objAntiRefresh=Nothing
Response.Write("您的访问过去频繁请2秒后再试.")
Response.End()
End If
Set objAntiRefresh=Nothing

%>

其中要注意的是
Const VarNameDateArr="www_domai_net_App_DataArr" '队列名称
Const VarNameIPArr="www_domai_net_App_IPArr"    '队列名称
比方你要在List.asp与search.asp中加入通一个防刷新器，那么你把上面的调用代码分别复制到这两个页面，或者保证两个页面的掉用代码一致。这样的效果是，你访问了List.asp页那么你在2秒内将不能访问List.asp或Search.asp页
如果你要2个页面独立，即你访问List.asp后，你会在2秒内不能再次访问List.asp，但是你可以访问Search.asp，反之毅然，那么你就要保证2个页面的 Const VarNameDateArr="xxx"，Const VarNameIPArr="xxx"不同，比方第一个也面你用xxxList,第个个页面用xxxSearch,
如:
Const VarNameDateArr="www_domai_net_App_DataArr_Search" '(_List)
Const VarNameIPArr="www_domai_net_App_IPArr_Search"    '(_List)

唠叨这些是给那么不太懂的朋友，以便他们能使用这些代码，如果你懂Asp那么以上的对你来说就很好理解了。

下面是AntiRefresh.asp文件源码

<%
'***************************************
'*       页面防刷新模块             *
'* WDFrog,2007-8-16

'***************************************

Class AntiRefresh

Private IPArr,DateArr
Private m_BufferSize
Private m_CacheItemAvailTime

Private Sub Class_Initialize()
Application.Lock()
m_BufferSize=100
m_CacheItemAvailTime=2

End Sub
Private Sub Class_Terminate()
Application.UnLock()
End Sub
Public Property Get CacheItemAvailTime
CacheItemAvailTime=m_CacheItemAvailTime
End Property
Public Property Let CacheItemAvailTime(Value)
m_CacheItemAvailTime=Value
End Property

Public Property Get BufferSize
BufferSize=m_BufferSize
End Property

Public Property Let BufferSize(Value)
m_BufferSize=Value
End Property

Private Sub EnsureArr()
If IsArray(Application(VarNameDateArr)) Then
DateArr=Application(VarNameDateArr)
Else
ReDim DateArr(BufferSize)
End If

If IsArray(Application(VarNameIPArr)) Then
IPArr=Application(VarNameIPArr)
Else
ReDim IPArr(BufferSize)
End If
End Sub

Public Function IsValidAccess()
Dim ip,i
ip=GetIP()
IsValidAccess=True
EnsureArr()
For i=1 To BufferSize
If IPArr(i)=ip Then
   If DateDiff("s",CDate(DateArr(i)),Now()) < CacheItemAvailTime Then
   IsValidAccess=False
   Exit Function
   End If
End If
Next
Call QueueHandle()
DateArr(1)=Now()
IPArr(1)=ip
Application(VarNameIPArr)=IPArr
Application(VarNameDateArr)=DateArr
End Function

Public Function ClearCache()
Set Application(VarNameDateArr)=Nothing
Set Application(VarNameIPArr)=Nothing
End Function

Private Sub QueueHandle()
Dim i,j

For i=BufferSize-1 To 1 Step -1
DateArr(i+1)=DateArr(i)
Next
For j=BufferSize-1 To 1 Step -1
IPArr(j+1)=IPArr(j)
Next
End Sub

Private Function GetIP()
Dim strIPAddr
If Request.ServerVariables("HTTP_X_FORWARDED_FOR") = "" or InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), "unknown") > 0 Then
strIPAddr = Request.ServerVariables("REMOTE_ADDR")
ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",") > 0 Then
strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",")-1)
ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";") > 0 Then
strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";")-1)
Else
strIPAddr = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
End If
GetIP = (Trim(Mid(strIPAddr, 1, 30)))
End Function

End Class
%>

Tags: asp

分类:技术文章 | 固定链接 | 评论: 0 | 引用: 0 | 查看次数: 2421

ASP的URLDecode函数URLEncode解码函数

作者:admin 日期:2012-12-16

ASP/Visual Basic代码

Function URLDecode(ByVal urlcode)
Dim start,final,length,char,i,butf8,pass
Dim leftstr,rightstr,finalstr
Dim b0,b1,bx,blength,position,u,utf8
On Error Resume Next
b0 = Array(192,224,240,248,252,254)
urlcode = Replace(urlcode,"+"," ")
pass = 0
utf8 = -1
length = Len(urlcode) : start = InStr(urlcode,"%") : final = InStrRev(urlcode,"%")
If start = 0 Or length < 3 Then URLDecode = urlcode : Exit Function
leftstr = Left(urlcode,start - 1) : rightstr = Right(urlcode,length - 2 - final)
For i = start To final
char = Mid(urlcode,i,1)
If char = "%" Then
bx = URLDecode_Hex(Mid(urlcode,i + 1,2))
If bx > 31 And bx < 128 Then
i = i + 2
finalstr = finalstr & ChrW(bx)
ElseIf bx > 127 Then
i = i + 2
If utf8 < 0 Then
butf8 = 1 : blength = -1 : b1 = bx
For position = 4 To 0 Step -1
If b1 >= b0(position) And b1 < b0(position + 1) Then
blength = position
Exit For
End If
Next
If blength > -1 Then
For position = 0 To blength
b1 = URLDecode_Hex(Mid(urlcode,i + position * 3 + 2,2))
If b1 < 128 Or b1 > 191 Then butf8 = 0 : Exit For
Next
Else
butf8 = 0
End If
If butf8 = 1 And blength = 0 Then butf8 = -2
If butf8 > -1 And utf8 = -2 Then i = start - 1 : finalstr = "" : pass = 1
utf8 = butf8
End If
If pass = 0 Then
If utf8 = 1 Then
b1 = bx : u = 0 : blength = -1
For position = 4 To 0 Step -1
If b1 >= b0(position) And b1 < b0(position + 1) Then
blength = position
b1 = (b1 xOr b0(position)) * 64 ^ (position + 1)
Exit For
End If
Next
If blength > -1 Then
For position = 0 To blength
bx = URLDecode_Hex(Mid(urlcode,i + 2,2)) : i = i + 3
If bx < 128 Or bx > 191 Then u = 0 : Exit For
u = u + (bx And 63) * 64 ^ (blength - position)
Next
If u > 0 Then finalstr = finalstr & ChrW(b1 + u)
End If
Else
b1 = bx * &h100 : u = 0
bx = URLDecode_Hex(Mid(urlcode,i + 2,2))
If bx > 0 Then
u = b1 + bx
i = i + 3
Else
If Left(urlcode,1) = "%" Then
u = b1 + Asc(Mid(urlcode,i + 3,1))
i = i + 2
Else
u = b1 + Asc(Mid(urlcode,i + 1,1))
i = i + 1
End If
End If
finalstr = finalstr & Chr(u)
End If
Else
pass = 0
End If
End If
Else
finalstr = finalstr & char
End If
Next
URLDecode = leftstr & finalstr & rightstr
End Function
Function URLDecode_Hex(ByVal h)
On Error Resume Next
h = "&h" & Trim(h) : URLDecode_Hex = -1
If Len(h) <> 4 Then Exit Function
If isNumeric(h) Then URLDecode_Hex = cInt(h)
End Function

Tags: asp

分类:技术文章 | 固定链接 | 评论: 0 | 引用: 0 | 查看次数: 3420

Asp实现不带www301重定向到带www且带参数

作者:admin 日期:2012-11-04

带参数的301重定向代码好像不多见，自己写了一段：

ASP/Visual Basic代码

Dim strHostName,strScriptName,strSubUrl,strRequestItem
strHostName=CStr(Request.ServerVariables("HTTP_HOST"))
if strHostName="shanxicoal.com" then
strScriptName=CStr(Request.ServerVariables("SCRIPT_NAME"))
strSubUrl=""
If Request.QueryString<>"" Then
strScriptName=strScriptName&"?"
For Each strRequestItem In Request.QueryString
If InStr(strScriptName,strRequestItem)=0 Then
If strSubUrl="" Then
strSubUrl=strSubUrl&strRequestItem&"="&Server.URLEncode(Request.QueryString(""&strRequestItem&""))
Else
strSubUrl=strSubUrl&"&"&strRequestItem&"="&Server.URLEncode(Request.QueryString(""&strRequestItem&""))
End If
End If
Next
End If
GetUrl="http://www."&strHostName&strScriptName&strSubUrl
Response.Status="301 Moved Permanently"
Response.AddHeader "Location",GetUrl
end if