<![CDATA[邮件技术网-邮件中继,海外退信,反垃圾网关,邮件代收,外贸邮箱,邮件群发]]> http://www.030904.net/ zh-cn www.emlog.net ASP读取TXT http://www.030904.net/program/186.html <%
dim ss(20)
set fs=server.createobject("scripting.filesystemobject") 
file=server.mappath("qq.txt") 
set txt=fs.opentextfile(file,1,true) 
for n=1 to 20 ‘读取前二十行
if txt.atendofstream then exit for
'do not txt.atendofstream
line=txt.readline
'a=instr(line,"-")
's=left(line,a)
response.write line & "<br>" 
'loop
next
%>
'ReadLine：从文件中读取一行数据 
'Read(N)：从文件中读取N个字节的数据 
'ReadAll：读取文件中的所有数据

========================FSO=============================
究级FSO函数，推荐使用。 
<% 
Class Cls_FSO 
Public objFSO 
Private Sub Class_Initialize() 
Set objFSO = Server.CreateObject("Scripting.FileSystemObject") 
End Sub 
Private Sub class_terminate() 
Set objFSO = Nothing 
End Sub 
'=======文件操作======== 
'取文件大小 
Public Function GetFileSize(FileName) 
Dim f 
If ReportFileStatus(FileName) = 1 Then 
Set f = objFSO.Getfile(FileName) 
GetFileSize = f.Size 
Else 
GetFileSize = -1 
End if 
End Function 
'文件删除 
Public Function deleteAFile(FileSpec) 
If ReportFileStatus(FileSpec) = 1 Then 
objFSO.deleteFile(FileSpec) 
deleteAFile = 1 
Else 
deleteAFile = -1 
End if 
End Function 
'显示文件列表 
Public Function ShowFileList(FolderSpec) 
Dim f, f1, fc, s 
If ReportFolderStatus(FolderSpec) = 1 Then 
Set f = objFSO.GetFolder(FolderSpec) 
Set fc = f.Files 
For Each f1 in fc 
s = s & f1.name 
s = s & "|" 
Next 
ShowFileList = s 
Else 
ShowFileList = -1 
End if 
End Function 
'文件复制 
Public Function CopyAFile(SourceFile, DestinationFile) 
Dim MyFile 
If ReportFileStatus(SourceFile) = 1 Then 
Set MyFile = objFSO.GetFile(SourceFile) 
MyFile.Copy (DestinationFile) 
CopyAFile = 1 
Else 
CopyAFile = -1 
End if 
End Function 
'文件移动 
Public Function MoveAFile(SourceFile,DestinationFile) 
If ReportFileStatus(SourceFile) = 1 And ReportFileStatus(DestinationFileORPath) = -1 Then 
objFSO.MoveFile SourceFile,DestinationFileORPath 
MoveAFile = 1 
Else 
MoveAFile = -1 
End if 
End Function 
'文件是否存在？ 
Public Function ReportFileStatus(FileName) 
Dim msg 
msg = -1 
If (objFSO.FileExists(FileName)) Then 
msg = 1 
Else 
msg = -1 
End If 
ReportFileStatus = msg 
End Function 
'文件创建日期 
Public Function ShowDatecreated(FileSpec) 
Dim f 
If ReportFileStatus(FileSpec) = 1 Then 
Set f = objFSO.GetFile(FileSpec) 
ShowDatecreated = f.Datecreated 
Else 
ShowDatecreated = -1 
End if 
End Function 
'文件属性 
Public Function GetAttributes(FileName) 
Dim f 
Dim strFileAttributes 
If ReportFileStatus(FileName) = 1 Then 
Set f = objFSO.GetFile(FileName) 
select Case f.attributes 
Case 0 strFileAttributes = "普通文件。没有设置任何属性。 " 
Case 1 strFileAttributes = "只读文件。可读写。 " 
Case 2 strFileAttributes = "隐藏文件。可读写。 " 
Case 4 strFileAttributes = "系统文件。可读写。 " 
Case 16 strFileAttributes = "文件夹或目录。只读。 " 
Case 32 strFileAttributes = "上次备份后已更改的文件。可读写。 " 
Case 1024 strFileAttributes = "链接或快捷方式。只读。 " 
Case 2048 strFileAttributes = " 压缩文件。只读。" 
End select 
GetAttributes = strFileAttributes 
Else 
GetAttributes = -1 
End if 
End Function 
'最后一次访问/最后一次修改时间 
Public Function ShowFileAccessInfo(FileName,InfoType) 
'//功能：显示文件创建时信息 
'//形参：文件名,信息类别 
'// 1 -----创建时间 
'// 2 -----上次访问时间 
'// 3 -----上次修改时间 
'// 4 -----文件路径 
'// 5 -----文件名称 
'// 6 -----文件类型 
'// 7 -----文件大小 
'// 8 -----父目录 
'// 9 -----根目录 
Dim f, s 
If ReportFileStatus(FileName) = 1 then 
Set f = objFSO.GetFile(FileName) 
select Case InfoType 
Case 1 s = f.Datecreated 
Case 2 s = f.DateLastAccessed 
Case 3 s = f.DateLastModified 
Case 4 s = f.Path 
Case 5 s = f.Name 
Case 6 s = f.Type 
Case 7 s = f.Size 
Case 8 s = f.ParentFolder 
Case 9 s = f.RootFolder 
End select 
ShowFileAccessInfo = s 
ELse 
ShowFileAccessInfo = -1 
End if 
End Function 
'写文本文件 
Public Function WriteTxtFile(FileName,TextStr,WriteORAppendType) 
Const ForReading = 1, ForWriting = 2 , ForAppending = 8 
Dim f, m 
select Case WriteORAppendType 
Case 1: '文件进行写操作 
Set f = objFSO.OpenTextFile(FileName, ForWriting, True) 
f.Write TextStr 
f.Close 
If ReportFileStatus(FileName) = 1 then 
WriteTxtFile = 1 
Else 
WriteTxtFile = -1 
End if 
Case 2: '文件末尾进行写操作 
If ReportFileStatus(FileName) = 1 then 
Set f = objFSO.OpenTextFile(FileName, ForAppending) 
f.Write TextStr 
f.Close 
WriteTxtFile = 1 
Else 
WriteTxtFile = -1 
End if 
End select 
End Function 
'读文本文件 
Public Function ReadTxtFile(FileName) 
Const ForReading = 1, ForWriting = 2 
Dim f, m 
If ReportFileStatus(FileName) = 1 then 
Set f = objFSO.OpenTextFile(FileName, ForReading) 
m = f.ReadLine 
ReadTxtFile = m 
f.Close 
Else 
ReadTxtFile = -1 
End if 
End Function 
'建立文本文件 

