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

现在流行的asp上传组件除了无惧的化境之外，最多的可能就是ewebEditor 和Fckeditor的上传是，但是经过测试都很难防止改名为gif和asp文件上传，在FckEditor中改名后的asp木马不能直接上传，系统会检测到 <%等字符而拒绝，但是经过修改后的asp木马再改名为gif后却可以顺利上传，如在文件前端加上许多空行，或对木马进行加密处理。当然有人会认为木马传到服务器后会被杀掉，但是做过免杀的木马却会漏网。基于这些原因，本人开发了一个可以从根本上解决这个问题的无组件上传类。经过测试常用的文件格式均可通过。做法是对上传的文件进行格式分析，不符合的格式不允许上传，这样就从根本上解决了这个问题。现贴上来请大家指教。

1、文件upfile.asp

‘**************************************************************************
‘*  类文件名称:upfile.asp
‘*  作者:马如风（Melon）
‘*  邮箱:[email protected]
‘*  版权:=====筱风工作室(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([email protected])
‘Fix upload large file.
‘**********************************************
‘ 修正作者：long
‘ 联系邮件: [email protected]
‘ 修正时间：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 ‘子程序到此结束

‘获得文件路径程序
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
%>
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
%>

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
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

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组件

时间： 2024-10-08 01:31:36

一个能防止改名木马漏洞的无组件上传类的相关文章

艾恩ASP无组件上传类(上传组件)说明文档(from www.sysoft.cc)

艾恩ASP无组件上传类(上传组件)说明文档2010-1-18 By Anlige一.简介自从接触ASP就开始接触上传,看过一些上传类,但是总感觉封装的还是不够简单,因此自己尝试写一个能够用最少最简单的代码实现各种上传方式的上传类.在学校期间就开始写,一点点的完善.优化,到现在的版本,现在的版本能适应各种上传方式.上传类的主要的功能如下:1.自由设置最大上传大小.单文件最大上传大小2.自由设置允许上传的文件类型3.可设置文本的编码,以适应各种上传环境4.内置进度条,a用户可选择开启和关闭5.多种错

asp无惧上传类2.2上传文件的同时，通过 Request.QueryString将参数传递到保存页面中

先转一段文字,对不对再评论 在后台asp程序中,以前获取表单提交的ASCII 数据,非常的容易.但是如果 需要获取上传的文件,就必须使用Request对象的BinaryRead方法来读取.BinaryRead方法是对当前输入流进行指定字节数的二进制读取,有点需要注意的 是,一旦使用BinaryRead 方法后,再也不能使用Request.Form 或  Request.QueryString 集合了.结合Request对象的TotalBytes属性,可以将 所有表单提交的数据全部变成二进制,不过

ASP 无组件上传

说明:从网上收集了一部分,自己写了一部分.主要提升就是对于form的二进制数据进行了类封装,可以容易的得到form内的元素的信息. Form 二进制数据格式: 分割标志数据 + 0x0D0A 元素说明信息 + 0x0D0A0D0A 元素内容数据 + 0x0D0A 分割标志数据 + 0x0D0A 元素说明信息 + 0x0D0A0D0A 元素内容数据 + 0x0D0A -- 分割标志数据 + 0x0D0A 1． Upload.htm <html> <head><title>

无惧上传类修改版ASP

<%OPTION EXPLICIT%><%class clsUp '文件上传类'------------------------Dim Form,FileDim AllowExt_ '允许上传类型(白名单)Dim NoAllowExt_ '不允许上传类型(黑名单)Private oUpFileStream '上传的数据流Private isErr_ '错误的代码,0或true表示无错Private ErrMessage_ '错误的字符串信息Private isGetData_ '指示是否

jQuery AJAX 网页无刷新上传示例

新年礼,提供简单.易套用的 jQuery AJAX 上传示例及代码下载.后台对文件的上传及检查,以 C#/.NET Handler 处理 (可视需要改写成 Java 或 PHP). 有时做一个网站项目 (不论是否 ASP.NET),内附的 FileUpload 控件,功能不足 (页面必须刷新.不支援 AJAX),或外观太丑被用户嫌弃 (却无法透过 CSS 自定义外观).网路上虽已有许多可用的示例,如: jQuery File Upload,但功能太强大.外观复杂,欲仅取出部分功能来引用,反而不易

jQuery无刷新上传学习心得

记得刚离开大学,进入目前这家公司不到一个月时,有一位前辈给我们当时的新人讲了下JS无刷新上传的相关知识. 在此之前,一直都是在使用C#提供的服务器上传控件FileUpload,但是每次使用时,都会刷新一次页面,给人的感觉不是太好.但是那是,并不是太在意这个细节,而且JS知识非常匮乏,所以并没有去找解决的办法. 当时,这位前辈提到的一种方法是: 准备一个主页面(用户界面)和一个上传页(放在主页面隐藏的iframe中,作为真正意义的上传页),当点击主页面的上传按钮时,实际上是调用了上传页的上传控件,

基于h5的图片无刷新上传(uploadifive)

基于h5的图片无刷新上传(uploadifive) uploadifive简介 了解uploadify之前,首先了解来一下什么是uploadify,uploadfy官网,uploadify和uploadifive是一家的,他们都是基于jquery的插件,都支持多文件异步上传,支持显示上传进度,不同的是uploadify基于swfUpload这一开源无刷新上传插件开发,基于flash,而uploadifive则是基于html5,不依赖于flash. 基于他们的不同点,我们可以根据自己的需求来进行选

iframe实现无刷新上传文件(转)

其实在ajax出现之前,web应用也可以是无刷新的,那时大多通过IFrame来做到这一点.当然Ajax出现之后,人们一窝蜂地投奔Ajax 的阵营了,iFrame 就乏人问津了.但是用iFrame来实现无刷新上传文件确实一个很好的选择. [1].[代码] [HTML]代码 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 <html>   <body>      <form action="upload.jsp

隐藏iframe无刷新上传文件

首先ajax不能上传文件,这误导了我有段时间,今晚睡不着就照着说明做了个无刷新上传文件 其实原理很简单 <form enctype="multipart/form-data" method="POST" target="upload" action="http://localhost/class.upload.php" > <input type="file" name="upl