多百度一下,会找到很多参考代码,然后稍改就能搞定。
例:以服务端ASP代码为例
网页部分:[code=xml]<FORM id= "FileEditForm " Name= "FileEditForm " Action= "UpdateFile.asp " enctype= "multipart/form-data " method= "post ">
<INPUT id= "FileTitle " Name= "FileTitle " type= "text " size=50 style= "background-color: #ffffff; font-family: 宋体; font-size: 12px; border-style: groove; border-width: 1 ">
<INPUT type= "file " id= "IconPic " Name= "IconPic " value= " " size= "39 " style= "background-color: #ffffff; font-family: 宋体; font-size: 12px; border-style: groove; border-width: 1 ">
<INPUT type= "submit " value= "确 定 ">
</FORM> [/code]ASP部份
文件名:UpdateFile.asp
插不进VB脚本代码,用JAVA脚本代码器编辑,VB脚本部份可能有问题,你注意点看哈[code=jscript]<SCRIPT RUNAT=SERVER LANGUAGE= "JavaScript ">
function getfileextraname(string_value)
{
string_value=trim_spaces(string_value);
var index=string_value.length-1;
while(index> =0&&string_value.charAt(index)!= ". ")
{
index--;
}
if(index!=-1)
{
return string_value.substring(index+1,string_value.length)
}
else
{
return " ";
}
}
function trim_spaces(string_value)
{
var start;
var end;
start=0;
end=string_value.length-1;
while(string_value.charAt(start)== " ")
{
start++;
}
while(string_value.charAt(end)== " ")
{
end--;
}
return string_value.substring(start,end+1);
}
function get_newfilename()
{
var Date_obj=new Date();
return "Adj "+Date_obj.getTime();
}
</SCRIPT>
<SCRIPT RUNAT=SERVER LANGUAGE= "VBScript ">
Function GetFileName(FullPath)
FullPath=trim_spaces(FullPath)
IF FullPath <> " " Then
FullPath=Replace(FullPath, "/ ", "\ ")
GetFileName=mid(FullPath,InStrRev(FullPath, "\ ")+1)
Else
GetFileName= " "
End IF
End Function
</SCRIPT>
<%
'VB 脚本部份代码,因回贴用的JSP代码模式,可能显示不方便,你自己看着办吧。
Dim objStream
Dim vbEnter,MAXFileSize
Set objStream=Server.CreateObject( "ADODB.Stream ")
objstream.mode=3
objStream.Type=1
objStream.Open
objstream.write Request.BinaryRead(Request.TotalBytes)
vbEnter=Chr(13)&Chr(10)
MAXFileSize=1024*2048
filesavepath= "UploadIMG/ "
FileTitle=get_generalfield_value( "FileTitle ",1)
IconPicFileSize=get_filesize( "IconPic ")
IF IconPicFileSize> 0 And IconPicFileSize <MAXFileSize Then
NewFileName=get_newfilename()
IconPicSaveFileName=NewFileName& "IconPic "
filesize=get_filedata_savetofile( "IconPic ",filesavepath,IconPicSaveFileName)
IconPicFileType=filetype
IF IconPicFileType <> " " Then
IconPicFullFileName=NewFileName& "IconPic "& ". "&IconPicFileType
Else
IconPicFullFileName=NewFileName& "IconPic "
End IF
IconPicFullPath=filesavepath&IconPicFullFileName
Response.Write "您上传的文本是: "&FileTitle& "
"
Response.Write "您上传的文件保存在服务器的路径为: "&IconPicFullPath
Else
HTMLCode= " <Script> "
HTMLCode=HTMLCode& "alert( '上传文件超过 "&MAXFileSize/1024& "K限制或文件不存在! '); "
HTMLCode=HTMLCode& " </Script> "
Response.Write HTMLCode
Response.End
End IF
objStream.close
%>
<SCRIPT RUNAT=SERVER LANGUAGE= "VBScript ">
function get_generalfield_value(fieldname,index)
dim startposition
dim endposition
vbEnter=Chr(13)&Chr(10)
startposition=1
for i=1 to index-1
startposition=instring(startposition,fieldname)+len(fieldname)
next
get_generalfield_value= " "
startposition=instring(startposition,fieldname)
startposition=startposition+len(fieldname)+5
endposition=instring(startposition,vbenter+ "----------------------------- ")
if startposition> 5+len(fieldname) then
get_generalfield_value=substring(startposition,endposition-startposition)
end if
end function
function get_filesize(fieldname) '获得文件大小
vbEnter=Chr(13)&Chr(10)
dim startposition
dim endposition
startposition=1
startposition=instring(startposition,fieldname)
startposition=startposition+len(fieldname)+13
endposition=instring(startposition,vbenter)-1
startposition=instring(endposition,vbenter+vbenter)+3
endposition=instring(startposition,vbenter+ "----------------------------- ")
get_filesize=endposition-startposition-1
end function
function get_filedata_savetofile(fieldname,paths,savefilename) 'fieldname为接收的名称,path为上传文件存放路径,该路径必须在服务器端已存在,否则upload.asp不能上载任何文件,savefilename为保存到服务器的文件名
vbEnter=Chr(13)&Chr(10)
dim startposition
dim endposition
startposition=1
startposition=instring(startposition,fieldname)
startposition=startposition+len(fieldname)+13
endposition=instring(startposition,vbenter)-1
filename=substring(startposition,endposition-startposition)
filename=getfilename(filename)
filetype=getfileextraname(filename)
startposition=instring(endposition,vbenter+vbenter)+3
endposition=instring(startposition,vbenter+ "----------------------------- ")
filestart=startposition
filesize=endposition-startposition-1
objstream.position=filestart
Set StreamObj = Server.CreateObject( "ADODB.Stream ")
StreamObj.Mode=3
StreamObj.Type=1
StreamObj.Open
objstream.copyto StreamObj,FileSize
savefilename=paths+savefilename+ ". "+filetype
StreamObj.SaveToFile server.mappath(savefilename),2
get_filedata_savetofile=filesize
end function
Private function GetFileName(FullPath)
If FullPath <> " " Then
GetFileName = mid(FullPath,InStrRev(FullPath, "\ ")+1)
Else
GetFileName = " "
End If
End function
Function inString(theStart,varStr)
dim i,j,bt,theLen,str
InString=0
Str=toByte(varStr)
theLen=LenB(Str)
for i=theStart to objStream.Size-theLen
if i> objstream.size then exit Function
objstream.Position=i-1
if AscB(objstream.Read(1))=AscB(midB(Str,1)) then
InString=i
for j=2 to theLen
if objstream.EOS then
inString=0
Exit for
end if
if AscB(objstream.Read(1)) <> AscB(MidB(Str,j,1)) then
InString=0
Exit For
end if
next
if InString <> 0 then Exit Function
end if
next
End Function
function toByte(Str)
dim i,iCode,c,iLow,iHigh
toByte= " "
For i=1 To Len(Str)
c=mid(Str,i,1)
iCode =Asc(c)
If iCode <0 Then iCode = iCode + 65535
If iCode> 255 Then
iLow = Left(Hex(Asc(c)),2)
iHigh =Right(Hex(Asc(c)),2)
toByte = toByte & chrB( "&H "&iLow) & chrB( "&H "&iHigh)
Else
toByte = toByte & chrB(AscB(c))
End If
Next
End function
Function subString(theStart,theLen)
dim i,c,stemp
objStream.Position=theStart-1
stemp= " "
for i=1 to theLen
if objStream.EOS then Exit for
c=ascB(objStream.Read(1))
If c > 127 Then
if objStream.EOS then Exit for
stemp=stemp&Chr(AscW(ChrB(AscB(objStream.Read(1)))&ChrB(c)))
i=i+1
else
stemp=stemp&Chr(c)
End If
Next
subString=stemp
End function
</SCRIPT>[/code] |