微软OfficeActive控件怎么将文档上传到服务器

Question

(1)在http://www.cppblog.com/wanhhf/archive/2006/04/29/3355.html看到如下代码
  我用的控件是http://www.cppblog.com/Files/wanhhf/DSOFramer_0521.rar
  //初始化Http引擎
  document.all.FramerControl1.HttpInit();
  //增加Post变量
  document.all.FramerControl1.HttpAddPostString("RecordID","20060102200);
  document.all.FramerControl1.HttpAddPostString("UserID","李局长");
  //上传打开的文件
  document.all.FramerControl1.HttpAddPostCurrFile("FileData", "文档名.doc");
  //执行上传动作
 document.all.FramerControl1.HttpPost("http://xxxx.com/uploadfile.asp"); 
 不明白怎么上传
(2)使用document.all.FramerControl1.Save("http://localhost/WebOffice/文档名.doc"，true)，IE报脚本错误：
      行：36
      字符：4
      错误： 未指定的错误
      代码：0
      URL：http://localhost/WebOffice/Default.aspx我的行36代码为：document.all.FramerControl1.Save("http://localhost/WebOffice/Document/test.doc",true)，是我写错了吗？

Answer 1

uploadfile.asp来处理所提交的信息

Answer 2

我在uploadfile.aspx该如何写数据分析部分的程序啊？
是遍历Request.InputStream吗，我想应该有比较好的实现方法吧！

Answer 3

这有个asp的
uploadfile.asp
<%@ Language=VBScript %>
<!-- #include file="upload.inc" -->
<%
Set Uploader = New UpFile_Class
Uploader.NoAllowExt="cs;vb;js;exe" ' 设置不允许上传的文件类型
Uploader.GetData (Request.TotalBytes) ' 设置限制的上传文件大小，Request.TotalBytes表示无限制if Uploader.isErr then  '如果出错
  select case Uploader.isErr
case 1
Response.Write "系统没有取得您上传的数据，请重试"
case 2
Response.Write "您上传的文件超出我们的限制"
End select
Response.End
End ifDBStr="Provider=SQLOLEDB;Data Source=(local);Initial Catalog=TestUploadFile;User ID=sa;Password=;"
Set BbsDB =Server.CreateObject("ADODB.Connection")
BbsDB.Open DBStr
Set rs=Server.CreateObject("ADODB.RecordSet")dim id 
id = Request.QueryString("id")
if id = "" then 
   id = 0
End ifif id<>0 then 
    Sql="SELECT * from TestFiles where id = "&id
else
    Sql="SELECT * from TestFiles"
End ifrs.Open Sql,BbsDB,1, 3for each formName in Uploader.file ' 列出所有上传了的文件
set file=Uploader.file(formName) ' 生成一个文件对象
If id<>0 then  
rs("MyFileName")   = "test.doc"
rs("MyFile")  = Uploader.FileData(formname)
rs("FileType")   = "doc"
else
rs.AddNew
rs("MyFileName")  = "test.doc"
rs("MyFile") = Uploader.FileData(formname)    ''保存文件
rs("FileType")  = "doc"
End If
 Response.Write "OK"
 set file=nothing
 rs.Update
exit for 
nextrs.Close
Set rs=Nothing
BbsDB.close
set BbsDB = Nothing
Set Uploader = Nothing%>

Answer 4

upload.inc
<%
'文件上传类
Class UpFile_ClassDim Form,File
Private oUpFileStream
Private isErr_
Private ErrMessage_
Private isGetData_ '------------------------------------------------------------------
'类的属性Public Property Get isErr '错误的代码,0或true表示无错
isErr=isErr_
End PropertyPublic Property Get ErrMessage '错误的字符串信息
ErrMessage=ErrMessage_
End Property
'----------------------------------------------------------------
'类实现代码'初始化类
Private Sub Class_Initialize
isErr_ = 0
isGetData_=false
End Sub'类结束
Private Sub Class_Terminate
on error Resume Next
'清除变量及对像
Form.RemoveAll
Set Form = Nothing
File.RemoveAll
Set File = Nothing
oUpFileStream.Close
Set oUpFileStream = Nothing
End Sub'分析上传的数据
Public Sub GetData (MaxSize)
 '定义变量
on error Resume Next
if isGetData_=false then 
Dim RequestBinDate,sSpace,bCrLf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,oFileInfo
Dim sFormValue,sFileName
Dim iFindStart,iFindEnd
Dim iFormStart,iFormEnd,sFormName
'代码开始
If Request.TotalBytes < 1 Then '如果没有数据上传
isErr_ = 1
ErrMessage_="没有数据上传"
Exit Sub
End If
If MaxSize > 0 Then '如果限制大小
If Request.TotalBytes > MaxSize Then
isErr_ = 2 '如果上传的数据超出限制大小
ErrMessage_="上传的数据超出限制大小"
Exit Sub
End If
End If
Set Form = Server.CreateObject ("Scripting.Dictionary")
Form.CompareMode = 1
Set File = Server.CreateObject ("Scripting.Dictionary")
File.CompareMode = 1
Set tStream = Server.CreateObject ("ADODB.Stream")
Set oUpFileStream = Server.CreateObject ("ADODB.Stream")
oUpFileStream.Type = 1
oUpFileStream.Mode = 3
oUpFileStream.Open 
oUpFileStream.Write Request.BinaryRead (Request.TotalBytes)
oUpFileStream.Position = 0
RequestBinDate = oUpFileStream.Read 
iFormEnd = oUpFileStream.Size
bCrLf = ChrB (13) & ChrB (10)
'取得每个项目之间的分隔符
sSpace = MidB (RequestBinDate,1, InStrB (1,RequestBinDate,bCrLf)-1)
iStart = LenB(sSpace)
iFormStart = iStart+2
'分解项目
Do
iInfoEnd = InStrB (iFormStart,RequestBinDate,bCrLf & bCrLf)+3
tStream.Type = 1
tStream.Mode = 3
tStream.Open
oUpFileStream.Position = iFormStart
oUpFileStream.CopyTo tStream,iInfoEnd-iFormStart
tStream.Position = 0
tStream.Type = 2
tStream.CharSet = "gb2312"
sInfo = tStream.ReadText
'取得表单项目名称
iFormStart = InStrB (iInfoEnd,RequestBinDate,sSpace)-1
iFindStart = InStr (22,sInfo,"name=""",1)+6
iFindEnd = InStr (iFindStart,sInfo,"""",1)
sFormName = Mid (sinfo,iFindStart,iFindEnd-iFindStart)
'如果是文件
If InStr (45,sInfo,"filename=""",1) > 0 Then
Set oFileInfo = new FileInfo_Class
'取得文件属性
iFindStart = InStr (iFindEnd,sInfo,"filename=""",1)+10
iFindEnd = InStr (iFindStart,sInfo,""""&vbCrLf,1)
sFileName = Mid (sinfo,iFindStart,iFindEnd-iFindStart)
oFileInfo.FileName = GetFileName(sFileName)
oFileInfo.FilePath = GetFilePath(sFileName)
oFileInfo.FileExt = GetFileExt(sFileName)
iFindStart = InStr (iFindEnd,sInfo,"Content-Type: ",1)+14
iFindEnd = InStr (iFindStart,sInfo,vbCr)
oFileInfo.FileMIME = Mid(sinfo,iFindStart,iFindEnd-iFindStart)
oFileInfo.FileStart = iInfoEnd
oFileInfo.FileSize = iFormStart -iInfoEnd -2
oFileInfo.FormName = sFormName
file.add sFormName,oFileInfo
else
'如果是表单项目
tStream.Close
tStream.Type = 1
tStream.Mode = 3
tStream.Open
oUpFileStream.Position = iInfoEnd 
oUpFileStream.CopyTo tStream,iFormStart-iInfoEnd-2
tStream.Position = 0
tStream.Type = 2
tStream.CharSet = "gb2312"
sFormValue = tStream.ReadText
If Form.Exists (sFormName) Then
Form (sFormName) = Form (sFormName) & ", " & sFormValue
else
Form.Add sFormName,sFormValue
End If
End If
tStream.Close
iFormStart = iFormStart+iStart+2
'如果到文件尾了就退出
Loop Until (iFormStart+2) >= iFormEnd 
RequestBinDate = ""
Set tStream = Nothing
isGetData_=true
end if
End Sub'保存到文件,自动覆盖已存在的同名文件
Public Function SaveToFile(Item,Path)
SaveToFile=SaveToFileEx(Item,Path,True)
End Function'保存到文件,自动设置文件名
Public Function AutoSave(Item,Path)
AutoSave=SaveToFileEx(Item,Path,false)
End Function'保存到文件,OVER为真时,自动覆盖已存在的同名文件,否则自动把文件改名保存
Private Function SaveToFileEx(Item,Path,Over)
On Error Resume Next
Dim oFileStream
Dim tmpPath
isErr=0
Set oFileStream = CreateObject ("ADODB.Stream")
oFileStream.Type = 1
oFileStream.Mode = 3
oFileStream.Open
oUpFileStream.Position = File(Item).FileStart
oUpFileStream.CopyTo oFileStream,File(Item).FileSize
tmpPath=Path
if Over then
if isAllowExt(GetFileExt(tmpPath)) then
oFileStream.SaveToFile tmpPath,2
Else
isErr_=3
ErrMessage_="该后缀名的文件不允许上传!"
End if
Else
Path=GetFilePath(Path)
if isAllowExt(File(Item).FileExt) then
do
Err.Clear()
tmpPath=Path&GetNewFileName()&"."&File(Item).FileExt
oFileStream.SaveToFile tmpPath
loop Until Err.number<1
oFileStream.SaveToFile Path
Else
isErr_=3
ErrMessage_="该后缀名的文件不允许上传!"
End if
End if
oFileStream.Close
Set oFileStream = Nothing
if isErr_=3 then SaveToFileEx="" else SaveToFileEx=GetFileName(tmpPath)
End Function'取得文件数据
Public Function FileData(Item)
isErr_=0
if isAllowExt(File(Item).FileExt) then
oUpFileStream.Position = File(Item).FileStart
FileData = oUpFileStream.Read (File(Item).FileSize)
Else
isErr_=3
ErrMessage_="该后缀名的文件不允许上传!"
FileData=""
End if
End Function
'取得文件路径
Public function GetFilePath(FullPath)
  If FullPath <> "" Then
    GetFilePath = Left(FullPath,InStrRev(FullPath, "\"))
    Else
    GetFilePath = ""
  End If
End function'取得文件名
Public Function GetFileName(FullPath)
  If FullPath <> "" Then
    GetFileName = mid(FullPath,InStrRev(FullPath, "\")+1)
    Else
    GetFileName = ""
  End If
End function'取得文件的后缀名
Public Function GetFileExt(FullPath)
  If FullPath <> "" Then
    GetFileExt = LCase(Mid(FullPath,InStrRev(FullPath, ".")+1))
    Else
    GetFileExt = ""
  End If
End function'取得一个不重复的序号
Public Function GetNewFileName()
dim ranNum
dim dtNow
dtNow=Now()
ranNum=int(90000*rnd)+10000
'以下这段由webboy提供
GetNewFileName=year(dtNow) & right("0" & month(dtNow),2) & right("0" & day(dtNow),2) & right("0" & hour(dtNow),2) & right("0" & minute(dtNow),2) & right("0" & second(dtNow),2) & ranNum
End FunctionPublic Function isAllowExt(Ext)
if NoAllowExt="" then
isAllowExt=cbool(InStr(1,";"&AllowExt&";",LCase(";"&Ext&";")))
else
isAllowExt=not CBool(InStr(1,";"&NoAllowExt&";",LCase(";"&Ext&";")))
end if
End Function
End Class
'----------------------------------------------------------------------------------------------------
'文件属性类
Class FileInfo_Class
Dim FormName,FileName,FilePath,FileSize,FileMIME,FileStart,FileExt
End Class%>

Answer 5

我研究研究 先把它转城ASP.NET的