使用asp和vb实现FileUpload的一种实现(XML)

liuruhong 2002-12-11 05:54:22
首先是客户端的实现 ,CFileUpload使用Vbscript编写,在VB中同样测试通过
<script language="VBScript">
<!--

class CFileUpload
Private sFilePath
Private sUploadServer
Private sSaveFilePath
Private sFileName

Private sStatus
Private sResponseInfo

Public Property Let FilePath(ByVal vData)
sFilePath = vData
End Property

Public Property Get FilePath()
FilePath = sFilePath
End Property

Public Property Let FileName(ByVal vData)
sFileName = vData
End Property

Public Property Get FileName()
FileName = sFileName
End Property

Public Property Let SaveFilePath(ByVal vData)
sSaveFilePath = vData
End Property

Public Property Get SaveFilePath()
SaveFilePath = sSaveFilePath
End Property

Public Property Let UploadFileServer(ByVal vData)
sUploadServer = vData
End Property

Public Property Get UploadFileServer()
UploadFileServer = sUploadServer
End Property


Public Property Get ResponseStatus()
ResponseStatus = sStatus
End Property

Public Property Get ResponseInformation()
ResponseInformation = sResponseInfo
End Property
Public Sub UploadFile()
Dim adoStream
Dim xmlDOM
Dim objHTTP

Dim ndFileName
Dim ndFileData
Dim ndSaveFilePath

Set adoStream = CreateObject("ADODB.Stream")
Set xmlDOM = CreateObject("MSXML2.DOMDocument")

xmlDOM.loadXML ("<?xml version=""1.0"" ?><Root/>")
xmlDOM.documentElement.setAttribute "xmlns:dt", "urn:schemas-microsoft-com:datatypes"



Set ndFileName = xmlDOM.createElement("FileName")
ndFileName.Text = sFileName
xmlDOM.documentElement.appendChild (ndFileName)

Set ndSaveFilePath = xmlDOM.createElement("SaveFilePath")
ndSaveFilePath.Text = sSaveFilePath
xmlDOM.documentElement.appendChild (ndSaveFilePath)

Set ndFileData = xmlDOM.createElement("FileData")
ndFileData.dataType = "bin.base64"


adoStream.Type = 1
adoStream.Open
adoStream.LoadFromFile sFilePath
ndFileData.nodeTypedValue = adoStream.Read(-1)
adoStream.Close

xmlDOM.documentElement.appendChild (ndFileData)

Set objHTTP = CreateObject("Microsoft.XMLHTTP")
objHTTP.Open "POST", "http://localhost/up.asp", False
objHTTP.send xmlDOM.xml

Set responseDoc = CreateObject("MSXML2.DOMDocument")
responseDoc.loadXML (objHTTP.responseText) 'why not use objHTTP.ResponseXML,Who can tell me . liuruhong@263.net

sStatus = CInt(responseDoc.selectSingleNode("Response/Status").Text)
sResponseInfo = responseDoc.selectSingleNode("Response/Description").Text

End Sub

end class

sub UploadFile
set objUPF=new CFileUpload
objUPF.FilePath =file_path.value
objUPF.FileName =file_name.value
objUPF.SaveFilePath =save_path.value
objUPF.UploadFile
div_message.innerText = objUPF.ResponseInformation
end sub
//-->
</script>
<HTML>
<HEAD><TITLE>文件上传</TITLE></HEAD>
<BODY>

文件名:
<input id="file_name" type="text"><br>
保存路径:<input id="save_path" type="text"><br>
文件:
<input id="file_path" type="file" value="选择文件" onchange='file_name.value=mid(file_path.value,instrrev(file_path.value ,"\")+1)'>
<br>
<INPUT id=btn_send name="btn_send" type=button value="FILE SEND" onclick="UploadFile">
<DIV id=div_message>Ready</DIV>
</BODY>
</HTML>

<SCRIPT LANGUAGE=javascript>
<!--
/*
下面函数是JavaScript的实现方式,采用OOP的方式实现
可能有部分问题,如果哪个兄弟有空帮我调试一下
*/
/*
function CFileUpload(sFilePath,sFileName,sSaveToPath,sUploadServer){

this.FilePath=sFilePath;
this.FileName=sFileName;
this.UploadServer=sUploadSerer;
this.SaveFileToPath=sSaveToPath;
alert('liu');
}

CFileUpload.prototype.Upload = function(){

var adoStream=new ActiveXObject("ADODB.Stream"); //文件流对象
var xmlDOM =new ActiveXObject("MSXML2.DOMDocument"); //XML对象
xmlDOM.loadXML('<?xml version="1.0" ?> <root/>');
xmlDOM.documentElement.setAttribute("xmlns:dt","urn:schemas-microsoft-com:datatypes");

var ndFileData=xmlDOM.createElement("FileData")
ndFileData.dataType="bin.base64";

adoStream.Type =1 ;//设置为二进制类型
adoStream.Open();
adoStream.LoadFromFile(this.FilePath);

ndFileData.nodeTypedValue=adoStream.Read(-1);

ado_stream.Close();

xmlDOM.appendChild(ndFileData);

//添加文件名
var ndFileName=xmlDOM.createElement("FileName");
ndFileName.value=this.FileName;
xmlDOM.appendChild(ndFileName);

//添加保存文件路径
var ndSaveToPath=xmlDOM.createElement("SaveFilePath");
ndSaveToPath.value=this.SaveFileToPath;
xmlDOM.appendChild(ndSaveToPath);
/*
var objHTTP=new ActiveXObject("Microsoft.XMLHTTP");
objHTTP.open("POST","UploadService.asp",false);

alert("hello");

}

function UploadFile(){
var upf=new CFileUpload();
upf.FilePath=file_path.value ;
upf.FileName=file_name.value ;
upf.SaveToFilePath=null;
alert("kk");
upf.Uplad();
}
*/
//-->
</SCRIPT>