'=======目录操作======== 
'取目录大小 
Public Function GetFolderSize(FolderName) 
Dim f 
If ReportFolderStatus(FolderName) = 1 Then 
Set f = objFSO.GetFolder(FolderName) 
GetFolderSize = f.Size 
Else 
GetFolderSize = -1 
End if 
End Function 
'创建的文件夹 
Public Function createFolderDemo(FolderName) 
Dim f 
If ReportFolderStatus(Folderspec) = 1 Then 
createFolderDemo = -1 
Else 
Set f = objFSO.createFolder(FolderName) 
createFolderDemo = 1 
End if 
End Function 
'目录删除 
Public Function deleteAFolder(Folderspec) 
Response.write Folderspec 
If ReportFolderStatus(Folderspec) = 1 Then 
objFSO.deleteFolder (Folderspec) 
deleteAFolder = 1 
Else 
deleteAFolder = -1 
End if 
End Function 
'显示目录列表 
Public Function ShowFolderList(FolderSpec) 
Dim f, f1, fc, s 
If ReportFolderStatus(FolderSpec) = 1 Then 
Set f = objFSO.GetFolder(FolderSpec) 
Set fc = f.SubFolders 
For Each f1 in fc 
s = s & f1.name 
s = s & "|" 
Next 
ShowFolderList = s 
Else 
ShowFolderList = -1 
End if 
End Function 
'目录复制 
Public Function CopyAFolder(SourceFolder,DestinationFolder) 
objFSO.CopyFolder SourceFolder,DestinationFolder 
CopyAFolder = 1 
CopyAFolder = -1 
End Function 

'目录进行移动 
Public Function MoveAFolder(SourcePath,DestinationPath) 
If ReportFolderStatus(SourcePath)=1 And ReportFolderStatus(DestinationPath)=0 Then 
objFSO.MoveFolder SourcePath, DestinationPath 
MoveAFolder = 1 
Else 
MoveAFolder = -1 
End if 
End Function 
'判断目录是否存在 
Public Function ReportFolderStatus(fldr) 
Dim msg 
msg = -1 
If (objFSO.FolderExists(fldr)) Then 
msg = 1 
Else 
msg = -1 
End If 
ReportFolderStatus = msg 
End Function 
'目录创建时信息 
Public Function ShowFolderAccessInfo(FolderName,InfoType) 
'//功能：显示目录创建时信息 
'//形参：目录名,信息类别 
'// 1 -----创建时间 
'// 2 -----上次访问时间 
'// 3 -----上次修改时间 
'// 4 -----目录路径 
'// 5 -----目录名称 
'// 6 -----目录类型 
'// 7 -----目录大小 
'// 8 -----父目录 
'// 9 -----根目录 
Dim f, s 
If ReportFolderStatus(FolderName) = 1 then 
Set f = objFSO.GetFolder(FolderName) 
select Case InfoType 
Case 1 s = f.Datecreated 
Case 2 s = f.DateLastAccessed 
Case 3 s = f.DateLastModified 
Case 4 s = f.Path 
Case 5 s = f.Name 
Case 6 s = f.Type 
Case 7 s = f.Size 
Case 8 s = f.ParentFolder 
Case 9 s = f.RootFolder 
End select 
ShowFolderAccessInfo = s 
ELse 
ShowFolderAccessInfo = -1 
End if 
End Function 
'遍历目录 
Public Function DisplayLevelDepth(pathspec) 
Dim f, n ,Path 
Set f = objFSO.GetFolder(pathspec) 
If f.IsRootFolder Then 
DisplayLevelDepth ="指定的文件夹是根文件夹。"&RootFolder 
Else 
Do Until f.IsRootFolder 
Path = Path & f.Name &"<br>" 
Set f = f.ParentFolder 
n = n + 1 
Loop 
DisplayLevelDepth ="指定的文件夹是嵌套级为 " & n & " 的文件夹。<br>" & Path 
End If 
End Function 
'========磁盘操作======== 
'驱动器是否存在？ 
Public Function ReportDriveStatus(drv) 
Dim msg 
msg = -1 
If objFSO.DriveExists(drv) Then 
msg = 1 
Else 
msg = -1 
End If 
ReportDriveStatus = msg 
End Function 
'可用的返回类型包括 FAT、NTFS 和 CDFS。 
Public Function ShowFileSystemType(drvspec) 
Dim d 
If ReportDriveStatus(drvspec) = 1 Then 
Set d = objFSO.GetDrive(drvspec) 
ShowFileSystemType = d.FileSystem 
ELse 
ShowFileSystemType = -1 
End if 
End Function 
End Class 
%>]]> Thu, 17 Sep 2015 06:26:47 +0000 山坛兄弟 http://www.030904.net/program/186.html ASP代码中如何屏蔽ip地址 禁止某IP段访问网站 http://www.030904.net/program/184.html 经常有些地方性的B2B或者B2C网站到处都被批量发布好多垃圾信息，把我的解决办法分享给大家：

