现在流行的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 FileSavePathClass UpFileClass  '类别名称'定义Dictionary变量，用于保存上传的信息
DimupForm,upFile'　类初始化过程
private subClass_Initialize'判断传递的数据，如无，则退出
if Request.TotalBytes <1 Then
Exit sub
End if
'FileSavePath=""  '全局变量负值
set BinaStream=Server.CreateObject("adodb.stream")set upForm=NewDictionaryClassset upFile=NewDictionaryClassEnd sub '类清除过程
Private subClass_Terminate
upFile.RemoveAll
upForm.RemoveAllset upFile=nothing
set upForm=nothingBinaStream.Closeset BinaStream=nothingFileSavePath=""
End sub '获取数据过程
Public subGetDataDim 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=newFileInfo
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 thenError_Msg("发生数据错误，传递数据空或丢失！")Exit sub
End ifBinaStream.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下的错误。DimnTotalBytes, nPartBytes, ReadBytes
ReadBytes= 0nTotalBytes=Request.TotalBytes'循环分块读取
Do While ReadBytes <nTotalBytes'分块读取
nPartBytes = 64 * 1024 '分成每块64k
If nPartBytes + ReadBytes > nTotalBytes ThennPartBytes= nTotalBytes -ReadBytesEnd IfBinaStream.Write Request.BinaryRead(nPartBytes)
ReadBytes= ReadBytes +nPartBytesLoop
'读取完毕
BinaStream.Position=0otmpBinaData=BinaStream.Read
oDataAllSize=BinaStream.Size'获得分隔符
oDataSeprator=MidB(otmpBinaData,1,InstrB(1,otmpBinaData,oCrLf)-1)'给寻找指针付值
oFindStart=Lenb(oDataSeprator)+2oFindEnd=oFindStart'分解名项目，且保存其值
While oFindStart+2 <oDataAllSize
otmpStream.Type=1otmpStream.MOde=3otmpStream.Open
oFindEnd=InstrB(oFindStart,otmpBinaData,oCrLf&oCrLf)+3
'此时，oFindEnd指向内容，oFindStart指向描述
BinaStream.Position=oFindStart
BinaStream.CopyTo otmpStream,oFindEnd-oFindStart'把表单描述存入oFormData
otmpStream.Position=0otmpStream.Type=2 '设为文本类型数据
otmpStream.Charset="gb2312" '设字符集为中文
oFormData=otmpStream.ReadText '保存数据为文本'查找表单项目名称
oFormStart=Instr(1,oFormData,"name=",1)+len("name=")+1oFormEnd=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-3oFileInfo.FormName=oFormName'把数据加入到upFile[Dictionary对象]中保存'调试开始'open_appe_txt "debug.txt","循环中(文件)："&chr(13)&chr(10)&"oFindStart="&oFindStart&"oFormName="&oFormName'调试结束
upFile.add oFormName,oFileInfoElse
'如果是表单元素，则取元素值'关闭otmpStream对象，以便重新读取内容
otmpStream.Close
otmpStream.Type=1otmpStream.Mode=3otmpStream.Open'找到内容结束位置
oFindStart=InstrB(oFindEnd,otmpBinaData,oDataSeprator)'读出内容
BinaStream.Position=oFindEnd
BinaStream.CopyTo otmpStream,oFindStart-oFindEnd-3otmpStream.Position=0otmpStream.Type=2otmpStream.Charset="gb2312"oFormContent=otmpStream.ReadText
upForm.add oFormName,oFormContentEnd if
'调整寻找指针位置
oFindStart=oFindStart+LenB(oDataSeprator)+1
'此时，寻找指针均指向下一描述
otmpStream.Close
WEnd'循环返回'变量清空
otmpBinaData=""
set otmpBinaData=nothing
end sub '子程序到此结束'获得文件路径程序
Private FunctionGetFilePath(FullPath)if FullPath <>"" ThenGetFilePath=Left(FullPath,InstrRev(FullPath,"/"))ElseGetFilePath=""
End if
End Function '获得文件名程序
Private FunctionGetFileName(FullPath)if FullPath <>"" ThenGetfileName=Mid(FullPath,InstrRev(FullPath,"/")+1)ElseGetFileName=""
End if
End Function '获得文件扩展名
Private FunctionGetFileExt(FullPath)if FullPath <>"" ThenGetFileExt=Mid(FullPath,InstrRev(FullPath,".")+1)ElseGetFileExt=""
End if
End Function '类定义结束
End Class '文件属性类定义开始
ClassFileInfoDimFileName,FileSize,FileStart,FilePath,FileExt,FileType,FormName'Dim FileSaveNamePrivate subClass_Initialize
FileName=""FileSize=0FileStart=0FilePath=""FileExt=""FileType=""FormName=""
End sub Private subClass_Terminate'空子程序
End sub '把内容存入到服务器上指定位置和名称的文件
Public FunctionSaveToFile(tmpFileName)DimFileSaveStream,tmpStream,tmpReadStream,FullPathDimfilePath,FileFullName,SpcPosition'使用服务器路径
tmpFileName=s_SavePath&tmpFileName
FullPath=server.mappath(tmpFileName)'加入
DimmfileExt,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 ThenfilePath=s_curPath '使用程序所在目录
FileFullName=FullPathElsefilePath=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=1FileSaveStream.Mode=3fileSaveStream.Open
BinaStream.position=FileStart
BinaStream.CopyTo FileSaveStream,FileSize BinaStream.position=FileStart
tmpData=BinaStream.read(30)If mfileExt <>"" Then
If SniffPic(mfileExt,tmpData)=False ThensaveToFile=-1
Exit function
End if
End IfFileSaveStream.SaveToFile FullPath,2FileSaveStream.Closeset FileSaveStream=nothingSaveToFile=0 End Function '获得文件保存的内容,返回二进制数据，可以用来存入数据库中
Public FunctionGetFileData()
BinaStream.Position=FileStart
GetFileData=BinaStream.Read(Filesize)End Function '测试一个文件是否存在
functionAutoRename(filePath,FileFullName)'如果一个文件存在，则自动更名
DimoFSO,testFileName,testFileExt,extPosition,iCounter,sFileName'返回值,默认直接返回
AutoRename=fileFullName'取得文件名
extPosition=InstrRev(FileFullName,".")If extPosition>0 ThentestFileName=Mid(FileFullName,1,extPosition-1)
testFileExt=Mid(FileFullName,extPosition+1,Len(FileFullName))ElsetestFileName=FileFullName
testFileExt=""
End IfsFileName=fileFullNameSet oFSO = Server.CreateObject( "Scripting.FileSystemObject")'测试指定目录是否存在
if not (oFSO.FolderExists( filePath)) then
'不存在，则生成目录,然后退出
oFSO.CreateFolder(filePath)elseiCounter= 0 Do While ( True)DimsFilePath
sFilePath= filePath & "/" &sFileNameIf ( oFSO.FileExists( sFilePath ) ) TheniCounter= iCounter + 1sFileName=  testFileName & "(" & iCounter & ")." &testFileExtElse
Exit Do
End If
Loop If iCounter>0 ThenAutoRename=sFileNameEnd if
end if
End function End Class
'FileInfo类定义结束
%>
<%functionopen_appe_txt(txt_name,txt_content)dimMyFileObject,MyTextFileset MyFileObject=server.CreateObject("Scripting.FileSystemObject")set MyTextFile=MyFileObject.OpenTextFile(server.MapPath(txt_name),8,true)
MyTextFile.WriteLine(txt_content)
MyTextFile.Closeset MyTxtFile=nothing
set MyFileObject=nothing
end function%>
<%'显示错误信息程序
subError_Msg(eMsg,eUrl)
%>
<script>alert('<%=eMsg%>');
if (""=='<%=eUrl%>')
history.back();elsedocument.location='<%=eUrl%>';
</script>
<%End Sub '马如风2009.3.26
FunctionBin2Str(Bin)Dim I, Str For I=1 toLenB(Bin) clow=MidB(Bin,I,1)if AscB(clow) <128 then Str = Str & Chr(ASCB(clow))ElseI=I+1 if I <= LenB(Bin) then Str = Str & Chr(ASCW(MidB(Bin,I,1)&clow))end If NextBin2Str= Str
End Function functionbinToNum(bin)'二进制转为 Numericdim i:binToNum=0 for i=lenB(bin) to 1 step -1binToNum=binToNum*256+ascB(midB(bin,i,1))next 'shawl.qiu code'end function FunctionSniffPic(sFileExt,sData)
SniffPic=false
If sfileExt="" Then
Exit function
End if DimtmpExt,tmpData,tmpI,tmpSource tmpExt=UCase(sFileExt)If lenb(sData) <10 Then
Exit Function
End If Select CasetmpExtCase "GIF"
For tmpI=1 To 3tmpData=tmpData & Hex(binToNum(Midb(sData,tmpI,1)))NexttmpSource=Hex("&H47") & Hex("&H49") & Hex("&H46")If tmpData=tmpSource ThenSniffPic=true
End if
Case "JPG"
For tmpI=1 To 3tmpData=tmpData & Hex(binToNum(Midb(sData,tmpI,1)))nexttmpSource=CStr(Hex("&HFF")) & CStr(Hex("&HD8")) & CStr(Hex("&HFF"))If tmpData=tmpSource ThenSniffPic=true
End if
Case "PNG"
For tmpI=1 To 4tmpData=tmpData & Hex(binToNum(Midb(sData,tmpI,1)))nexttmpSource=CStr(Hex("&H89")) & CStr(Hex("&H50")) & CStr(Hex("&H4E")) & CStr(Hex("&H47"))If tmpData=tmpSource ThenSniffPic=true
End if
Case "BMP"
For tmpI=1 To 2tmpData=tmpData & Hex(binToNum(Midb(sData,tmpI,1)))nexttmpSource=CStr(Hex("&H42")) & CStr(Hex("&H4D"))If tmpData=tmpSource ThenSniffPic=true
End if
Case "PCX"
For tmpI=1 To 4tmpData=tmpData & Hex(binToNum(Midb(sData,tmpI,1)))nexttmpSource=CStr(Hex("&H0A")) & CStr(Hex("&H05")) & CStr(Hex("&H01")) & CStr(Hex("&H08"))If tmpData=tmpSource ThenSniffPic=true
End if
Case "TIF"
For tmpI=1 To 4tmpData=tmpData & Hex(binToNum(Midb(sData,tmpI,1)))nexttmpSource=CStr(Hex("&H49")) & CStr(Hex("&H49")) & CStr(Hex("&H2A")) & CStr(Hex("&H00"))If tmpData=tmpSource ThenSniffPic=true
End If
Case "DOC"
For tmpI=1 To 8tmpData=tmpData & Hex(binToNum(Midb(sData,tmpI,1)))nexttmpSource=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 ThenSniffPic=true
End If
Case "XLS"
For tmpI=1 To 8tmpData=tmpData & Hex(binToNum(Midb(sData,tmpI,1)))nexttmpSource=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 ThenSniffPic=true
End If
Case "RAR"
For tmpI=1 To 10tmpData=tmpData & Hex(binToNum(Midb(sData,tmpI,1)))nexttmpSource=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 ThenSniffPic=true
End If
Case Elsesniffpic=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=newupFileClass
FileUP.GetDataset file1=FileUP.upFile.item("file1")If i_rename=0 then
'filename=s_SavePath&fname&"."&file1.FileExt
filename=fname&"."&file1.FileExtelsefilename=file1.filenameEnd if '对文件格式进行判断处理
If InStr(S_FileExt,UCase(file1.fileExt))=0 thenerror_msg"Your File"&Chr(96)& "s Type is not allowed!/n",""response.End()end if if int(file1.filesize/1024)>i_upSize thenError_Msg"The FileSize is Exceed"&i_upSize&"KB!/n",""response.End()end if '
DimtmpResult'tmpResult=file1.SaveToFile(server.mappath(filename))
tmpResult=file1.SaveToFile(fileName)set FileUP=Nothing If tmpResult=0 thenimg=filename
response.write ("<SCRIPT>parent.document.getElementById("""& s_inputName &""").value+='/n"&img&"';history.back(); </SCRIPT>")Elseerror_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<%ClassDictionaryClassDim ArryObj()    '使用该二维数组来做存放数据的字典
Dim MaxIndex      'MaxIndex则是ArryObj开始的最大上标
Dim CurIndex      '字典指针,用来指向ArryObj的指针
Dim C_ErrCode      '错误代码号Private SubClass_Initialize
CurIndex=0      '从下标0开始
C_ErrCode=0      '0表示没有任何错误
MaxIndex=100      '默认的大小
Redim ArryObj(1,MaxIndex)  '定义一个二维的数组
End Sub Private SubClass_TerminateErase ArryObj  '清除数组
End Sub Public Property Get ErrCode '返回错误代码
ErrCode=C_ErrCodeEnd Property Public Property Get Count  '返回数据的总数,只返回CurIndex当前值-1即可.
Count=CurIndexEnd Property Public Property Get Keys  '返回字典数据的全部Keys,返回数组.
DimKeyCount,ArryKey(),I
KeyCount=CurIndex-1
RedimArryKey(KeyCount)For I=0 ToKeyCount ArryKey(I)=ArryObj(0,I)NextKeys=ArryKeyEraseArryKeyEnd Property Public Property Get Items  '返回字典数据的全部Values,返回数组.DimKeyCount,ArryItem(),I KeyCount=CurIndex-1 RedimArryItem(KeyCount)For I=0 ToKeyCountIf isObject(ArryObj(1,I)) Then Set ArryItem(I)=ArryObj(1,I)ElseArryItem(I)=ArryObj(1,I)End If NextItems=ArryItemEraseArryItemEnd Property Public Property Let Item(sKey,sVal) '取得sKey为Key的字典数据If sIsEmpty(sKey) Then Exit Property End If Dimi,iType iType=GetType(sKey)If iType=1 Then '如果sKey为数值型的则检查范围If sKey>CurIndex Or sKey <1 ThenC_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)=sValElseArryObj(1,i)=sValEnd If Exit Property End If Next ElseIf iType=1 ThensKey=sKey-1 If isObject(sVal) Then Set ArryObj(1,sKey)=sValElseArryObj(1,sKey)=sValEnd If Exit Property End IfC_ErrCode=2        'ErrCode为2则是替换或个为sKey的字典数据时找不到数据
End Property Public Property GetItem(sKey)If sIsEmpty(sKey) ThenItem=NullExit Property
End If Dimi,iType iType=GetType(sKey)If iType=1 Then '如果sKey为数值型的则检查范围If sKey>CurIndex Or sKey <1 ThenItem=NullExit 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)ElseItem=ArryObj(1,i)End If Exit Property End If Next ElseIf iType=1 ThensKey=sKey-1 If isObject(ArryObj(1,sKey)) Then Set Item=ArryObj(1,sKey)ElseItem=ArryObj(1,sKey)End If Exit Property End IfItem=NullEnd Property Public Sub Add(sKey,sVal) '添加字典'On Error Resume NextIf Exists(sKey) Or C_ErrCode=9 ThenC_ErrCode=1          'Key值不唯一(空的Key值也不能添加数字)Exit Sub
End If If CurIndex>MaxIndex ThenMaxIndex=MaxIndex+1      '每次增加一个标数,可以按场合需求改为所需量Redim Preserve ArryObj(1,MaxIndex)End IfArryObj(0,CurIndex)=Cstr(sKey)    'sKey是标识值,将Key以字符串类型保存
if isObject(sVal) Then Set ArryObj(1,CurIndex)=sVal    'sVal是数据
ElseArryObj(1,CurIndex)=sVal    'sVal是数据
End IfCurIndex=CurIndex+1
End Sub Public SubInsert(sKey,nKey,nVal,sMethod)If Not Exists(sKey) ThenC_ErrCode=4
Exit Sub
End If If Exists(nKey) Or C_ErrCode=9 ThenC_ErrCode=4          'Key值不唯一(空的Key值也不能添加数字)
Exit Sub
End IfsType=GetType(sKey)        '取得sKey的变量类型DimArryResult(),I,sType,subIndex,sAddReDim ArryResult(1,CurIndex)  '定义一个数组用来做临时存放地if sIsEmpty(sMethod) Then sMethod="b"  '为空的数据则默认是"b"
sMethod=lcase(cstr(sMethod))
subIndex=CurIndex-1sAdd=0
If sType=0 Then            '字符串类型比较
If sMethod="1" Or sMethod="b" Or sMethod="back" Then '将数据插入sKey的后面
For I=0 TOsubIndex
ArryResult(0,sAdd)=ArryObj(0,I)If IsObject(ArryObj(1,I)) Then
Set ArryResult(1,sAdd)=ArryObj(1,I)ElseArryResult(1,sAdd)=ArryObj(1,I)End If If ArryObj(0,I)=sKey Then '插入数据
sAdd=sAdd+1ArryResult(0,sAdd)=nKeyIf IsObject(nVal) Then
Set ArryResult(1,sAdd)=nValElseArryResult(1,sAdd)=nValEnd If
End IfsAdd=sAdd+1
Next Else
For I=0 TOsubIndexIf ArryObj(0,I)=sKey Then '插入数据
ArryResult(0,sAdd)=nKeyIf IsObject(nVal) Then
Set ArryResult(1,sAdd)=nValElseArryResult(1,sAdd)=nValEnd IfsAdd=sAdd+1
End IfArryResult(0,sAdd)=ArryObj(0,I)If IsObject(ArryObj(1,I)) Then
Set ArryResult(1,sAdd)=ArryObj(1,I)ElseArryResult(1,sAdd)=ArryObj(1,I)End IfsAdd=sAdd+1
Next
End If
ElseIf sType=1 ThensKey=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)ElseArryResult(1,I)=ArryObj(1,I)End If
Next
'插入新的数据
ArryResult(0,sKey+1)=nKeyIf IsObject(nVal) Then
Set ArryResult(1,sKey+1)=nValElseArryResult(1,sKey+1)=nValEnd If
'取sKey后面的数据
For I=sKey+1 TOsubIndex
ArryResult(0,I+1)=ArryObj(0,I)If IsObject(ArryObj(1,I)) Then
Set ArryResult(1,I+1)=ArryObj(1,I)ElseArryResult(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)ElseArryResult(1,I)=ArryObj(1,I)End If
Next
'插入新的数据
ArryResult(0,sKey)=nKeyIf IsObject(nVal) Then
Set ArryResult(1,sKey)=nValElseArryResult(1,sKey)=nValEnd If
'取sKey后面的数据
For I=sKey TOsubIndex
ArryResult(0,I+1)=ArryObj(0,I)If IsObject(ArryObj(1,I)) Then
Set ArryResult(1,I+1)=ArryObj(1,I)ElseArryResult(1,I+1)=ArryObj(1,I)End If
Next
End If
ElseC_ErrCode=3
Exit Sub
End If ReDim ArryObj(1,CurIndex) '重置数据For I=0 ToCurIndex
ArryObj(0,I)=ArryResult(0,I)If isObject(ArryResult(1,I)) Then
Set ArryObj(1,I)=ArryResult(1,I)ElseArryObj(1,I)=ArryResult(1,I)End If
NextMaxIndex=CurIndexEraseArryResult
CurIndex=CurIndex+1    'Insert后数据指针加一
End Sub Public Function Exists(sKey)  '判断存不存在某个字典数据
If sIsEmpty(sKey) ThenExists=False
Exit Function
End If DimI,vType
vType=GetType(sKey)If vType=0 Then
For I=0 To CurIndex-1
If ArryObj(0,I)=sKey ThenExists=True
Exit Function
End If
Next
ElseIf vType=1 Then
If sKey <=CurIndex And sKey>0 ThenExists=True
Exit Function
End If
End IfExists=False
End Function Public Sub Remove(sKey)        '根据sKey的值Remove一条字典数据
If Not Exists(sKey) ThenC_ErrCode=3
Exit Sub
End IfsType=GetType(sKey)        '取得sKey的变量类型DimArryResult(),I,sType,sAddReDim ArryResult(1,CurIndex-2)  '定义一个数组用来做临时存放地
sAdd=0
If sType=0 Then            '字符串类型比较
For I=0 TO CurIndex-1
If ArryObj(0,I) <>sKey ThenArryResult(0,sAdd)=ArryObj(0,I)If IsObject(ArryObj(1,I)) Then Set ArryResult(1,sAdd)=ArryObj(1,I)ElseArryResult(1,sAdd)=ArryObj(1,I)End IfsAdd=sAdd+1
End If
Next ElseIf sType=1 ThensKey=sKey-1            '减1是为了符合日常习惯(从1开始)
For I=0 TO CurIndex-1
If I <>sKey ThenArryResult(0,sAdd)=ArryObj(0,I)If IsObject(ArryObj(1,I)) Then
Set ArryResult(1,sAdd)=ArryObj(1,I)ElseArryResult(1,sAdd)=ArryObj(1,I)End IfsAdd=sAdd+1
End If
Next
ElseC_ErrCode=3
Exit Sub
End IfMaxIndex=CurIndex-2
ReDim ArryObj(1,MaxIndex) '重置数据For I=0 ToMaxIndex
ArryObj(0,I)=ArryResult(0,I)If isObject(ArryResult(1,I)) Then
Set ArryObj(1,I)=ArryResult(1,I)ElseArryObj(1,I)=ArryResult(1,I)End If
Next EraseArryResult
CurIndex=CurIndex-1    '减一是Remove后数据指针
End Sub Public Sub RemoveAll '全部清空字典数据,只Redim一下就OK了
RedimArryObj(MaxIndex)
CurIndex=0
End Sub Public Sub ClearErr  '重置错误
C_ErrCode=0
End Sub Private Function sIsEmpty(sVal) '判断sVal是否为空值
If IsEmpty(sVal) ThenC_ErrCode=9          'Key值为空的错误代码
sIsEmpty=True
Exit Function
End If If IsNull(sVal) ThenC_ErrCode=9          'Key值为空的错误代码
sIsEmpty=True
Exit Function
End If If Trim(sVal)="" ThenC_ErrCode=9          'Key值为空的错误代码
sIsEmpty=True
Exit Function
End IfsIsEmpty=False
End Function Private Function GetType(sVal)  '取得变量sVal的变量类型
dimsType
sType=TypeName(sVal)Select CasesTypeCase "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">
<htmlxmlns="http://www.w3.org/1999/xhtml">
<head> <title> new document </title> <metaname="generator"content="editplus" /> <metaname="author"content="" /> <metaname="keywords"content="" /> <metaname="description"content="" />
</head> <body> <table> <formname="upfile"> <tr> <td> <inputtype="text"id="filePath"name="filePath"size="40"> </td> <td> <iframeheight="30"width="320"frameborder="0"scrolling="no"src="up.asp"> </iframe> </td> </tr> </form> </table>
</body>
</html>