upfile.asp

红金羚v1.5办公自动化软件是基于大型数据库系统开发的应用系统

<%@ LANGUAGE = VBScript %>
<%Server.ScriptTimeOut=5000%>
<!--#include file="utils.asp" -->
<%
dim Data_5xsoft
Class upload_5xsoft  
dim objForm,objFile,Version
Public function Form(strForm)
   strForm=lcase(strForm)
   if not objForm.exists(strForm) then
     Form=""
   else
     Form=objForm(strForm)
   end if
 end function
Public function File(strFile)
   strFile=lcase(strFile)
   if not objFile.exists(strFile) then
     set File=new FileInfo
   else
     set File=objFile(strFile)
   end if
 end function
Private Sub Class_Initialize 
  dim RequestData,sStart,vbCrlf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,theFile
  dim iFileSize,sFilePath,sFileType,sFormValue,sFileName
  dim iFindStart,iFindEnd
  dim iFormStart,iFormEnd,sFormName
  Version="Version 2.0"
  set objForm=Server.CreateObject("Scripting.Dictionary")
  set objFile=Server.CreateObject("Scripting.Dictionary")
  if Request.TotalBytes<1 then Exit Sub
  set tStream = Server.CreateObject("adodb.stream")
  set Data_5xsoft = Server.CreateObject("adodb.stream")
  Data_5xsoft.Type = 1
  Data_5xsoft.Mode =3
  Data_5xsoft.Open
  Data_5xsoft.Write  Request.BinaryRead(Request.TotalBytes)
  Data_5xsoft.Position=0
  RequestData =Data_5xsoft.Read 

  iFormStart = 1
  iFormEnd = LenB(RequestData)
  vbCrlf = chrB(13) & chrB(10)
  sStart = MidB(RequestData,1, InStrB(iFormStart,RequestData,vbCrlf)-1)
  iStart = LenB (sStart)
  iFormStart=iFormStart+iStart+1
  while (iFormStart + 10) < iFormEnd 
	iInfoEnd = InStrB(iFormStart,RequestData,vbCrlf & vbCrlf)+3
	tStream.Type = 1
	tStream.Mode =3
	tStream.Open
	Data_5xsoft.Position = iFormStart
	Data_5xsoft.CopyTo tStream,iInfoEnd-iFormStart
	tStream.Position = 0
	tStream.Type = 2
	tStream.Charset ="gb2312"
	sInfo = tStream.ReadText
	tStream.Close
	'取得表单项目名称
	iFormStart = InStrB(iInfoEnd,RequestData,sStart)
	iFindStart = InStr(22,sInfo,"name=""",1)+6
	iFindEnd = InStr(iFindStart,sInfo,"""",1)
	sFormName = lcase(Mid (sinfo,iFindStart,iFindEnd-iFindStart))
	'如果是文件
	if InStr (45,sInfo,"filename=""",1) > 0 then
		set theFile=new FileInfo
		'取得文件名
		iFindStart = InStr(iFindEnd,sInfo,"filename=""",1)+10
		iFindEnd = InStr(iFindStart,sInfo,"""",1)
		sFileName = Mid (sinfo,iFindStart,iFindEnd-iFindStart)
		theFile.FileName=getFileName(sFileName)
		theFile.FilePath=getFilePath(sFileName)
		'取得文件类型
		iFindStart = InStr(iFindEnd,sInfo,"Content-Type: ",1)+14
		iFindEnd = InStr(iFindStart,sInfo,vbCr)
		theFile.FileType =Mid (sinfo,iFindStart,iFindEnd-iFindStart)
		theFile.FileStart =iInfoEnd
		theFile.FileSize = iFormStart -iInfoEnd -3
		theFile.FormName=sFormName
		if not objFile.Exists(sFormName) then
		  objFile.add sFormName,theFile
		end if
	else
	'如果是表单项目
		tStream.Type =1
		tStream.Mode =3
		tStream.Open
		Data_5xsoft.Position = iInfoEnd 
		Data_5xsoft.CopyTo tStream,iFormStart-iInfoEnd-3
		tStream.Position = 0
		tStream.Type = 2
		tStream.Charset ="gb2312"
	        sFormValue = tStream.ReadText 
	        tStream.Close
		if objForm.Exists(sFormName) then
		  objForm(sFormName)=objForm(sFormName)&", "&sFormValue		  
		else
		  objForm.Add sFormName,sFormValue
		end if
	end if
	iFormStart=iFormStart+iStart+1
	wend
  RequestData=""
  set tStream =nothing
End Sub

Private Sub Class_Terminate  
 if Request.TotalBytes>0 then
	objForm.RemoveAll
	objFile.RemoveAll
	set objForm=nothing
	set objFile=nothing
	Data_5xsoft.Close
	set Data_5xsoft =nothing
 end if
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
End Class

Class FileInfo
  dim FormName,FileName,FilePath,FileSize,FileType,FileStart
  Private Sub Class_Initialize 
    FileName = ""
    FilePath = ""
    FileSize = 0
    FileStart= 0
    FormName = ""
    FileType = ""
  End Sub
  
 Public function SaveAs(FullPath)
    dim dr,ErrorChar,i
    SaveAs=true
    if trim(fullpath)="" or FileStart=0 or FileName="" or right(fullpath,1)="/" then exit function
    set dr=CreateObject("Adodb.Stream")
    dr.Mode=3
    dr.Type=1
    dr.Open
    Data_5xsoft.position=FileStart
    Data_5xsoft.copyto dr,FileSize
    dr.SaveToFile FullPath,2
    dr.Close
    set dr=nothing 
    SaveAs=false
  end function
  End Class
%>
<html>
<head>
<title>发送邮件</title>
<link rel="stylesheet" href="vos.css" type="text/css">
</head>
<body>
<%
 ' MailMessages: 
	' message_id: int identity|int: 4
	' mailbox_id: byte: 1
	' user_name: text|varchar: 50
	' hd_frpm: text|varchar: 50
	' hd_to: text|varchar: 50
	' hd_cc: text|varchar: 100
	' hd_date: text|varchar: 50
	' hd_subject: text|varchar: 100
	' msg_body: memo
	' dt_created: datetime: 8
	' dt_read: datetime: 8
	' readbit: bit
	' draftbit: bit
	' replybit: bit
	' attachbit: bit
	' attachfile: text|varchar: 50
	' level: byte: 1
dim mailbox_id
dim user_name
dim hd_frpm
dim hd_to
dim hd_cc
dim hd_date
dim hd_subject
dim msg_body
dim attachfile
dim level

dim adOpenKeyset
dim adLockOptimistic
dim NumOfrs
adOpenKeyset = 1
adLockOptimistic = 3
function MakedownName()
	dim fname
    fname =now()
	fname = replace(fname,"-","")
	fname = replace(fname,"/","")
    fname = replace(fname," ","") 
    fname = replace(fname,":","")
    fname = replace(fname,"PM","")
    fname = replace(fname,"AM","")
    fname = replace(fname,"上午","")
    fname = replace(fname,"下午","")
    fname = int(fname) + int((100)*Rnd + 1)
	MakedownName=fname & iext
end function 
%>
<%
	dim upload,file,formName,formPath,iCount
	set upload=new upload_5xsoft
	hd_from = upload.form("hd_from")
	hd_to = upload.form("hd_to")
	hd_cc = upload.form("hd_cc")
	hd_subject = upload.form("hd_subject")
	msg_body = upload.form("msg_body")
	dt_created=upload.form("DateTime")
	level = upload.form("level")
	'格式化邮件信息
	msg_body=replace(msg_body,"<s","&lt;s")
	msg_body=replace(msg_body,"<S","&lt;S")+vbcrlf+vbcrlf+vbcrlf+vbcrlf+vbcrlf+vbcrlf
	if msg_body="" then msg_body="无内容"
	msg_body=replace(msg_body,"'","’")
	hd_subject=replace(hd_subject,"<","&lt;")
	if hd_subject="" then hd_subject="无标题"
	formPath=upload.form("filepath")
	if right(formPath,1)<>"/" then formPath=formPath&"/" 
	'写入附件信息
	iCount=0
	for each formName in upload.objFile
		set file=upload.file(formName)
		if file.FileSize>0 then
  			iext="."&mid(file.FileName,InStrRev(file.FileName, ".")+1)
			newname=MakedownName()
			attachfile=newname
			attachbit=1			
			file.SaveAs Server.mappath(formPath&newname)
			iCount=iCount+1
		else
			attachfile=""
			attachbit=0
		end if
 	set file=nothing
	next
	
	mailbox_id=1	'写入收件箱
	sql = "INSERT INTO MailMessages" & _ 
	"(" & _ 
	"mailbox_id," & _ 
	"hd_from," & _ 
	"hd_to," & _ 
	"hd_cc," & _ 
	"hd_subject," & _ 
	"dt_created," & _ 
	"attachfile," & _ 
	"attachbit," & _ 
	"msg_body" & _ 
	") VALUES(" & _ 
	"" & to_sql(mailbox_id,"number") & "," & _ 
	"" & to_sql(hd_from,"text") & "," & _ 
	"" & to_sql(hd_to,"text") & "," & _ 
	"" & to_sql(hd_cc,"text") & "," & _ 
	"" & to_sql(hd_subject,"text") & "," & _ 
	"" & to_sql(dt_created,"text") & "," & _ 
	"" & to_sql(attachfile,"text") & "," & _ 
	"" & to_sql(attachbit,"number") & "," & _ 
	"" & to_sql(msg_body,"text") & _ 
	")" 
	cn.Execute(sql)
	'**************************保存在发件箱***************************************
	if  upload.form("copy")="checkbox" then
	'写入附件
		'写入附件信息
	iCount=0
	for each formName in upload.objFile
		set file=upload.file(formName)
		if file.FileSize>0 then
  			iext="."&mid(file.FileName,InStrRev(file.FileName, ".")+1)
			newname=MakedownName()
			attachfile=newname
			attachbit=1			
			file.SaveAs Server.mappath(formPath&newname)
			iCount=iCount+1
		else
			attachfile=""
			attachbit=0
		end if
 	set file=nothing
	next
	
	mailbox_id=0	'写发收件箱
	sql = "INSERT INTO MailMessages" & _ 
	"(" & _ 
	"mailbox_id," & _ 
	"hd_from," & _ 
	"hd_to," & _ 
	"hd_cc," & _ 
	"hd_subject," & _ 
	"dt_created," & _ 
	"attachfile," & _ 
	"attachbit," & _ 
	"msg_body" & _ 
	") VALUES(" & _ 
	"" & to_sql(mailbox_id,"number") & "," & _ 
	"" & to_sql(hd_from,"text") & "," & _ 
	"" & to_sql(hd_to,"text") & "," & _ 
	"" & to_sql(hd_cc,"text") & "," & _ 
	"" & to_sql(hd_subject,"text") & "," & _ 
	"" & to_sql(dt_created,"text") & "," & _ 
	"" & to_sql(attachfile,"text") & "," & _ 
	"" & to_sql(attachbit,"number") & "," & _ 
	"" & to_sql(msg_body,"text") & _ 
	")" 
	cn.Execute(sql)
	end if
	set upload=nothing 
%>
<table width="100%" border="0" cellpadding="0" cellspacing="0">
  <tr> 
    <td width="100%" height="22" valign="top" class="HeaderTD">发送邮件</td>
  </tr>
  <tr> 
    <td height="146" valign="middle" align="center" class="MsgTD"><font color="#FF0000"><b>邮件发送成功！</b></font></td>
  </tr>
  <tr> 
    <td height="22" valign="top" class="HeaderTD"> 
      <input type="button" value="  返回  " name="B3" class=cmd onclick="javascript:history.back(-1)">
    </td>
  </tr>
</table>
</body>
</html>