　　把以下代码加入到你的ASP页面就可以测试到效果了：

        <%
        '受屏蔽IP地址(段)集合，星号为通配符，通常保存于配置文件中。 
        Const BadIPGroup = "192.168.1.*|202.68.*.*|*.12.55.34|185.*.96.24|127.*.0.1|192.168.0.1"

        If IsForbidIP(BadIPGroup) = True Then 
        Response.Write(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
   %>

       

　　这样就可以限制网站访问的IP段了，你可以根据地区的IP段来设置。

]]> Thu, 17 Sep 2015 06:20:43 +0000 山坛兄弟 http://www.030904.net/program/184.html FSO(File System Object)操作函数集(检测 创建 删除 文件 文件夹) http://www.030904.net/program/149.html '////////////////////////////////////////////////FSO操作/////////////////////////////////////
'判断文件夹是否存在
Function FolderExits(Folder)
Folder=Server.Mappath(Folder)
Set FSO= Server.CreateObject("Scripting.FileSystemObject")
IF FSO.FolderExists(Folder) Then
   FolderExits=true
Else
   FolderExits=false
End IF 
End Function

'判断文件是否存在
Function FileExits(FileName)
FileName=Server.Mappath(FileName)
Set FSO= Server.CreateObject("Scripting.FileSystemObject")
IF FSO.FileExists(FileName) Then
   FileExits=true
Else
   FileExits=false
End IF 
End Function

'创建文件夹
Function CreateFolder(Folder)
on error resume next
Folder=Server.Mappath(Folder)
Set FSO = Server.CreateObject("Scripting.FileSystemObject")
FSO.CreateFolder(Folder)
if err>0 then 
  err.clear
  CreateFolder=False
else 
  CreateFolder=True
end if 
End function

'创建文件
Function CreateFile(FileName,Content)
on error resume next
FileName=Server.Mappath(FileName)
Set FSO = Server.CreateObject("Scripting.FileSystemObject")
set fd=FSO.createtextfile(FileName,true)
fd.writeline Content
if err>0 then 
  err.clear
  CreateFile=False
else 
  CreateFile=True
end if 
End function

'删除文件
function DeleteFile(FileName)
on error resume next 
Set FSO = Server.CreateObject("Scripting.FileSystemObject")
if FSO.FileExists(FileName) then 
  FSO.DeleteFile FileName,true
end if
if err>0 then 
  err.clear
  DeleteFile=False
else 
  DeleteFile=True
end if 
end function 

'删除文件夹
function DeleteFolder(Folder)
on error resume next 
Folder=server.MapPath(Folder)
Set FSO = Server.CreateObject("Scripting.FileSystemObject")
if FSO.FolderExists(Folder) then 
  FSO.Deletefolder Folder,true
end if
if err>0 then 
  err.clear
  Deletefolder=False
else 
  Deletefolder=True
end if 
end function ]]> Wed, 08 Oct 2014 12:27:38 +0000 山坛兄弟 http://www.030904.net/program/149.html lanmp v2.5安装soap支持方法 http://www.030904.net/program/97.html 服务器的环境采用的是lanmp v2.5，后来采用webservice接口做程序，发现不支持soap，只能自己安装，在网上找了很多资料，终于安装成功了，安装方式如下：

首先建立一个文件夹，以方便下载源程序，本文以test来命名。
进入web目录：
cd /www
在里面创建test文件夹：
mkdir test
下载lanmp v2.5至test文件夹
wget http://dl.wdlinux.cn:5180/lanmp_v2.5.tar.gz 
解压下载的文件：
tar zxvf lanmp_v2.5.tar.gz 
进入lanmp目录：
cd lanmp
tar zxvf php-5.3.27.tar.gz  （解压对应的PHP版本）
cd php-5.3.27
cd ext/soap
/www/wdlinux/php/bin/phpize
./configure --with-php-config=/www/wdlinux/php/bin/php-config
make
make install
echo 'extension=soap.so' >> /www/wdlinux/etc/php.ini
然后重起下服务：
service httpd restart 

 

