发一个能防止改名木马漏洞的无组件上传类

mqmelon 2009-03-29 03:19:28
现在流行的asp上传组件除了无惧的化境之外,最多的可能就是ewebEditor 和Fckeditor的上传是,但是经过测试都很难防止改名为gif和asp文件上传,在FckEditor中改名后的asp木马不能直接上传,系统会检测到<%等字符而拒绝,但是经过修改后的asp木马再改名为gif后却可以顺利上传,如在文件前端加上许多空行,或对木马进行加密处理。当然有人会认为木马传到服务器后会被杀掉,但是做过免杀的木马却会漏网。基于这些原因,本人开发了一个可以从根本上解决这个问题的无组件上传类。经过测试常用的文件格式均可通过。做法是对上传的文件进行格式分析,不符合的格式不允许上传,这样就从根本上解决了这个问题。现贴上来请大家指教。
1、文件upfile.asp
<%
'**************************************************************************
'* 类文件名称:upfile.asp
'* 作者:马如风(Melon)
'* 邮箱:mqmelon0@163.com
'* 版权:=====筱风工作室(R)2004.1-2004.3=====
'* 内容:不用组件上传文件类
'* 用法:在接收表单内容的文件中定义UpFileClass类对象,用GetData方法
'* 读取文件内容,并使用FileInfo类的SaveToFile方法存入指定文件
'* 例子:set FileUP=new UpFileClass
'* FileUp.GetData
'* set file1=FileUP.upFile("表单元素名")
'* filename=path&filename
'* file1.SaveToFile(server.mappath(filename))
'* set FileUp=nothing
'**************************************************************************
%>
<%
response.charset="gb2312"

Dim BinaStream '全局变量
'dim FileSavePath

Class UpFileClass '类别名称
'定义Dictionary变量,用于保存上传的信息
Dim upForm,upFile

' 类初始化过程
private sub Class_Initialize
'判断传递的数据,如无,则退出
if Request.TotalBytes<1 Then
Exit sub
End if
'FileSavePath="" '全局变量负值
set BinaStream=Server.CreateObject("adodb.stream")
set upForm=New DictionaryClass
set upFile=New DictionaryClass
End sub

'类清除过程
Private sub Class_Terminate
upFile.RemoveAll
upForm.RemoveAll
set upFile=nothing
set upForm=nothing
BinaStream.Close
set BinaStream=nothing
FileSavePath=""
End sub

'获取数据过程
Public sub GetData
Dim oFileInfo '用于保存文件信息的类对象
Dim oDataSeprator '用于保存分隔符信息,为二进制字符串
Dim oFindStart,oFindEnd '寻找指针
Dim oCrLf ' CHRB(13)&CHRB(10), 分隔数字
Dim oFormData ' 表单数据描述信息,文本串
Dim oFileStart ' 文件开始位置
Dim otmpStream ' 临时Stream 对象,用于中间周转字符串
Dim otmpBinaData ' 临时二进制字符串,用于中间周转
Dim oDataAllSize ' 所有二进制数值大小
Dim oFormName ' 表单元素名称
Dim oFormContent ' 表单元素内容
Dim oFormStart ' 表单元素开始位置
Dim oFormEnd ' 表单元素结束位置
Dim oFileFullName ' 带路径文件名

'变量初始化
set oFileInfo=new FileInfo
oDataSeprator=""
oFindStart=Clng(0)
oFindEnd=Clng(0)
oCrLf=chrB(13)&chrB(10)
oFormData=""
oFileStart=Clng(0)
set otmpStream=Server.CreateObject("adodb.stream")
otmpBinaData=""
oDataAllSize=Clng(0)
oFormName=""
oFormcontent=""
oFormStart=Clng(0)
oFormEnd=Clng(0)
oFileFullName=""
' 获得传递过来的二进制数据
if Request.TotalBytes<1 then
Error_Msg("发生数据错误,传递数据空或丢失!")
Exit sub
End if
BinaStream.Type=1 '二进制
BinaStream.Mode=3 '读写模式,1-读,2-写,3-读写
BinaStream.Open '打开对象,准备读写
'开始读取所有上传的数据
'Thankful long(yrl031715@163.com)
'Fix upload large file.
'**********************************************
' 修正作者:long
' 联系邮件: yrl031715@163.com
' 修正时间:2007年5月6日
' 修正说明:由于iis6的Content-Length 头信息中包含的请求长度超过了 AspMaxRequestEntityAllowed 的值(默认200K), IIS 将返回一个 403 错误信息.
' 直接导致在iis6下调试FCKeditor上传功能时,一旦文件超过200K,上传文件时文件管理器失去响应,受此影响,文件的快速上传功能也存在在缺陷。
' 在参考 宝玉 的 Asp无组件上传带进度条 演示程序后作出如下修改,以修正在iis6下的错误。

