操作系统和网络技术研究
以下是Asp判断客户端操作系统源码，支持自定义关键词，支持“<img”方式调用：
<%
Function GetSysVer() '获取系统类型(可以判断:29种操作系统(包括手机))
GetSysVer="Other Unknown"
TheInfo = UCase(Request.ServerVariables("HTTP_USER_AGENT"))
if Instr(TheInfo,UCase("x11"))>0 or Instr(TheInfo,UCase("Unix"))>0 then GetSysVer="Unix"
if Instr(TheInfo,UCase("Sunos"))>0 or In Continue reading "ASP判断操作系统的代码"
pop：闲着无聊又想把博客的程序换一下，所以找了一些转换程序，看是否能有合适我博客转换的。这个程序很不错，可以把TAG、评论、留言、分类等都移植过去，真的是无缝转换。
程序说明：
1、把文件传到ASP空间上就可以了
2、转换后zblog的用户 Continue reading "PJBlog无缝转换到ZBlog的ASP程序"
pop：之前XP安装IIS还需要放入光盘，现在winodws7都不需要光盘了，直接安装就可以搞定了。具体的步骤如下
1、进入Windows 7的“控制面板”--“程序和功能”，选择左侧的“打开或关闭Windows功能”。
2、现在出现了安装Windows功能的选项菜单，注意选择的项目，一般来说默认就可以了。但是为了开启ASP的服务，就要勾选一下“应用程序开发功能”下的“ASP和ISAPI扩展”
3、安装完成后，点击“控制面板”--“所有控制面板项”--“管理工具”，双击“Internet(IIS)管理器”进入IIS的设置。
4、选择“Default Web Site”，并双击右边的“ASP”选项
5、这时弹出了ASP的默认配置，在“启用父路径”这里选择“True”即可开启父路径。（至于为什么要开父路径自己去搜索一下，也就是为了支持 ../ 类似的调用语句）
6、配置IIS7的站点。 单击右边的 高级设置 选项，可以设置网站的目录。
7、点击右侧的“绑定...”，设置网站的端口，默认为80，也可以为其他端口 。
8、点击“默认文档”， 设置网站的默认首页文档，根据自己网站首页文件进行设置即可。
至此，Windows 7的IIS7设置已经基本完成了，ASP+Access程序也可以调试成功。
原文地址（附图片）：
http://blog.sina.com.cn/s/blog_55b0c6470100h355.html
实现效果：通过对特殊字符的转换，可以保证数据的安全。
代码如下：
<%
Function FormatHTML(fString)
If fString<>"" Then
fString = trim(fString)
fString = replace(fString, ";", "；") ''分号过滤
> fString = replace(fString, "--", "——") ''--过滤
fString = replace(fString, "%20", "") ''特殊字符过滤
p; fString = replace(fString, "==", "") ''==过滤
fString = replace(fString, ">", ">")
fString = replace(fString,
"<", "<")
fString = Replace(fString, CHR(32), " ") ''
fString = Replace(fString, CHR(9
: #000000; BACKGROUND-COLOR: #f5f5f5">), " ") ''
fString = Replace(fString, CHR(34), """)
fString = Replace(fString, CHR(39), "'
KGROUND-COLOR: #f5f5f5">") ''单引号过滤
fString = Replace(fString, CHR(13), "")
fString = Replace(fString, CHR(10) & CHR(10), "</P><P>
pan>")
fString = Replace(fString, CHR(10), "<BR> ")
FormatHTML = fString
End If
End Function
%>
第二种代码：
<%
Function ChkInvaildWord(Words)
Const InvaildWords="select|update|delete|insert|@|--|," '需要过滤得字符以“|”隔开，最后结束的字符必须是|
ChkInvaildWord=True
InvaildWord=Split(InvaildWords,"|")
inWords=LCase(Trim(Words))
For i=LBound(InvaildWord) To UBound(InvaildWord)
If Instr(inWords,InvaildWord(i))>0 Then
ChkInvaildWord=True
Exit Function
End If
Next
ChkInvaildWord=False
End Function
%>
实现的效果：
当访问出现404错误提示信息的时候系统会自动发一封邮件给管理员，这样就不必担心了也有不能访问的死链接了
把下面的带嵌入到404页面之后，设置好中间的帐号和密码。
代码如下：
<% @language="vbscript" %>
<% Option Explicit %>
<%
Dim strPage, strReferer, strMessage
Dim objSMTP
' Log the offending page
strPage = Request.ServerVariables("HTTP_URL")
' Log the referer
strReferer = Request.ServerVariables("HTTP_REFERER")
' Set up the email component
Set objSMTP = Server.CreateObject("JMail.Message")
objSMTP.From = "you@yourdomain.com"
objSMTP.FromName = "Your Domain"
objSMTP.Subject = "404 Error Logged"
objSMTP.AddRecipient("you@yourdomain.com")
' Write the message
strMessage = "Requested page: " & strPage & vbCrLf & vbCrLf
If strReferer <> "" Then
strMessage = strMessage & "Referer: " & strReferer
Else
strMessage = strMessage "The visitor typed the address in"
End If
objSMTP.Body = strMessage
' Send the message
objSMTP.Send("mail.jzxue.com")
' Tidy up
objSMTP.ClearRecipients
objSMTP.Close()
Set objSMTP = Nothing
%>
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN"
"http://www.w3.org/TR/html4/strict.dtd">
<html lang="en">
<head>
<title>404 Page Not Found</title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
</head>
<body>
<h1>404 Page Not Found Error</h1>
<p>
Appropriate message here.
</p>
</body>
</html>
注释的作用就是为了以后方面自己修改，当然注释的代码是不执行的，也可以注释一些经常需要修改的代码
一、html的注释方法
二、CSS的注释方法
在单独的css样式表文件中也采用此方法注释
三、java
四、asp
'asp单行需要注释的内容
其他注释方法：
vbs用“'”或“REM”来注释内容
PHP支持C，C++和Unix风格的注释方式：
/* C,C++ 多行注释的内容 */
// C++ 单行注释的内容
# Unix 单行注释的内容
将下面的代码保存为 .asp的文件，如1.asp
代码如下：
<%
'受屏蔽IP地址(段)集合，星号为通配符，通常保存于配置文件中。
Const BadIPGroup = "192.168.1.*|119.96.207.*"
If IsForbidIP(BadIPGroup) = True Then
Response.Write("您的IP地址是："& GetIP &" 此IP地址禁止访问！")
Response.End()
End If
'参数vBadIP：要屏蔽的IP段,IP地址集合，用|符号分隔多个IP地址(段)
'返回Bool：True用户IP在被屏蔽范围，False 反之
Function IsForbidIP(vBadIP)
Dim counter, arrIPPart, arrBadIP, arrBadIPPart, i, j
arrBadIP = Split(vBadIP, "|")
arrIPPart = Split(GetIP(), ".")
For i = 0 To UBound(arrBadIP)
counter = 0
arrBadIPPart = Split(arrBadIP(i), ".")
For j = 0 To UBound(arrIPPart)
If(arrBadIPPart(j)) = "*" or Cstr(arrIPPart(j)) = Cstr(arrBadIPPart(j)) Then
counter = counter + 1
End If
Next
If counter = 4 Then
IsForbidIP = True
Exit Function
End If
Next
IsForbidIP = False
End Function
'返回客户IP地址
Function GetIP()
Dim IP
IP = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
If IP = "" Then IP = Request.ServerVariables("REMOTE_ADDR")
GetIP = IP
End Function
%>
最近做网站后台的时候，登陆后发现刷新页面时Session会丢失，过几秒钟也会自然丢失，查了资料后发现可以这样解决：
具体解决步骤：
当您在负载平衡的 Web 场环境中运行 ASP.NET Web 应用程序时，一定要使用 SqlServer 或 StateServer 会话状态模式，在项目中我们基于性能考虑并没有选择SqlServer模式来存储Session状态，而是选择一台SessionStateServer 服务器来用户的Session会话状态。
我们要在系统配置文件web.config中设置如下：
mode="StateServer" //就是修改这里为“StateServer”
stateConnectionString="tcpip=127.0.0.1:42424"
sqlConnectionString="data source=127.0.0.1;Trusted_Connection=yes"
cookieless="false"
timeout="30"
/>
2、打开“控制面板--管理工具--服务”，将“ASP.NET State Service”把它设为自动启动即可。
pop：在网上搜集到的，随便修改了一下。要正常使用的话，下载一个最新的纯真IP数据库到目录下就可以查询了。
代码如下：
<%
IP = request("IP")
If IP = "" then
IP = Request.ServerVariables("REMOTE_ADDR")
%>
<style type="text/css">
<!--
.search {
height: auto;
width: 200px;
}
.STYLE1 {
font-size: 12px;
font-weight: bold;
}
-->
</style>
<title>ip138ASP查询程序</title><table width="400" align="center">
<tr>
<td><span class="STYLE1">您的IP是：</span><%=IP%> <span class="STYLE1">来自：</span><%=Disp_IPAddressData(IP,2)%><%=Disp_IPAddressData(IP,3)%>
<%End if%></td>
</tr>
</table>
<br />
<table width="400" border="0" align="center">
<tr>
<td><span class="STYLE1">请输入您需要查询的IP地址：</span>
<input name="IP" type="text" id="IP">
<input type="submit" name="Submit" value="查询">
</td>
</tr>
</table>
<p align="center"><br />
<%
' ============================================
' 返回IP信息 Disp_IPAddressData(IP,0)
' ============================================
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
'''''Look_Ip = Wry.Country & ""
End Function
' ============================================
' 返回IP信息 JS调用
' ============================================
Function Disp_IPAddressData(IP, sType)
Dim Wry, IPType
Set Wry = New TQQWry
IPType = Wry.QQWry(IP)
Select Case sType
Case 1 Disp_IPAddressData = IP
Case 2 Disp_IPAddressData = Wry.Country
Case 3 Disp_IPAddressData = Wry.LocalStr
'Case Else Disp_IPAddressData = Wry.Country & "" & Wry.LocalStr
Case Else Disp_IPAddressData = Wry.Country
End Select
End Function
' ============================================
' 返回QQWry信息
' ============================================
Function WryInfo()
Dim Wry, IPType, QQWry_tem(0), QQWry_tem1(1)
' 设置类对象
Set Wry = New TQQWry
IPType = Wry.QQWry("255.255.255.254")
' 读取数据库版本信息
QQWry_tem(0) = Wry.Country & " " & Wry.LocalStr
' 读取数据库IP地址数目
QQWry_tem1(1) = Wry.RecordCount + 1
WryInfo = QQWry_tem(0)& " " & QQWry_tem1(1)
End Function
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")
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 = ""
If InStr(LocalStr, "CZ88.NET") Then LocalStr = ""
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
%>
<br />
Copyright (c) pop 2008 Allright Reserved.
ASPWebPack(整站文件备份系统) v1.0
功能列表：1、备份数据 2、恢复数据 3、上传备份 4、备份管理
程序说明：拥有了 ASPWebPack，上传更新网站，您只需一步即可完成。适用于空间没有代备份功能的用户，如果您的虚拟主机自带了备份功能，那可以用来辅助整站下载嘛。更适用于做为黑工具，方便各种职业下载整站源代码商业拍卖(声明:作者的意图并非如此，希望大家勿用于非法。)。反正就是方便到家啦，希望大家喜欢。
补充说明：本地打包文件请使用NetBox，或者自己开本地IIS。
作者声明：本程序只作为辅助站长备份站点使用，请勿用于非法。版权归 Cool-Co 所有，如擅自非法使用本人概不负责。
JiaJia 使用报告：可以用精辟的四个字来形容，那就是“非常好用”，真的好用，其他的我想不出什么不好用的地方啦。
默认密码：yulv.net
下载地址：
http://www.cncode.com/downinfo/10862.html
http://www.newasp.net/code/asp/22837.html
ASP网站打包急速（推荐）
ASP网站打包急速版
//1.asp ASP后门打包
//解压.vbs VBS本地解压
用记事本打开1.asp文件，找到pop.mdb，把pop.mdb改成您想要的名称
1.asp内容：
<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<%
Option Explicit
Response.Buffer = True
Server.ScriptTimeOut=999999999
%>
<%
dim dbFile,Fso,Sql,mdbFile,Cat,Conn,Rs,obj,objFolder,objFile,objStream,strNoPack
mdbFile="pop.mdb" '数据库名字
strNoPack = "pop.mdb|1.asp" '不打包的文件或文件夹
dbFile=server.MapPath(mdbFile)
Set Fso = CreateObject("Scripting.FileSystemObject")
If Fso.FileExists(dbFile) Then '如果数据库存在就删除原有数据
Fso.DeleteFile(dbFile)
End If
Set Fso=nothing
Set Cat=server.CreateObject("ADOX.Catalog") '开始建立数据库
Cat.Create "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbFile
Set Cat=nothing
If Err.Number=0 Then
Response.Write ("-->数据库 " & dbFile & " 创建成功<br /> ")
Else
Response.Write ("-->数据库创建失败，原因： " & err.description)
Response.End
End If
Set Conn = Server.CreateObject("ADODB.Connection") '建立表
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & dbFile
Sql="Create TABLE filedata([id] counter PRIMARY KEY,[path] Memo,[file] General)"
Conn.Execute(Sql)
Set Rs = CreateObject("ADODB.RecordSet")
Rs.Open "FileData", Conn, 1, 3
Set obj=server.createobject("scripting.filesystemobject")
Set objFolder=obj.getfolder(server.mappath("/")) '需要打包的目录
Search objFolder '开始查找文件
Response.Write("-->打完，收工回家睡觉！")
Function Search(objFolder)'文件搜索函数
Dim objSubFolder
If Ext(objFolder.name) Then
For Each objFile in objFolder.files
Set objStream = Server.CreateObject("ADODB.Stream")
objStream.Type = 1
objStream.Open
If Not Ext(objFile.name) or Right(objFile.path,len(mdbFile))=mdbFile or Right(objFile.path,4)=".ldb" then
Response.Write ("-->跳过"&objFile.name&"<br />")
Else
Response.Write ("-->"&objFile.path&"<br />")
objStream.LoadFromFile objFile.path
Rs.addnew
Rs("file")=objstream.read
Rs("Path")=Right(objFile.path,Len(objFile.path)-3)
Rs.update
objStream.close
End If
Next
For Each objSubFolder in objFolder.SubFolders
Search objSubFolder
Next
Else
Response.Write ("-->跳过"&objFolder.path&"<br />")
End If
End Function
Function Ext(FileName)
Ext = True
dim temp_ext,e
temp_ext = Split(strNoPack,"|")
for e=0 to ubound(temp_ext)
If LCase(filename)=LCase(temp_ext(e)) Then Ext=False
Next
End Function
%>
解压.vbs内容：
Dim rs, ws, fso, conn, stream, connStr, theFolder
Set rs = CreateObject("ADODB.RecordSet")
Set stream = CreateObject("ADODB.Stream")
Set conn = CreateObject("ADODB.Connection")
Set fso = CreateObject("Scripting.FileSystemObject")
dbname=inputbox("请在下面输入数据库名称，数据库必须与本程序在同一目录。名称如pop.mdb", "pop's 网站解压", "pop.mdb")
connStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="&dbname&";"
conn.Open connStr
rs.Open "select * from [filedata]", conn, 1, 1
stream.Open
stream.Type = 1
On Error Resume Next
Do Until rs.Eof
theFolder = Left(rs("path"), InStrRev(rs("path"), "\"))
If fso.FolderExists(theFolder) = False Then
createFolder(theFolder)
End If
stream.SetEos()
stream.Write rs("file")
stream.SaveToFile str & rs("path"), 2
rs.MoveNext
Loop
rs.Close
conn.Close
stream.Close
Set ws = Nothing
Set rs = Nothing
Set stream = Nothing
Set conn = Nothing
Wscript.Echo "所有文件释放完毕!"
Sub createFolder(path)
Dim i
i = Instr(path, "\")
Do While i > 0
If fso.FolderExists(Left(path, i)) = False Then
fso.CreateFolder(Left(path, i - 1))
End If
If InStr(Mid(path, i + 1), "\") Then
i = i + Instr(Mid(path, i + 1), "\")
Else
i = 0
End If
Loop
End Sub
ASP网站打包急速版 下载地址：
http://www.uudisc.com/user/pop3067/file/1228461
http://115.com/file/bh0qlg9w