文章来源: PHP二次开发 http://www.php2.cc

]]> Mon, 03 Mar 2014 04:05:53 +0000 山坛兄弟 http://www.030904.net/program/97.html ASP伪造REFERER http://www.030904.net/program/36.html <%
Function GetBody(weburl) 
    Set Retrieval = Server.CreateObject("MSXML2.XMLHTTP") 
    With Retrieval 
        .Open "Get", weburl, False, "", "" 
        .setRequestHeader "referer","http://www.030904.com/"'想改什么就改什么
        .Send 
        GetBody = .ResponseBody
    End With 
    GetBody = BytesToBstr(GetBody,"GB2312")
    Set Retrieval = Nothing 
End Function

Function BytesToBstr(body,Cset)
        dim objstream
        set objstream = Server.CreateObject("adodb.stream")
        objstream.Type = 1
        objstream.Mode =3
        objstream.Open
        objstream.Write body
        objstream.Position = 0
        objstream.Type = 2
        objstream.Charset = Cset
        BytesToBstr = objstream.ReadText 
        objstream.Close
        set objstream = nothing
End Function

Response.Write(GetBody("http://www.030904.com/referer.asp"))
%> 

]]> Sat, 22 Jun 2013 12:03:53 +0000 山坛兄弟 http://www.030904.net/program/36.html ASP防止图片木马上传 http://www.030904.net/program/34.html ASP木马防御：

    const adTypeBinary=1

    dim jpg(1):jpg(0)=CByte(&HFF):jpg(1)=CByte(&HD8)
dim bmp(1):bmp(0)=CByte(&H42):bmp(1)=CByte(&H4D)
dim png(3):png(0)=CByte(&H89):png(1)=CByte(&H50):png(2)=CByte(&H4E):png(3)=CByte(&H47)
dim gif(5):gif(0)=CByte(&H47):gif(1)=CByte(&H49):gif(2)=CByte(&H46):gif(3)=CByte(&H39):gif(4)=CByte(&H38):gif(5)=CByte(&H61)
Response.Write CheckFileType(Server.MapPath("2.gif"))

    function CheckFileType(filename)
on error resume next
CheckFileType=false
dim fstream,fileExt,stamp,i
fileExt=mid(filename,InStrRev(filename,".")+1)
set fstream=Server.createobject("ADODB.Stream")
fstream.Open
fstream.Type=adTypeBinary
fstream.LoadFromFile filename
fstream.position=0
select case fileExt
case "jpg","jpeg"
stamp=fstream.read(2)
for i=0 to 1
if ascB(MidB(stamp,i+1,1))=jpg(i) then CheckFileType=true else CheckFileType=false
next
case "gif"
stamp=fstream.read(6)
for i=0 to 5
if ascB(MidB(stamp,i+1,1))=gif(i) then CheckFileType=true else CheckFileType=false
next
case "png"
stamp=fstream.read(4)
for i=0 to 3
if ascB(MidB(stamp,i+1,1))=png(i) then CheckFileType=true else CheckFileType=false
next
case "bmp"
stamp=fstream.read(2)
for i=0 to 1
if ascB(MidB(stamp,i+1,1))=bmp(i) then CheckFileType=true else CheckFileType=false
next
end select
fstream.Close
set fseteam=nothing
if err.number<>0 then CheckFileType=false
end function
%>
]]> Sat, 22 Jun 2013 12:02:07 +0000 山坛兄弟 http://www.030904.net/program/34.html 利用ASP正则提取文章里面的图片的有效的src地 http://www.030904.net/program/28.html <%
Function gameimgs(content) 
 Set regEx = New RegExp '建立正则表达式。 
 regEx.Pattern = "(<img)(.[^<>]*)(src=)('|"&CHR(34)&"| )?(.[^'|\s|"&CHR(34)&"]*)(\.)(jpg|gif|png|bmp|jpeg)('|"&CHR(34)&"|\s|>)(.[^>]*)(>)" '设置模式。 
 regEx.IgnoreCase = True '设置是否区分字符大小写。 
 regEx.Global = True '设置全局可用性。 
 Set Matches = regEx.Execute(content) '执行搜索。
 For Each Match in Matches '遍历匹配集合。 
 '输入图片地址 
 'Response.Write Match.SubMatches(4)&"."&Match.SubMatches(6)
 gameimgs = Match.SubMatches(4)&"."&Match.SubMatches(6)
 Next
End Function
%>

<ol>
<% 
set imgrs=server.CreateObject("adodb.recordset")
imgrs.open "select * from news",conn,1,3
if imgrs.eof and imgrs.bof then
 response.write "111"
else
 do until imgrs.eof
  response.write "<li>"& imgrs("title")
  imgrs("saveimg") = gameimgs(imgrs("game"))
  imgrs("img") = gameimgs(imgrs("game"))
  response.write "</li>"
  imgrs.update
 imgrs.movenext
 loop
 
end if
imgrs.close
set imgrs=nothing
%>
</ol>
<%conn.close:set conn=nothing%>
利用ASP正则提取文章里面的图片的有效的src地址的示例
]]> Sat, 22 Jun 2013 11:58:15 +0000 山坛兄弟 http://www.030904.net/program/28.html asp正则替换内容里的特定内容 http://www.030904.net/program/27.html <%
content = "<!--开始-->这里第一个需要替换的内容<!--结束--> 不需要替换的内容 <!--开始-->这里第二个需要替换的内容<!--结束--> asdas d asd as d as d asd as d asd as <!--开始-->这里第三个需要替换的内容<!--结束--> <!--开始-->这里第四个需要替换的内容<!--结束--> 自行车自行车形成子形成在才这些才在"