Dim nTotalBytes, nPartBytes, ReadBytes
ReadBytes = 0
nTotalBytes = Request.TotalBytes
'循环分块读取
Do While ReadBytes < nTotalBytes
'分块读取
nPartBytes = 64 * 1024 '分成每块64k
If nPartBytes + ReadBytes > nTotalBytes Then
nPartBytes = nTotalBytes - ReadBytes
End If
BinaStream.Write Request.BinaryRead(nPartBytes)
ReadBytes = ReadBytes + nPartBytes
Loop
'读取完毕
BinaStream.Position=0
otmpBinaData=BinaStream.Read
oDataAllSize=BinaStream.Size
'获得分隔符
oDataSeprator=MidB(otmpBinaData,1,InstrB(1,otmpBinaData,oCrLf)-1)
'给寻找指针付值
oFindStart=Lenb(oDataSeprator)+2
oFindEnd=oFindStart
'分解名项目,且保存其值
While oFindStart+2<oDataAllSize
otmpStream.Type=1
otmpStream.MOde=3
otmpStream.Open
oFindEnd=InstrB(oFindStart,otmpBinaData,oCrLf&oCrLf)+3
'此时,oFindEnd指向内容,oFindStart指向描述
BinaStream.Position=oFindStart
BinaStream.CopyTo otmpStream,oFindEnd-oFindStart
'把表单描述存入oFormData
otmpStream.Position=0
otmpStream.Type=2 '设为文本类型数据
otmpStream.Charset="gb2312" '设字符集为中文
oFormData=otmpStream.ReadText '保存数据为文本
'查找表单项目名称
oFormStart=Instr(1,oFormData,"name=",1)+len("name=")+1
oFormEnd=Instr(oFormStart,oFormData,"""",1)
oFormName=Mid(oFormData,oFormStart,oFormEnd-oFormStart)
'调试开始
'open_appe_txt "debug.txt","oFormData="&chr(13)&chr(10)&oFormData
'open_appe_txt "debug.txt","判断前:"&chr(13)&chr(10)&"oFormStart="&oFormStart&"oFormEnd="&oFormEnd&"oFormName="&oFormName
'调试结束
'判断是否为文件
if Instr(oFormEnd,oFormData,"filename=",1)>0 Then
'是文件,则取文件属性
'找到文件名字
oFormStart=Instr(oFormEnd,oFormData,"filename=",1)+len("filename=")+1
'加1是为了去掉文件名字前面的引号
oFormEnd=Instr(oFormStart,oFormData,"""",1)
'此时,oFormEnd指向下一个描述的前一个位置,减1是为去掉引号
'获得文件信息
'获得带路径文件名称
oFileFullName=Mid(oFormData,oFormStart,oFormEnd-oFormStart)
'分解文件名称
oFileInfo.FileName=GetFileName(oFileFullName)
oFileInfo.FileExt=GetFileExt(oFileFullName)
oFileInfo.FilePath=GetFilePath(oFileFullName)
'获得文件类型
oFormStart=Instr(oFormEnd,oFormData,"Content-Type:",1)+len("Content-Type:")
oFormEnd=Instr(oFormStart,oFormData,chr(13)&chr(10),1)
oFileInfo.FileType=Mid(oFormData,oFormStart,oFormEnd-oFormStart)
'获得文件内容起始点
oFileInfo.FileStart=oFindEnd
oFindStart=InstrB(oFindEnd,otmpBinaData,oDataSeprator)
'此时,oFindStart指向分隔符位置
oFileInfo.FileSize=oFindStart-oFindEnd-3
oFileInfo.FormName=oFormName
'把数据加入到upFile[Dictionary对象]中保存
'调试开始
'open_appe_txt "debug.txt","循环中(文件):"&chr(13)&chr(10)&"oFindStart="&oFindStart&"oFormName="&oFormName
'调试结束
upFile.add oFormName,oFileInfo
Else
'如果是表单元素,则取元素值
'关闭otmpStream对象,以便重新读取内容
otmpStream.Close
otmpStream.Type=1
otmpStream.Mode=3
otmpStream.Open
'找到内容结束位置
oFindStart=InstrB(oFindEnd,otmpBinaData,oDataSeprator)
'读出内容
BinaStream.Position=oFindEnd
BinaStream.CopyTo otmpStream,oFindStart-oFindEnd-3
otmpStream.Position=0
otmpStream.Type=2
otmpStream.Charset="gb2312"
oFormContent=otmpStream.ReadText
upForm.add oFormName,oFormContent
End if
'调整寻找指针位置
oFindStart=oFindStart+LenB(oDataSeprator)+1
'此时,寻找指针均指向下一描述
otmpStream.Close
WEnd '循环返回
'变量清空
otmpBinaData=""
set otmpBinaData=nothing
end sub '子程序到此结束
...全文
170 9 打赏 收藏 转发到动态 举报
写回复
用AI写文章
9 条回复
切换为时间正序
请发表友善的回复…
发表回复
mqmelon 2009-03-29
  • 打赏
  • 举报
回复
不是每个人都会记得去设权限的,所以如果能在上传时就把漏洞堵住不是更好。发这个贴子是希望大家能想出更好的办法来解决这个问题,因为在asp.net中对文件实际类型的判断是很容易的,但在 asp中却很难做到。
w000111 2009-03-29
  • 打赏
  • 举报
回复
反正iis的权限设置遵循一个规律,可执行则不可写,可写则不可执行。。。,
w000111 2009-03-29
  • 打赏
  • 举报
回复
那些上传的组建不是本来就有类型控制的吗?


但是它不能控制jpg文件里面包含的病毒和木马。如果市asp之类的文件你在服务器上设置存储的目录没有执行权限就可以了,传上来不管是什么文件都不能执行了,只能静态读出。

反正iis的权限设置遵循一个规律,可执行则不可写,可写则不可执行。。。,
xiaoqinjian 2009-03-29
  • 打赏
  • 举报
回复
学习
mqmelon 2009-03-29
  • 打赏
  • 举报
回复

4、1.asp
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<title> new document </title>
<meta name="generator" content="editplus" />
<meta name="author" content="" />
<meta name="keywords" content="" />
<meta name="description" content="" />
</head>

<body>
<table>
<form name="upfile">
<tr>
<td><input type="text" id="filePath" name="filePath" size="40"></td><td> <iframe height="30" width="320" frameborder="0" scrolling="no" src="up.asp"></iframe></td>
</tr>
</form>
</table>
</body>
</html>

说明:upfile.asp为上传类,up.asp为调用文件,1.asp为演示文件,dic.asp为避免iis服务器dictonary组件不可用时的自写义dictonary组件也可以将其修改为iis的dictonary组件
mqmelon 2009-03-29
  • 打赏
  • 举报
回复

ArryResult(0,sAdd)=ArryObj(0,I)

If IsObject(ArryObj(1,I)) Then
Set ArryResult(1,sAdd)=ArryObj(1,I)
Else
ArryResult(1,sAdd)=ArryObj(1,I)
End If

sAdd=sAdd+1
Next
End If
ElseIf sType=1 Then
sKey=sKey-1 '减1是为了符合日常习惯(从1开始)

If sMethod="1" Or sMethod="b" Or sMethod="back" Then '将数据插入sKey的后面
For I=0 TO sKey '取sKey前面部分数据
ArryResult(0,I)=ArryObj(0,I)
If IsObject(ArryObj(1,I)) Then
Set ArryResult(1,I)=ArryObj(1,I)
Else
ArryResult(1,I)=ArryObj(1,I)
End If
Next
'插入新的数据
ArryResult(0,sKey+1)=nKey
If IsObject(nVal) Then
Set ArryResult(1,sKey+1)=nVal
Else
ArryResult(1,sKey+1)=nVal
End If
'取sKey后面的数据
For I=sKey+1 TO subIndex
ArryResult(0,I+1)=ArryObj(0,I)
If IsObject(ArryObj(1,I)) Then
Set ArryResult(1,I+1)=ArryObj(1,I)
Else
ArryResult(1,I+1)=ArryObj(1,I)
End If
Next
Else
For I=0 TO sKey-1 '取sKey-1前面部分数据
ArryResult(0,I)=ArryObj(0,I)
If IsObject(ArryObj(1,I)) Then
Set ArryResult(1,I)=ArryObj(1,I)
Else
ArryResult(1,I)=ArryObj(1,I)
End If
Next
'插入新的数据
ArryResult(0,sKey)=nKey
If IsObject(nVal) Then
Set ArryResult(1,sKey)=nVal
Else
ArryResult(1,sKey)=nVal
End If
'取sKey后面的数据
For I=sKey TO subIndex
ArryResult(0,I+1)=ArryObj(0,I)
If IsObject(ArryObj(1,I)) Then
Set ArryResult(1,I+1)=ArryObj(1,I)
Else
ArryResult(1,I+1)=ArryObj(1,I)
End If
Next
End If
Else
C_ErrCode=3
Exit Sub
End If

ReDim ArryObj(1,CurIndex) '重置数据

For I=0 To CurIndex
ArryObj(0,I)=ArryResult(0,I)
If isObject(ArryResult(1,I)) Then
Set ArryObj(1,I)=ArryResult(1,I)
Else
ArryObj(1,I)=ArryResult(1,I)
End If
Next

MaxIndex=CurIndex
Erase ArryResult
CurIndex=CurIndex+1 'Insert后数据指针加一
End Sub

Public Function Exists(sKey) '判断存不存在某个字典数据
If sIsEmpty(sKey) Then
Exists=False
Exit Function
End If

Dim I,vType
vType=GetType(sKey)

If vType=0 Then
For I=0 To CurIndex-1
If ArryObj(0,I)=sKey Then
Exists=True
Exit Function
End If
Next
ElseIf vType=1 Then
If sKey<=CurIndex And sKey>0 Then
Exists=True
Exit Function
End If
End If

Exists=False
End Function

Public Sub Remove(sKey) '根据sKey的值Remove一条字典数据
If Not Exists(sKey) Then
C_ErrCode=3
Exit Sub
End If

sType=GetType(sKey) '取得sKey的变量类型

Dim ArryResult(),I,sType,sAdd

ReDim ArryResult(1,CurIndex-2) '定义一个数组用来做临时存放地
sAdd=0
If sType=0 Then '字符串类型比较
For I=0 TO CurIndex-1
If ArryObj(0,I)<>sKey Then
ArryResult(0,sAdd)=ArryObj(0,I)

If IsObject(ArryObj(1,I)) Then
Set ArryResult(1,sAdd)=ArryObj(1,I)
Else
ArryResult(1,sAdd)=ArryObj(1,I)
End If

sAdd=sAdd+1
End If
Next

ElseIf sType=1 Then
sKey=sKey-1 '减1是为了符合日常习惯(从1开始)
For I=0 TO CurIndex-1
If I<>sKey Then
ArryResult(0,sAdd)=ArryObj(0,I)
If IsObject(ArryObj(1,I)) Then
Set ArryResult(1,sAdd)=ArryObj(1,I)
Else
ArryResult(1,sAdd)=ArryObj(1,I)
End If

sAdd=sAdd+1
End If
Next
Else
C_ErrCode=3
Exit Sub
End If

MaxIndex=CurIndex-2
ReDim ArryObj(1,MaxIndex) '重置数据

For I=0 To MaxIndex
ArryObj(0,I)=ArryResult(0,I)
If isObject(ArryResult(1,I)) Then
Set ArryObj(1,I)=ArryResult(1,I)
Else
ArryObj(1,I)=ArryResult(1,I)
End If
Next

Erase ArryResult
CurIndex=CurIndex-1 '减一是Remove后数据指针
End Sub

Public Sub RemoveAll '全部清空字典数据,只Redim一下就OK了
Redim ArryObj(MaxIndex)
CurIndex=0
End Sub

Public Sub ClearErr '重置错误
C_ErrCode=0
End Sub

Private Function sIsEmpty(sVal) '判断sVal是否为空值
If IsEmpty(sVal) Then
C_ErrCode=9 'Key值为空的错误代码
sIsEmpty=True
Exit Function
End If

If IsNull(sVal) Then
C_ErrCode=9 'Key值为空的错误代码
sIsEmpty=True
Exit Function
End If

If Trim(sVal)="" Then
C_ErrCode=9 'Key值为空的错误代码
sIsEmpty=True
Exit Function
End If

sIsEmpty=False
End Function

Private Function GetType(sVal) '取得变量sVal的变量类型
dim sType
sType=TypeName(sVal)
Select Case sType
Case "String"
GetType=0
Case "Integer","Long","Single","Double"
GetType=1
Case Else
GetType=-1
End Select

End Function

End Class
%>
mqmelon 2009-03-29
  • 打赏
  • 举报
回复
3、dic.asp
<%
Class DictionaryClass
Dim ArryObj() '使用该二维数组来做存放数据的字典
Dim MaxIndex 'MaxIndex则是ArryObj开始的最大上标
Dim CurIndex '字典指针,用来指向ArryObj的指针
Dim C_ErrCode '错误代码号


Private Sub Class_Initialize
CurIndex=0 '从下标0开始
C_ErrCode=0 '0表示没有任何错误
MaxIndex=100 '默认的大小
Redim ArryObj(1,MaxIndex) '定义一个二维的数组
End Sub

Private Sub Class_Terminate
Erase ArryObj '清除数组
End Sub

Public Property Get ErrCode '返回错误代码
ErrCode=C_ErrCode
End Property

Public Property Get Count '返回数据的总数,只返回CurIndex当前值-1即可.
Count=CurIndex
End Property

Public Property Get Keys '返回字典数据的全部Keys,返回数组.
Dim KeyCount,ArryKey(),I
KeyCount=CurIndex-1
Redim ArryKey(KeyCount)

For I=0 To KeyCount
ArryKey(I)=ArryObj(0,I)
Next

Keys=ArryKey
Erase ArryKey
End Property

Public Property Get Items '返回字典数据的全部Values,返回数组.
Dim KeyCount,ArryItem(),I
KeyCount=CurIndex-1
Redim ArryItem(KeyCount)

For I=0 To KeyCount
If isObject(ArryObj(1,I)) Then
Set ArryItem(I)=ArryObj(1,I)
Else
ArryItem(I)=ArryObj(1,I)
End If
Next

Items=ArryItem
Erase ArryItem
End Property

Public Property Let Item(sKey,sVal) '取得sKey为Key的字典数据
If sIsEmpty(sKey) Then
Exit Property
End If

Dim i,iType

iType=GetType(sKey)
If iType=1 Then '如果sKey为数值型的则检查范围
If sKey>CurIndex Or sKey<1 Then
C_ErrCode=2
Exit Property
End If
End If

If iType=0 Then
For i=0 to CurIndex-1
If ArryObj(0,i)=sKey Then
If isObject(sVal) Then
Set ArryObj(1,i)=sVal
Else
ArryObj(1,i)=sVal
End If
Exit Property
End If
Next
ElseIf iType=1 Then
sKey=sKey-1
If isObject(sVal) Then
Set ArryObj(1,sKey)=sVal
Else
ArryObj(1,sKey)=sVal
End If
Exit Property
End If
C_ErrCode=2 'ErrCode为2则是替换或个为sKey的字典数据时找不到数据
End Property

Public Property Get Item(sKey)
If sIsEmpty(sKey) Then
Item=Null
Exit Property
End If

Dim i,iType

iType=GetType(sKey)
If iType=1 Then '如果sKey为数值型的则检查范围
If sKey>CurIndex Or sKey<1 Then
Item=Null
Exit Property
End If
End If

If iType=0 Then
For i=0 to CurIndex-1
If ArryObj(0,i)=sKey Then
If isObject(ArryObj(1,i)) Then
Set Item=ArryObj(1,i)
Else
Item=ArryObj(1,i)
End If
Exit Property
End If
Next
ElseIf iType=1 Then
sKey=sKey-1
If isObject(ArryObj(1,sKey)) Then
Set Item=ArryObj(1,sKey)
Else
Item=ArryObj(1,sKey)
End If
Exit Property
End If

Item=Null
End Property

Public Sub Add(sKey,sVal) '添加字典
'On Error Resume Next
If Exists(sKey) Or C_ErrCode=9 Then
C_ErrCode=1 'Key值不唯一(空的Key值也不能添加数字)
Exit Sub
End If

If CurIndex>MaxIndex Then
MaxIndex=MaxIndex+1 '每次增加一个标数,可以按场合需求改为所需量
Redim Preserve ArryObj(1,MaxIndex)
End If

ArryObj(0,CurIndex)=Cstr(sKey) 'sKey是标识值,将Key以字符串类型保存
if isObject(sVal) Then
Set ArryObj(1,CurIndex)=sVal 'sVal是数据
Else
ArryObj(1,CurIndex)=sVal 'sVal是数据
End If

CurIndex=CurIndex+1
End Sub

Public Sub Insert(sKey,nKey,nVal,sMethod)
If Not Exists(sKey) Then
C_ErrCode=4
Exit Sub
End If

If Exists(nKey) Or C_ErrCode=9 Then
C_ErrCode=4 'Key值不唯一(空的Key值也不能添加数字)
Exit Sub
End If

sType=GetType(sKey) '取得sKey的变量类型

Dim ArryResult(),I,sType,subIndex,sAdd

ReDim ArryResult(1,CurIndex) '定义一个数组用来做临时存放地

if sIsEmpty(sMethod) Then sMethod="b" '为空的数据则默认是"b"
sMethod=lcase(cstr(sMethod))
subIndex=CurIndex-1
sAdd=0
If sType=0 Then '字符串类型比较
If sMethod="1" Or sMethod="b" Or sMethod="back" Then '将数据插入sKey的后面
For I=0 TO subIndex
ArryResult(0,sAdd)=ArryObj(0,I)

If IsObject(ArryObj(1,I)) Then
Set ArryResult(1,sAdd)=ArryObj(1,I)
Else
ArryResult(1,sAdd)=ArryObj(1,I)
End If

If ArryObj(0,I)=sKey Then '插入数据
sAdd=sAdd+1
ArryResult(0,sAdd)=nKey
If IsObject(nVal) Then
Set ArryResult(1,sAdd)=nVal
Else
ArryResult(1,sAdd)=nVal
End If
End If

sAdd=sAdd+1
Next

Else
For I=0 TO subIndex
If ArryObj(0,I)=sKey Then '插入数据
ArryResult(0,sAdd)=nKey
If IsObject(nVal) Then
Set ArryResult(1,sAdd)=nVal
Else
ArryResult(1,sAdd)=nVal
End If
sAdd=sAdd+1
End If
mqmelon 2009-03-29
  • 打赏
  • 举报
回复
2、up.asp
<%@codepage=936%>
<html><meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<body topmargin=0 rightmargin=0 leftmargin=0>
<%
'*******************************************
'* 文件:up.asp
'* 功能:上传文件
'* 输入:无
'* 输出:无
'* 修改日期:2004.3.5
'* 作者:马如风
'* 版权声明:筱风工作室版权所有(2004-2005)
'*******************************************
%>
<!--#include file="upfile.asp"-->
<!--#include file="dic.asp"-->
<!--#include file="setup.asp"-->

<%
fname=""&year(now)&month(now)&day(now)&hour(now)&minute(now)&second(now)&""
if request("up_act")="up_files" then

set FileUP=new upFileClass
FileUP.GetData

set file1=FileUP.upFile.item("file1")
If i_rename=0 then
'filename=s_SavePath&fname&"."&file1.FileExt
filename=fname&"."&file1.FileExt
else
filename=file1.filename
End if

'对文件格式进行判断处理
If InStr(S_FileExt,UCase(file1.fileExt))=0 then
error_msg "Your File"&Chr(96)& "s Type is not allowed!\n",""
response.End()
end if

if int(file1.filesize/1024)>i_upSize then
Error_Msg "The FileSize is Exceed "&i_upSize&"KB!\n",""
response.End()
end if

'
Dim tmpResult
'tmpResult=file1.SaveToFile(server.mappath(filename))
tmpResult=file1.SaveToFile(fileName)
set FileUP=Nothing

If tmpResult=0 then

img=filename
response.write ("<SCRIPT>parent.document.getElementById("""& s_inputName &""").value+='\n"&img&"';history.back();</SCRIPT>")

Else

error_msg "Sorry!File"&Chr(96)& "s Type is not correct!\n",""
response.End()
End if

Else
If i_upfile=1 And i_Author=1 then
%>

<table cellpadding=0 cellspacing=0 border="0">
<tr>
<form enctype=multipart/form-data method=post action=up.asp?up_act=up_files>
<td><input type=file style="FONT-SIZE:9pt;cursor:hand;" name=file1 size="20">
<input style="FONT-SIZE:9pt;cursor:hand;" type="submit" value=" 上 传 " name=Submit>
</form></td></tr></table>
<%
ElseIf i_Author=0 Then

%>
<table cellpadding=0 cellspacing=0 border="0">
<tr><td style="font-size:12px;height:24px;" valign="middle">请登录后再使用上传功能。</td></tr></table>
<%
else
%>
<table cellpadding=0 cellspacing=0 border="0">
<tr><td style="font-size:12px;height:24px;" valign="middle">不允许上传文件.</td></tr></table>
<%
End if
end if
%>
mqmelon 2009-03-29
  • 打赏
  • 举报
回复
'获得文件路径程序
Private Function GetFilePath(FullPath)
if FullPath<>"" Then
GetFilePath=Left(FullPath,InstrRev(FullPath,"\"))
Else
GetFilePath=""
End if
End Function

'获得文件名程序
Private Function GetFileName(FullPath)
if FullPath<>"" Then
GetfileName=Mid(FullPath,InstrRev(FullPath,"\")+1)
Else
GetFileName=""
End if
End Function

'获得文件扩展名
Private Function GetFileExt(FullPath)
if FullPath<>"" Then
GetFileExt=Mid(FullPath,InstrRev(FullPath,".")+1)
Else
GetFileExt=""
End if
End Function

'类定义结束
End Class

'文件属性类定义开始
Class FileInfo
Dim FileName,FileSize,FileStart,FilePath,FileExt,FileType,FormName
'Dim FileSaveName

Private sub Class_Initialize
FileName=""
FileSize=0
FileStart=0
FilePath=""
FileExt=""
FileType=""
FormName=""
End sub

Private sub Class_Terminate
'空子程序
End sub


'把内容存入到服务器上指定位置和名称的文件
Public Function SaveToFile(tmpFileName)
Dim FileSaveStream,tmpStream,tmpReadStream,FullPath
Dim filePath,FileFullName,SpcPosition
'使用服务器路径
tmpFileName=s_SavePath&tmpFileName
FullPath=server.mappath(tmpFileName)
'加入
Dim mfileExt,tmpData
mfileExt=Mid(FullPath,InstrRev(FullPath,".")+1,Len(FullPath))
'加入2009.3.27

SaveFile=-1
if FullPath="" or Right(FullPath,1)="/" Then
Call Error_Msg("Error Occured when Save the file to appointed directory and fileName!:\n The fileName is not valid!")
Exit Function
Else
'替换\为/
FullPath=Replace(FullPath,"\","/")
'取出保存的目录
SpcPosition=InStrrev(FullPath,"/")
If spcposition=0 Then
filePath=s_curPath '使用程序所在目录
FileFullName=FullPath
Else
filePath=Mid(FullPath,1,SpcPosition-1)
FileFullName=Mid(FullPath,spcPosition+1,Len(Fullpath))
End if


If i_AutoRename=1 Then
'如果存在同名,则自动更名
tmpFileName=s_SavePath& autoRename(filePath,FileFullName)
FullPath=server.mappath(tmpFileName)
End if
End if

set FileSaveStream=Server.CreateObject("adodb.stream")
FileSaveStream.Type=1
FileSaveStream.Mode=3
fileSaveStream.Open
BinaStream.position=FileStart
BinaStream.CopyTo FileSaveStream,FileSize

BinaStream.position=FileStart
tmpData=BinaStream.read(30)

If mfileExt<>"" Then
If SniffPic(mfileExt,tmpData)=False Then
saveToFile=-1
Exit function
End if
End If

FileSaveStream.SaveToFile FullPath,2
FileSaveStream.Close
set FileSaveStream=nothing

SaveToFile=0

End Function

'获得文件保存的内容,返回二进制数据,可以用来存入数据库中
Public Function GetFileData()
BinaStream.Position=FileStart
GetFileData=BinaStream.Read(Filesize)
End Function

'测试一个文件是否存在
function AutoRename(filePath,FileFullName)
'如果一个文件存在,则自动更名
Dim oFSO,testFileName,testFileExt,extPosition,iCounter,sFileName
'返回值,默认直接返回
AutoRename=fileFullName
'取得文件名
extPosition=InstrRev(FileFullName,".")
If extPosition>0 Then
testFileName=Mid(FileFullName,1,extPosition-1)
testFileExt=Mid(FileFullName,extPosition+1,Len(FileFullName))
Else
testFileName=FileFullName
testFileExt=""
End If
sFileName=fileFullName
Set oFSO = Server.CreateObject( "Scripting.FileSystemObject" )
'测试指定目录是否存在
if not (oFSO.FolderExists( filePath)) then
'不存在,则生成目录,然后退出
oFSO.CreateFolder(filePath)
else
iCounter = 0

Do While ( True )
Dim sFilePath
sFilePath = filePath & "/" & sFileName

If ( oFSO.FileExists( sFilePath ) ) Then
iCounter = iCounter + 1
sFileName = testFileName & "(" & iCounter & ")." & testFileExt
Else
Exit Do
End If
Loop

If iCounter>0 Then
AutoRename=sFileName
End if
end if
End function

End Class
'FileInfo类定义结束
%>
<%
function open_appe_txt(txt_name,txt_content)
dim MyFileObject,MyTextFile
set MyFileObject=server.CreateObject("Scripting.FileSystemObject")
set MyTextFile=MyFileObject.OpenTextFile(server.MapPath(txt_name),8,true)
MyTextFile.WriteLine(txt_content)
MyTextFile.Close
set MyTxtFile=nothing
set MyFileObject=nothing
end function
%>
<%
'显示错误信息程序
sub Error_Msg(eMsg,eUrl)
%>
<script>
alert('<%=eMsg%>');
if (""=='<%=eUrl%>')
history.back();
else
document.location='<%=eUrl%>';
</script>
<%
End Sub


'马如风2009.3.26
Function Bin2Str(Bin)
Dim I, Str
For I=1 to LenB(Bin)
clow=MidB(Bin,I,1)
if AscB(clow)<128 then
Str = Str & Chr(ASCB(clow))
Else
I=I+1
if I <= LenB(Bin) then Str = Str & Chr(ASCW(MidB(Bin,I,1)&clow))
end If
Next
Bin2Str = Str
End Function

function binToNum(bin)
'二进制转为 Numeric
dim i:binToNum=0
for i=lenB(bin) to 1 step -1
binToNum=binToNum*256+ascB(midB(bin,i,1))
next 'shawl.qiu code'

end function

Function SniffPic(sFileExt,sData)
SniffPic=false
If sfileExt="" Then
Exit function
End if

Dim tmpExt,tmpData,tmpI,tmpSource

tmpExt=UCase(sFileExt)
If lenb(sData)<10 Then
Exit Function
End If

Select Case tmpExt
Case "GIF"
For tmpI=1 To 3
tmpData=tmpData & Hex(binToNum(Midb(sData,tmpI,1)))
Next
tmpSource=Hex("&H47") & Hex("&H49") & Hex("&H46")
If tmpData=tmpSource Then
SniffPic=true
End if
Case "JPG"
For tmpI=1 To 3
tmpData=tmpData & Hex(binToNum(Midb(sData,tmpI,1)))
next
tmpSource=CStr(Hex("&HFF")) & CStr(Hex("&HD8")) & CStr(Hex("&HFF"))
If tmpData=tmpSource Then
SniffPic=true
End if
Case "PNG"
For tmpI=1 To 4
tmpData=tmpData & Hex(binToNum(Midb(sData,tmpI,1)))
next
tmpSource=CStr(Hex("&H89")) & CStr(Hex("&H50")) & CStr(Hex("&H4E")) & CStr(Hex("&H47"))
If tmpData=tmpSource Then
SniffPic=true
End if
Case "BMP"
For tmpI=1 To 2
tmpData=tmpData & Hex(binToNum(Midb(sData,tmpI,1)))
next
tmpSource=CStr(Hex("&H42")) & CStr(Hex("&H4D"))
If tmpData=tmpSource Then
SniffPic=true
End if
Case "PCX"
For tmpI=1 To 4
tmpData=tmpData & Hex(binToNum(Midb(sData,tmpI,1)))
next
tmpSource=CStr(Hex("&H0A")) & CStr(Hex("&H05")) & CStr(Hex("&H01")) & CStr(Hex("&H08"))
If tmpData=tmpSource Then
SniffPic=true
End if
Case "TIF"
For tmpI=1 To 4
tmpData=tmpData & Hex(binToNum(Midb(sData,tmpI,1)))
next
tmpSource=CStr(Hex("&H49")) & CStr(Hex("&H49")) & CStr(Hex("&H2A")) & CStr(Hex("&H00"))
If tmpData=tmpSource Then
SniffPic=true
End If
Case "DOC"
For tmpI=1 To 8
tmpData=tmpData & Hex(binToNum(Midb(sData,tmpI,1)))
next
tmpSource=CStr(Hex("&HD0")) & CStr(Hex("&HCF")) & CStr(Hex("&H11")) & CStr(Hex("&HE0")) & CStr(Hex("&HA1"))
tmpSource=tmpSource & CStr(Hex("&HB1")) & CStr(Hex("&H1A")) & CStr(Hex("&HE1"))
If tmpData=tmpSource Then
SniffPic=true
End If
Case "XLS"
For tmpI=1 To 8
tmpData=tmpData & Hex(binToNum(Midb(sData,tmpI,1)))
next
tmpSource=CStr(Hex("&HD0")) & CStr(Hex("&HCF")) & CStr(Hex("&H11")) & CStr(Hex("&HE0")) & CStr(Hex("&HA1"))
tmpSource=tmpSource & CStr(Hex("&HB1")) & CStr(Hex("&H1A")) & CStr(Hex("&HE1"))
If tmpData=tmpSource Then
SniffPic=true
End If
Case "RAR"
For tmpI=1 To 10
tmpData=tmpData & Hex(binToNum(Midb(sData,tmpI,1)))
next
tmpSource=CStr(Hex("&H52")) & CStr(Hex("&H61")) & CStr(Hex("&H72")) & CStr(Hex("&H21")) & CStr(Hex("&H1A")) & CStr(Hex("&H07"))
tmpSource=tmpSource & CStr(Hex("&H00")) & CStr(Hex("&HCF")) & CStr(Hex("&H90")) & CStr(Hex("&H73"))
If tmpData=tmpSource Then
SniffPic=true
End If
Case Else
sniffpic=true
End Select
End function
'马如风2009.3.26
%>

28,390

社区成员

发帖
与我相关
我的任务
社区描述
ASP即Active Server Pages,是Microsoft公司开发的服务器端脚本环境。
社区管理员
  • ASP
  • 无·法
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