savemail.htm
来自「全方面的OA管理程序代码」· HTM 代码 · 共 163 行
HTM
163 行
<!--#include file="../inc/Secure.htm"-->
<!--#include file="../inc/conn.htm"-->
<%
LoginID=trim(session("LoginID"))
if LoginID="" then LoginID=0
FromName=GetTableValue ("tblUser","Name","ID",LoginID)
sendto=replace(trim(request("sendto")),"'","''")
subject=replace(trim(request("subject")),"'","''")
copyto=replace(trim(request("copyto")),"'","''")
attachfile=replace(trim(request("attachfile")),"'","''")
body=replace(trim(request("body")),"'","''")
arrSendto=split(sendto,",")
arrCopyto=split(copyto,",")
dim strSendto, strCopyto
if request("cmdSend")<>"" then
if not isempty(arrSendto) then
for i=0 to ubound(arrSendto)
str=arrSendto(i)
ToID=GetTableValue ("tblUser","ID","Name",str)
if Toid="" or not isnumeric(toID) then
response.write "含有非法人名!请检查后再发送!<a href=""javascript:history.back(-1);"">[返回]</a>"
oconn.close
response.end
end if
strSendto=","& ToID
SendMail LoginID, FromName,ToID,str,subject,body,attachfile
CopyOneFile "../File_Up/MailTemp/"&LoginID&"/"&Attachfile, "../File_Up/Mail/"&ToID, attachfile
'SendMail(FromID,FromName,ToID,ToName,Subject,Body,AttachFile)
next
else
oConn.close
response.write "没有输入正确的收件人。<a href=mail.htm>[返回]</a>"
response.end
end if
if not isempty(arrCopyto) then
for i=0 to ubound(arrCopyto)
strCopyto=trim(arrCopyto(i))
if instr(sendto,strCopyto)<=0 then
copytoID=GetTableValue ("tblUser","ID","Name",arrCopyto(i))
if copytoID="" or not isnumeric(copytoID) then
response.write "含有非法人名!请检查后再发送!<a href=""javascript:history.back(-1);"">[返回]</a>"
oconn.close
response.end
end if
SendMail LoginID, FromName,copytoID,strCopyto,subject,body,attachfile
CopyOneFile "../File_Up/MailTemp/"&LoginID&"/"&Attachfile, "../File_Up/Mail/"©toID, attachfile
end if
next
end if
MailOut LoginID, FromName,0,sendto,copyto,Subject,Body,attachfile,1
CopyOneFile "../File_Up/MailTemp/"&LoginID&"/"&Attachfile, "../File_Up/Mail/"&LoginID, attachfile
DeleteOneFile "../File_Up/MailTemp/"& LoginID &"/" & AttachFile
Session("AttachFile")=""
response.write "邮件已经发送成功!<a href=mail.htm>[返回]</a>"
oconn.close
response.end
end if
if request("cmdSave")<>"" then
MailOut LoginID, FromName,0,sendto,copyto,Subject,Body,attachfile,0
Session("AttachFile")=""
response.write "邮件已经保存为草稿!<a href=mail.htm>[返回]</a>"
oconn.close
response.end
end if
%>
<HTML>
<HEAD>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<link rel="stylesheet" type="text/css" href="../CSS/main.css">
</HEAD>
<BODY BGCOLOR="#FFFFFF">
</BODY>
</HTML>
<!--#include file="../inc/conn_close.htm"-->
<%
Sub SendMail(FromID,FromName,ToID,ToName,Subject,Body,AttachFile)
sql="INSERT INTO tblMailIn(FromID, ToID, FromName, ToName, Subject, Body, AttachFile) VALUES(" & FromID & _
","& ToId & _
",'" & FromName & _
"','"& ToName & _
"','"& Subject & _
"','"& Body & _
"','"& AttachFile & _
"')"
'response.write sql&"<BR>"
oConn.execute (sql)
End Sub
Sub MailOut(FromID,FromName,ToID,ToName,copytoName,Subject,Body,AttachFile,status)
sql="INSERT INTO tblMailOut(FromID, ToID, FromName, ToName,copytoName, Subject, Body, AttachFile,status) VALUES(" & FromID & _
","& ToId & _
",'" & FromName & _
"','"& ToName & _
"','"& copyToName & _
"','"& Subject & _
"','"& Body & _
"','"& AttachFile & _
"',"& Status & _
")"
'response.write sql&"<br>"
oConn.execute (sql)
End Sub
Function GetTableValue(TableName,Field,ValueField,Value)
if TableName<>"" and Value<>"" then
Set RsTmp = Server.Createobject("Adodb.recordset")
strSql = "Select "& Field &" from "& TableName &" where "& ValueField &"='"& Value &"'"
Rstmp.open strSql,oConn,1,1
If not Rstmp.eof then
GetTableValue=trim(Rstmp(Field))
else
GetTableValue=""
end if
Rstmp.close
'set RsTmp = Nothing
else
GetTableValue=""
end if
End Function
sub DeleteOneFile (FilePathName)
FilePathName=Server.Mappath(FilePathName)
dim fs
Set fs = server.CreateObject("Scripting.FileSystemObject")
if trim(FilePathName)<>"" and fs.FileExists(FilePathName) then
fs.DeleteFile FilePathName
end if
set fs=nothing
end sub
sub CopyOneFile (FileName1,PathName2,FileName)
FileName1=Server.Mappath(FileName1)
PathName2=Server.Mappath(PathName2)
dim fs,f
Set fs = server.CreateObject("Scripting.FileSystemObject")
if not fs.FolderExists(PathName2) then
fs.CreateFolder PathName2
end if
if trim(FileName1)<>"" and fs.FileExists(FileName1) then
set f=fs.GetFile(FileName1)
f.Copy PathName2&"\"&FileName,true
end if
set fs=nothing
end sub
%>
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?