'正则替换函数'
Function ReplaceExp(srcstr, patrn, replStr) 
Set regEx = New RegExp 
regEx.Pattern = patrn 
regEx.IgnoreCase = True 
regEx.Global = True 
regEx.Execute(srcstr) 
ReplaceExp = regEx.Replace(srcstr, replStr) 
Set regEx = Nothing 
End Function

'调用并输出'
Response.write content
Response.write "<hr>"
Response.write ReplaceExp(content,"\<\!\-{2}开始\-{2}\>.*?\<\!\-{2}结束\-{2}\>","被替换了") 
%> 
]]> Sat, 22 Jun 2013 11:57:35 +0000 山坛兄弟 http://www.030904.net/program/27.html ASP留言板IP或IP段限制与限制留言次数 http://www.030904.net/program/26.html ASP留言板IP或IP段限制与限制留言次数

<%
'留言板IP限制程序
dim ips
ips = left(Request.ServerVariables("REMOTE_ADDR"),15)
response.write ips

IpLists = "127.0.|"

function isForbid(sip)
 dim Iplist,Iparr,Ipi
 Iplist = "|"& IpLists &"|" '
 Iparr = split(Iplist,"|") '生成数组
 for Ipi = 0 to ubound(Iparr) '循环查找数组IP
  if len(Iparr(Ipi)) > 0 and instr("|" & sip,"|" & Iparr(Ipi)) > 0 then
   isForbid = true
   exit function
  end if
 next
 isForbid = false
end function

if isForbid(ips) then
 Response.write "<p align=""center"">你没有留言的权限</p>"
else
 response.write "aaaaaaaaaa"
end if


'验证两次留言时间间隔 方法 01
'PostIntervalTime = 5*60 '同一个IP多长时间可以留一次言,单位是秒，5分钟可以用5*60表示，不限制请设置为0
PostIntervalTime = 1*60
 
 if int(PostIntervalTime) > 0 then
  newDate = Dateadd("s",int(PostIntervalTime)*-1,Now)
  Set rs = conn.execute("select top 1 ip from qwbmbook where ip = '"& fixsql(ip) &"' and time > #"& newDate &"#")
  if not (rs.eof and rs.bof) then
   set rs = nothing
   conn.close
   set conn = nothing
   'er "请不要频繁留言，请等分钟"& int(PostIntervalTime/60) &"留言！",""
  end if
  set rs = nothing
 end if
%>
]]> Sat, 22 Jun 2013 11:57:09 +0000 山坛兄弟 http://www.030904.net/program/26.html ASP过滤SQL中的非法字符并格式化 http://www.030904.net/program/25.html <%
function changechr(str) 
changechr=replace(replace(replace(replace(str,"<","&lt;"),">","&gt;"),chr(13),"<br>")," ","&nbsp;") 
changechr=replace(replace(replace(replace(changechr,"[sayyes]","<div align=center><img src="),"[b]","<b>"),"[red]","<font color=CC0000>"),"[big]","<font size=7>") 
changechr=replace(replace(replace(replace(changechr,"[/sayyes]","></img></div>"),"[/b]","</b>"),"[/red]","</font>"),"[/big]","</font>") 
end function

'过滤SQL非法字符并格式化html代码
function Replace_Text(fString)
if isnull(fString) then
Replace_Text=""
exit function
else
fString=trim(fString)
fString=replace(fString,"'","''")
fString=replace(fString,";","；")
fString=replace(fString,"--","—")
fString=server.htmlencode(fString)
Replace_Text=fString
end if 
end function

'会员发布的各种信息过滤
'Function Replace_Text(fString)
'If Not IsNull(fString) Then
'fString = trim(fString)
'fString = replace(fString, ";", "；")     '分号过滤
'fString = replace(fString, "--", "——") '--过滤
'fString = replace(fString, "%20", "")    '特殊字符过滤
'fString = replace(fString, "==", "")     '==过滤
'fString = replace(fString, ">", "&gt;")
'fString = replace(fString, "<", "&lt;")
'fString = Replace(fString, CHR(32), " ")   '&nbsp;
'fString = Replace(fString, CHR(9), " ")    '&nbsp;
'fString = Replace(fString, CHR(34), "&quot;")
'fString = Replace(fString, CHR(39), "&#39;") '单引号过滤
'fString = Replace(fString, CHR(13), "")
'fString = Replace(fString, CHR(10) & CHR(10), "</P><P> ")
'fString = Replace(fString, CHR(10), "<BR> ")
'Replace_Text = fString
'End If
'End Function

'过滤SQL非法字符
Function checkStr(Chkstr)
dim Str:Str=Chkstr
if isnull(Str) then
   checkStr = ""
   exit Function
else
   Str=replace(Str,"'","")
   Str=replace(Str,";","")
   Str=replace(Str,"--","")
   checkStr=Str
end if
End Function