有些东西写的不完善,这段日子比较忙,有哪个大哥有空帮我写完吧
我的E-Mail:liuruhong@263.net ,QQ:17886612,欢迎交流
...全文
130 3 打赏 收藏 转发到动态 举报
AI 作业
写回复
用AI写文章
3 条回复
切换为时间正序
请发表友善的回复…
发表回复
_TMG_ 2002-12-11
  • 打赏
  • 举报
回复
收藏ed. 有空看看
liuruhong 2002-12-11
  • 打赏
  • 举报
回复
忘记了,在IE中好像有的版本会出现ado/rds转到其他域的数据源,是否确定,选择yes就好了,我想是因为安全问题吧
liuruhong 2002-12-11
  • 打赏
  • 举报
回复
下面是服务器端的实现代码

UP.ASP

<%
Response.ContentType ="text/xml"
Response.CharSet ="gb2312"
set up=Server.CreateObject("ShuorenUpload.UploadService")
up.DisposeRequest
Response.Write up.ResponseXML
%>

Active Server Upload Component
使用vb编写的
Public Enum upEnumResponse
statusSuccessfull = 100 '成功
statusSaveDefaultFolder = 101 '成功保存
statusSaveOverWriteFile = 102 '覆盖文件保存

' 大于300以上的全部为错误
statusFileNameBlank = 301
statusFilePathNotExists = 302
statusOverWriteFileFail = 303

End Enum
Private mRequest As ASPTypeLibrary.Request
Private mResponse As ASPTypeLibrary.Response
Private mServer As ASPTypeLibrary.Server

Private mResponseDoc As DOMDocument

Private mResponseStatus As String
Private mResponseString As String

'------------------------------------------------------
'OnStartPage 和OnEndPage是Active Server Component需要执行的代码,如果通过Server.CreateObject来创建对象
'那么首先执行OnStartPage,对象释放的时候执行OnEndPage
'再OnStartPage加入了PassedScriptiongContext来保证对于asp进程的调用
'--------------------------------------------------------
Public Sub OnStartPage(PassedScriptingContext As ScriptingContext)
Set mRequest = PassedScriptingContext.Request
Set mResponse = PassedScriptingContext.Response
Set mserer = PassedScriptingContext.Server
End Sub

Public Sub OnEndPage()
Set mRequest = Nothing
Set mResponse = Nothing
Set mServer = Nothing
End Sub

Public Property Get ResponseXML() As String '响应消息
ResponseXML = mResponseDoc.xml
Debug.Print mResponseDoc.xml
End Property

Public Sub DisposeRequest() '处理XML请求
Dim xmlDOM As New DOMDocument
Dim adoStream As New ADODB.Stream
Dim mFileName As String
Dim mSaveFilePath As String

Dim ndFileName As IXMLDOMNode
Dim ndSaveFilePath As IXMLDOMNode
Dim ndFileData As IXMLDOMNode

Dim mDisposeStatus As upEnumResponse
xmlDOM.Load mRequest

'取必要的文件名
Set ndFileName = xmlDOM.selectSingleNode("Root/FileName")
mFileName = ndFileName.Text

'取文件存储的路径
Set ndSaveFilePath = xmlDOM.selectSingleNode("Root/SaveFilePath")
mSaveFilePath = ndSaveFilePath.Text

'取文件数据
Set ndFileData = xmlDOM.selectSingleNode("Root/FileData")
adoStream.Type = adTypeBinary
adoStream.Open
adoStream.Write ndFileData.nodeTypedValue
adoStream.SaveToFile mSaveFilePath & "\" & ndFileName.Text, 2
adoStream.Close

Set xmlDOM = Nothing
Set adoStream = Nothing

'响应客户请求
Set mResponseDoc = New DOMDocument
mResponseDoc.loadXML ("<?xml version=""1.0"" ?><Response/>")

mDisposeStatus = statusSuccessfull

Dim ndStatus As IXMLDOMNode
Dim ndInfo As IXMLDOMNode

Set ndStatus = mResponseDoc.createElement("Status")
ndStatus.Text = mDisposeStatus
mResponseDoc.documentElement.appendChild ndStatus

Set ndInfo = mResponseDoc.createElement("Description")
ndInfo.Text = "保存成功"
mResponseDoc.documentElement.appendChild ndInfo

End Sub


有些东西写的不晚上,这段日子比较忙,有哪个大哥有空帮我写完吧
我的E-Mail:liuruhong@263.net ,QQ:17886612,欢迎交流

28,409

社区成员

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

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