'检测传递的参数是否为数字型
Function Chkrequest(Para)
Chkrequest=False
If Not (IsNull(Para) Or Trim(Para)="" Or Not IsNumeric(Para)) Then
    Chkrequest=True
End If
End Function

'检测传递的参数是否为日期型
Function Chkrequestdate(Para)
Chkrequestdate=False
If Not (IsNull(Para) Or Trim(Para)="" Or Not IsDate(Para)) Then
    Chkrequestdate=True
End If
End Function

'得到当前页面的地址 
Function GetUrl() 
On Error Resume Next 
Dim strTemp 
If LCase(Request.ServerVariables("HTTPS")) = "off" Then 
strTemp = "http://" 
Else 
strTemp = "https://" 
End If 
strTemp = strTemp & CheckStr(Request.ServerVariables("SERVER_NAME")) 
If Request.ServerVariables("SERVER_PORT") <> 80 Then strTemp = strTemp & ":" & CheckStr(Request.ServerVariables("SERVER_PORT")) 
strTemp = strTemp & CheckStr(Request.ServerVariables("URL")) 
If Trim(Request.QueryString) <> "" Then strTemp = strTemp & "?" & CheckStr(Trim(Request.QueryString)) 
GetUrl = strTemp  
End Function 

'Function CheckReferer()   '检查用户是否在浏览器里输入了本页的地址
'     Dim sReferer, Icheck
'     CheckReferer = True
'     sReferer = Request.ServerVariables("HTTP_REFERER")
'     ServerIP = Request.ServerVariables("LOCAL_ADDR")
'     Icheck = InStr(sReferer, "ServerIP")
'     If Icheck = 0 Then
'     CheckReferer = False
'     End If
'End Function

'日期格式化
Function FormatDate(DT,tp)
dim Y,M,D
Y=Year(DT)
M=month(DT)
D=Day(DT)
if M<10 then M="0"&M
if D<10 then D="0"&D
select case tp
case 1 FormatDate=Y&"年"&M&"月"&D&"日"
case 2 FormatDate=Y&"-"&M&"-"&D
end select
End Function

'不允许外部提交数据的选择
Function ChkPost()
     dim HTTP_REFERER,SERVER_NAME
dim server_v1,server_v2
chkpost=false
     SERVER_NAME=CheckStr(Request.ServerVariables("SERVER_NAME"))
HTTP_REFERER=CheckStr(Request.ServerVariables("HTTP_REFERER"))
server_v1=Cstr(HTTP_REFERER)
server_v2=Cstr(SERVER_NAME)
if mid(server_v1,8,len(server_v2))<>server_v2 then
   chkpost=false
else
   chkpost=true
end if
End Function

'构造上传图片文件名随机数
function MakedownName()
dim fname
fname = now()
fname = replace(fname,"-","")
fname = replace(fname," ","") 
fname = replace(fname,":","")
fname = replace(fname,"PM","")
fname = replace(fname,"AM","")
fname = replace(fname,"上午","")
fname = replace(fname,"下午","")
fname = int(fname) + int((10-1+1)*Rnd + 1)
MakedownName=fname
end function

'Email检测
function IsValidEmail(email)
dim names, name, i, c
IsValidEmail = true
names = Split(email, "@")
if UBound(names) <> 1 then
    IsValidEmail = false
    exit function
end if
for each name in names
    if Len(name) <= 0 then
      IsValidEmail = false
      exit function
    end if
    for i = 1 to Len(name)
      c = Lcase(Mid(name, i, 1))
      if InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 and not IsNumeric(c) then
        IsValidEmail = false
        exit function
      end if
    next
    if Left(name, 1) = "." or Right(name, 1) = "." then
       IsValidEmail = false
       exit function
    end if
next
if InStr(names(1), ".") <= 0 then
    IsValidEmail = false
    exit function
end if
i = Len(names(1)) - InStrRev(names(1), ".")
if i <> 2 and i <> 3 then
    IsValidEmail = false
    exit function
end if
if InStr(email, "..") > 0 then
    IsValidEmail = false
end if
end function

'Jmail邮件发送
Function SendJmail(Email,Topic,MailBody)

Dim JMail
on error resume next
Set JMail = Server.CreateObject("JMail.SMTPMail")
JMail.LazySend             = true
JMail.silent             = true
JMail.Charset             = "gb2312"
JMail.ContentType       = "text/html"
JMail.Sender             = "wemaster@alibaba.info" '我们网站自己的邮箱
JMail.ReplyTo             = "wemaster@alibaba.info" '我们网站自己的邮箱
JMail.SenderName       = "阿里爸爸邮件发送"
JMail.Subject             = Topic
JMail.SimpleLayout       = true
JMail.Body             = MailBody
JMail.Priority             = 3
JMail.AddRecipient Email
JMail.AddHeader "Originating-IP", GBL_IPAddress
If JMail.Execute() = false Then
   SendJmail = 0
Else
   SendJmail = 1
End If
JMail.Close
Set JMail = Nothing

End Function

'分页
Function listPages(LinkFile) 
    if not (rs.eof and rs.bof) then
gopage=currentpage
totalpage=n
blockPage=Int((gopage-1)/10)*10+1
' if instr(linkfile,"?page=")>0 or instr(linkfile,"&page=")>0 then
' pos=instr(linkfile,"page=")-2
' linkfile=left(linkfile,pos)
' end if

If LCase(Request.ServerVariables("HTTPS")) = "off" Then 
     strTemp = "http://" 
     Else 
     strTemp = "https://" 
     End If 
     strTemp = strTemp & CheckStr(Request.ServerVariables("SERVER_NAME")) 
     If Request.ServerVariables("SERVER_PORT") <> 80 Then strTemp = strTemp & ":" & CheckStr(Request.ServerVariables("SERVER_PORT")) 
     strTemp = strTemp & CheckStr(Request.ServerVariables("URL"))
     lenstrTemp=len(strTemp)+1 
if instr(left(linkfile,lenstrTemp),"?")>0 then 

if blockPage = 1 Then
   Response.Write "<span disabled>【←前10页</span>&nbsp;"
Else
   Response.Write("<span disabled>【</span><a href=" & LinkFile & "&page="&blockPage-10&">←前10页</a>&nbsp;")
End If
    i=1
    Do Until i > 10 or blockPage > n
     If blockPage=int(gopage) Then
   Response.Write("<font color=#FF0000>[<b>"&blockPage&"</b>]</font>")
Else
   Response.Write(" <a href=" & LinkFile & "&page="&blockPage&">["&blockPage&"]</a> ")
     End If
     blockPage=blockPage+1
     i = i + 1
     Loop
if blockPage > totalpage Then
   Response.Write "&nbsp;<span disabled>后10页→】"
Else
   Response.Write("&nbsp;<a href=" & LinkFile & "&page="&blockPage&">后10页→</a><span disabled>】")
End If 
response.write" 直接到第 "
response.write"<select onchange=if(this.options[this.selectedIndex].value!=''){location=this.options[this.selectedIndex].value;}>"
     for i=1 to totalpage
     response.write"<option value='" & LinkFile & "&page=" & i & "'"
     if i=gopage then response.write"selected"
     response.write">"&i&"</option>"
     next
     response.write"</select>"
     response.write" 页<Br><Br>"

else

if blockPage = 1 Then
   Response.Write "<span disabled>【←前10页</span>&nbsp;"
Else
   Response.Write("<span disabled>【</span><a href=" & LinkFile & "?page="&blockPage-10&">←前10页</a>&nbsp;")
End If
    i=1
    Do Until i > 10 or blockPage > n
     If blockPage=int(gopage) Then
   Response.Write("<font color=#FF0000>[<b>"&blockPage&"</b>]</font>")
Else
   Response.Write(" <a href=" & LinkFile & "?page="&blockPage&">["&blockPage&"]</a> ")
     End If
     blockPage=blockPage+1
     i = i + 1
     Loop
if blockPage > totalpage Then
   Response.Write "&nbsp;<span disabled>后10页→】"
Else
   Response.Write("&nbsp;<a href=" & LinkFile & "?page="&blockPage&">后10页→</a><span disabled>】")
End If 
response.write" 直接到第 "
response.write"<select onchange=if(this.options[this.selectedIndex].value!=''){location=this.options[this.selectedIndex].value;}>"
     for i=1 to totalpage
     response.write"<option value='" & LinkFile & "?page=" & i & "'"
     if i=gopage then response.write"selected"
     response.write">"&i&"</option>"
     next
     response.write"</select>"
     response.write" 页<Br><Br>"

End If

Startinfo=((gopage-1)*msg_per_page)+1
Endinfo=gopage*msg_per_page
if Endinfo>totalrec then Endinfo=totalrec
   Response.Write("&nbsp;&nbsp;共 "&totalrec&" 条信息 当前显示第 "&Startinfo&" - "&Endinfo&" 条 每页 "&msg_per_page&" 条信息 共 "&n&" 页")
end if
End Function

'分页2
Function listPages2(LinkFile) 
    if not (rs.eof and rs.bof) then
gopage=currentpage
totalpage=n
blockPage=Int((gopage-1)/10)*10+1

If LCase(Request.ServerVariables("HTTPS")) = "off" Then 
     strTemp = "http://" 
     Else 
     strTemp = "https://" 
     End If 
     strTemp = strTemp & CheckStr(Request.ServerVariables("SERVER_NAME")) 
     If Request.ServerVariables("SERVER_PORT") <> 80 Then strTemp = strTemp & ":" & CheckStr(Request.ServerVariables("SERVER_PORT")) 
     strTemp = strTemp & CheckStr(Request.ServerVariables("URL"))
     lenstrTemp=len(strTemp)+1 
if instr(left(linkfile,lenstrTemp),"?")>0 then 

if blockPage = 1 Then
   Response.Write "<span disabled>前10页</span>&nbsp;"
Else
   Response.Write("<a href=" & LinkFile & "&page="&blockPage-10&">前10页</a>&nbsp;")
End If
    i=1
    Do Until i > 10 or blockPage > n
     If blockPage=int(gopage) Then
   Response.Write("<font color=#FF0000><b>"&blockPage&"</b></font>")
Else
   Response.Write(" <a href=" & LinkFile & "&page="&blockPage&">"&blockPage&"</a> ")
     End If
     blockPage=blockPage+1
     i = i + 1
     Loop
if blockPage > totalpage Then
   Response.Write "&nbsp;<span disabled>后10页"
Else
   Response.Write("&nbsp;<a href=" & LinkFile & "&page="&blockPage&">后10页</a><span disabled>")
End If 
response.write" 直接到第 "
response.write"<select onchange=if(this.options[this.selectedIndex].value!=''){location=this.options[this.selectedIndex].value;}>"
     for i=1 to totalpage
     response.write"<option value='" & LinkFile & "&page=" & i & "'"
     if i=gopage then response.write"selected"
     response.write">"&i&"</option>"
     next
     response.write"</select>"
     response.write" 页<Br><Br>"

else

if blockPage = 1 Then
   Response.Write "<span disabled>【←前10页</span>&nbsp;"
Else
   Response.Write("<span disabled>【</span><a href=" & LinkFile & "?page="&blockPage-10&">←前10页</a>&nbsp;")
End If
    i=1
    Do Until i > 10 or blockPage > n
     If blockPage=int(gopage) Then
   Response.Write("<font color=#FF0000>[<b>"&blockPage&"</b>]</font>")
Else
   Response.Write(" <a href=" & LinkFile & "?page="&blockPage&">["&blockPage&"]</a> ")
     End If
     blockPage=blockPage+1
     i = i + 1
     Loop
if blockPage > totalpage Then
   Response.Write "&nbsp;<span disabled>后10页→】"
Else
   Response.Write("&nbsp;<a href=" & LinkFile & "?page="&blockPage&">后10页→</a><span disabled>】")
End If 
response.write" 直接到第 "
response.write"<select onchange=if(this.options[this.selectedIndex].value!=''){location=this.options[this.selectedIndex].value;}>"
     for i=1 to totalpage
     response.write"<option value='" & LinkFile & "?page=" & i & "'"
     if i=gopage then response.write"selected"
     response.write">"&i&"</option>"
     next
     response.write"</select>"
     response.write" 页<Br><Br>"

End If

Startinfo=((gopage-1)*msg_per_page)+1
Endinfo=gopage*msg_per_page
if Endinfo>totalrec then Endinfo=totalrec
   Response.Write("&nbsp;&nbsp;共 "&totalrec&" 条信息 当前显示第 "&Startinfo&" - "&Endinfo&" 条 每页 "&msg_per_page&" 条信息 共 "&n&" 页")
end if
End Function

'判断文件类型是否合格
Function CheckFileExt(FileExt)
Dim ForumUpload,i
ForumUpload="gif,jpg,bmp,jpeg,png"
ForumUpload=Split(ForumUpload,",")
CheckFileExt=False
For i=0 to UBound(ForumUpload)
   If LCase(FileExt)=Lcase(Trim(ForumUpload(i))) Then
    CheckFileExt=True
    Exit Function
   End If
Next
End Function
'格式后缀
Function FixName(UpFileExt)
If IsEmpty(UpFileExt) Then Exit Function
FixName = Lcase(UpFileExt)
FixName = Replace(FixName,Chr(0),"")
FixName = Replace(FixName,".","")
FixName = Replace(FixName,"asp","")
FixName = Replace(FixName,"asa","")
FixName = Replace(FixName,"aspx","")
FixName = Replace(FixName,"cer","")
FixName = Replace(FixName,"cdx","")
FixName = Replace(FixName,"htr","")
End Function
'文件Content-Type判断
Function CheckFileType(FileType)
CheckFileType = False
If Left(Cstr(Lcase(Trim(FileType))),6)="image/" Then CheckFileType = True
End Function
%>
]]> Sat, 22 Jun 2013 11:56:31 +0000 山坛兄弟 http://www.030904.net/program/25.html 桃源网络硬盘AJAX问题 http://www.030904.net/program/8.html 最近在玩这个网络硬盘程序,我是将程序放到了子目录下,但是总是出现AJAX的问题.百度到网上找到很多方法,都是说

点注册出现正在处理后没有反应，并有脚本错误，文件操作没有反应。
IIS缺少默认的ashx扩展名支持！无法启用ajax，请在网站属性->目录->配置里，添加.ashx的扩展名，路径要设定到c:\windows\microsoft.net\framework\v1.1.4322\aspnet_isapi.dll，若为.net2.0版本，中间的版本号要改为v2.0.50727，添加时一定要把“确认文件是否存在”的对勾去掉!
4.1以下版本的升级用户还要确保web.config里面有<add verb="POST,GET" path="ajaxpro/*.ashx" type="AjaxPro.AjaxHandlerFactory, AjaxPro" />这行。

其实都是设置的问题,如果将放到子目录,在IIS中选择子目录,属性,创建程序即可.网上说的那些都是你抄我的，我抄你的。因为安装了NET2.0，.ashx等是自带支持的。
]]> Fri, 21 Jun 2013 15:09:40 +0000 山坛兄弟 http://www.030904.net/program/8.html ASP中过滤IP地址 http://www.030904.net/program/7.html <%
'过滤IP访问
'受屏蔽IP地址(段)集合，星号为通配符，通常保存于配置文件中。
Const BadIPGroup = "192.168.1.*|192.168.0.*|127.*.0.1|192.168.0.1"
If IsForbidIP(BadIPGroup) = True Then
Response.Write(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 
%>
]]> Fri, 21 Jun 2013 15:08:38 +0000 山坛兄弟 http://www.030904.net/program/7.html