''=========msg_add.asp===========
<%@ Language=VBScript %>
<!-- #include file="../share/connectdb.asp" -->
<!-- #include file="..\share\pubfun_a.inc" -->
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<link rel="StyleSheet" type="text/css" href="msg_css.css">
<script language=vbscript src="..\share\pubfun_crmcli_select.vbs"></script>
</head>
<body>
<%
Response.Expires=0
Dim rs
set rs=server.CreateObject("ADODB.recordset")
dim sygbhlb,sygxmlb,i,syglb
sygbhlb=Request.QueryString("ygbhlb")
syglb=""
sygxmlb=""
if sygbhlb<>"" then
rs.Open "select ygbh,ygxm from rs_ygb where ygbh in(" & sygbhlb & ")",conn,1,1
do while not rs.EOF
syglb="," & rs("ygbh")
sygxmlb=" " & rs("ygxm")
rs.MoveNext
loop
rs.Close
if syglb<>"" then
syglb=mid(syglb,2)
sygxmlb=mid(sygxmlb,2)
end if
end if
set rs=nothing
conn.close
set conn=nothing
%>
<br>
<fieldset style="position:absolute;left:1px;top:1px;width=346px;border:1" align=center>
<table class=dataclass width=100% align=center>
<form name=frmxx id=frmxx method="post">
<input type=hidden id=ygbhlb name=ygbhlb value="<%=syglb%>">
<tr>
<td width=54 class=left align=right nowrap>接收人 </td>
<td class=row width=402 style="border-1;border-style:solid;border-color:green;cursor:hand" onClick="vbscript:doselry" ><span id=jsrlb size="30" name=jsrlb><a><%=rtrim(sygxmlb)%></a></span> </td>
<td width="457" align=right class=row id=tools name=tools><img src="image/selectman.gif" alt="选择接收人" onClick="vbscript:doselry" style="cursor:hand"> <img src="image/send.gif" alt="发送" onClick="vbscript:doFS" style="cursor:hand"> </td>
</tr>
<tr>
<td width=54 class=left align=right nowrap>消息内容 </td>
<td class=row colspan=2><textarea class=inputarea cols=43 id=xxnr name=xxnr rows=10 style="border-1;border-style:solid;border-color:green;scrollbar-3dlight-color:a5d79c;scrollbar-arrow-color:green;scrollbar-base-color:a5d79c;scrollbar-darkshadow-color:48bb55;scrollbar-face-color:#48bb55;scrollbar-highlight-color:a5d79c;scrollbar-shadow-color:a5d79c;"></textarea>
</td>
</tr>
<tr> <td width=54 class=left align=right nowrap></td>
<td nowrap id="td_fj"></td>
</tr>
<tr> <td width=54 class=left align=right nowrap>增加</td>
<td ><input name="附件" type="button" id="button_fj" onClick="vbscript:xzfj()" value="附件" language=javascript></td>
</tr>
</form>
</table>
<!--=//////////////////////////==========-BY winner 15:18 2006-3-22 增加附件的功能---//////////////////////////////////////-->
<!--===//////////////////////========-BY winner 15:18 2006-3-22 增加附件的功能--//////////////////////////////////////////--->
</fieldset>
</body>
</html>
<script language="VBScript">
' function doFS()
sub doFS
if frmxx.ygbhlb.value="" then
msgbox "请选择接收人",vbinformation,"提示"
exit sub
end if
frmxx.xxnr.value=trim(frmxx.xxnr.value)
if frmxx.xxnr.value="" then
msgbox "您没有输入消息!",vbInformation,"提示"
frmxx.xxnr.focus
exit sub
end if
if len(frmxx.xxnr.value)>255 then
msgbox "消息长度需要在255个字符之内!",vbInformation,"提示"
frmxx.xxnr.focus
exit sub
end if
'''''By Winnner 判断附件的大小''''''''''''''''''
'判断附件
i=frmxx.elements.length
if (i<>0) then
for j=0 to i-1
set e=frmxx.elements(j)
if e.type="file" then
if trim(e.value)="" then
alert("请选择附件")
e.focus
exit sub
end if
count=mid(e.name,3,len(e.name))
set k=document.getElementById("fjsm"&count)
if k is nothing then
alert("异常错误，请刷新本页面")
k.focus
exit sub
end if
if trim(k.value)="" then
alert("请填写附件标题")
k.focus
exit sub
end if
end if
next
end if
'''''By Winnner 判断附件的大小''''''''''''''''''
tools.style.display="none"
frmxx.encoding = "multipart/form-data"
frmxx.action="msg_add_save.asp"
frmxx.submit
end sub
</script>
<SCRIPT LANGUAGE=javascript>
<!--
function dostr(s,l)
{
if (s.length-1<=l){
return s;
}
else
{
return(s.substr(0,l)+"...");
}
}
//-->
</SCRIPT>
<script language=vbscript>
<!--
function doselry
dim k,s
if doSelRYMti(frmxx.ygbhlb.value,k,s) then
frmxx.ygbhlb.value=k
jsrlb.innerHTML="<a title=""" & s & """>" & dostr(s,15) & "</a>"
end if
end function
//-->
</script>
<!--===========-BY winner 15:18 2006-3-22 增加附件的功能----->
<script language="vbscript">
function xzfj()
dim count_obj,tr_obj,td_obj,file_obj,form_obj,count,table_obj
dim button_obj,countview_obj
dim str1,str2
set form_obj=document.getElementById("frmxx")
set fj_obj=document.getElementById("td_fj")
if fj_obj.innertext="无附件" then
fj_obj.innertext=""
end if
set count_obj=document.getElementById("count_obj")
if (count_obj is nothing) then
set count_obj=document.createElement("input")
count_obj.type="hidden"
count_obj.id="count_obj"
count_obj.value=1
form_obj.appendChild(count_obj)
count=1
count_obj.value=1
else
set count_obj=document.getElementById("count_obj")
count=cint(count_obj.value)+1
count_obj.value=count
end if
set div_obj=document.createElement("div")
div_obj.id="div_"&cstr(count)
div_obj.align="center"
fj_obj.appendchild(div_obj)
str1=" 名称：<input type='file' name='fj"&count&"' size=20 class='input' id=fj'"&count&"'>"
str2="<br>说明：<input type='text' name='fjsm"&count&"' class='input' size=20 maxlength=255 id='fjsm"&count&"'>"
str3="<input type='button' class='button' value='删除' onclick='vbscript:delthis("+""""+div_obj.id+""""+")'>"
div_obj.innerHtml=str1+str2+str3
end function
function delthis(id)
dim child,parent
set child_t=document.getElementById(id)
if (child_t is nothing ) then
alert("对象为空")
else
call delmain_wer(child_t)
end if
set parent=document.getElementById("td_fj")
if parent.hasChildNodes() =false then
parent.innerText=""
end if
end function
function delmain_wer(obj)
dim length,i,tt
set tt=document.getElementById("table_obj")
if (obj.haschildNodes) then
length=obj.childNodes.length
for i=(length-1) to 0 step -1
call delmain_wer(obj.childNodes(i))
if obj.childNodes.length=0 then
obj.removeNode(false)
end if
next
else
obj.removeNode(false)
end if
end function
</script>
<!--===========-BY winner 15:18 2006-3-22 增加附件的功能----->
'=========msg_add_save.asp==========
<%@ Language=VBScript %>
<!-- #INCLUDE FILE="../Share/ConnectDB.asp" -->
<!-- #include file="..\share\pub_sendmsg.asp" -->
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
</head>
<%
Response.Expires=0
%>
<!-- BY Winner 10:57 2006-3-23 添加附件功能 ----------->
<%
function setNothing() '关闭对象
conn.RollBackTrans
set objUpload = Nothing
Conn.Close
set Conn = Nothing
%>
<script language="vbscript">
msgbox "异常错误，无法提交！",vbExclamation,"提示"
history.back(0)
</script>
<%
end function
%>
<%
Set objUpload = Server.CreateObject("LKOAAspcn.upload")
'设置文件大小，文件存储绝对路径
objupload.maxsize=100000000
objupload.Path= server.MapPath("../atthfiles/oa_message_fj") & "\"
objUpload.upload
%>
<!-- BY Winner 10:57 2006-3-23 添加附件功能 ----------->
<%
dim i,syglb,ayglb,rs,sygbh,sxxnr
sygbh=session("uYGBH")
set rs=server.CreateObject("adodb.recordset")
set rs2=server.CreateObject("adodb.recordset")
syglb=objUpload.Form("ygbhlb")
sxxnr=objUpload.Form("xxnr")
'-------把oamessage内容写入数据库暂不带附件------------------
if syglb<>"" then
conn.begintrans
sendmsg sygbh,syglb,sxxnr
conn.committrans
end if
'-------把oamessage内容写入数据库暂不带附件------------------
'=========================BY Winner 11:04 2006-3-23 start保存附件函数 ======================
function xzfj(allsendtime) '保存附件及附件记录
dim fjbh,fileldname,oldName,newName
for ii=0 to clng(objupload.count) - 1
fieldname = objUpload.FieldName(ii)
if objUpload.FileType(objUpload.FieldName(ii)) = "NonFileType" then
else
if objUpload.FileName(objUpload.FieldName(ii)) <> "" then
'-----------完成附件编号自动添加功能------------------
sql="select messagefjid from message_fj order by messagefjid desc" '得到附件编号
set rs=conn.execute(sql)
if not rs.eof and not rs.bof then
fjbh=rs("messagefjid")+1 '附件编号=最大的编号+1
else
fjbh=1 '如果为空附件编号==1
end if
rs.close
set rs=nothing
' response.write "fjbh="&fjbh
'-----------完成附件编号自动添加功能------------------
fjsm=constr1(objUpload.form(replace(fieldname,"fj","fjsm")))
oldName=objUpload.FileName(objUpload.FieldName(ii))
newName="oa_message_fj" & fjbh & "." & objUpload.FileType(objUpload.FieldName(ii))
'----------------------------上传文件过滤-start----------------------
Dim MyArray ,up
MyArray = Array("jpg","gif","doc","pdf","ppt","txt","xls","rar","swf","fla","zip","")
up=1
For I = Lbound(MyArray) to Ubound(MyArray)
if trim(Lcase(right(newName,3)))=MyArray(I) then
up=0
exit for
else
up=1
end if
Next
if up=1 then
%>
<script language="vbscript">
msgbox "文件格式错误！",vbInformation,"消息"
history.back(0)
</script>
<%
response.End()
else
up=1
end if
'----------------------------上传文件过滤----end-------------------
%>
<%
objupload.save objUpload.FieldName(ii),2,newName
if err<>0 then
call setnothing
Response.end
end if
sql="insert into message_fj([messagefjid],[messagesendtimeid],[fjsm],[fjyslj]) values("_
&fjbh&","&allsendtime&",'"&fjsm&"','"&newName&"')"
set rs=conn.execute(sql)
if err<>0 then
call setnothing
Response.end
end if
end if
end if
next
end function
'=========================BY Winner 11:04 2006-3-23 end保存附件函数 ======================
'----By Winner 11:46 2006-3-23在 (一次可以发多条。。对应fj中的id)--------------------
rs2.open "Select max(allsendtime) from oa_message",conn,1,1
dim allsendtime
allsendtime=clng(rs2(0))
rs2.Close
'----By Winner 11:46 2006-3-23 (一次可以发多条。。对应fj中的id)--------------------
call xzfj(allsendtime) '调用新增附件函数 传递变量是allsendtime 表示发送次数
set rs=nothing
conn.close
set conn=nothing
%>
<script language=vbscript>
<!--
msgbox "消息成功发出!",vbInformation,"提示"
parent.window.close
//-->
</script>
'===============pub_sendmsg.asp==========
<%
'sendmsg函数用来发送消息
'jsr传递消息接收人列表(员工编号,用逗号分开)(为空发送给所有用户)
'xxnr是消息的正文255字符之内
'fsr为消息发送人,为0则是系统消息,为-1则是定时提醒
function sendmsg(fsr,jsr,xxnr)
dim i,syglb,ayglb,rs,sygbh,sxxnr,rs1,rs2,sXXXH
sygbh=fsr
set rs=server.CreateObject("adodb.recordset")
set rs1=server.CreateObject("adodb.recordset")
set rs2=server.CreateObject("adodb.recordset")
syglb=jsr
sxxnr=xxnr
rs.open "select * from oa_message where 1>2",conn,3,2
if syglb<>"" then '接收人列表不为空时
'----By Winner 11:46 2006-3-23在循环外加一个控制总共发过多少次(一次可以发多条。。对应fj中的id)--------------------
rs2.open "Select max(allsendtime) from oa_message",conn,1,1
dim allsendtime
allsendtime=clng(rs2(0))+1
rs2.Close
'----By Winner 11:46 2006-3-23在循环外加一个控制总共发过多少次(一次可以发多条。。对应fj中的id)--------------------
ayglb=Split(syglb,",")
for i=0 to ubound(ayglb)
if trim(ayglb(i))<>"" then
sxxxh=1
'-------完成ID自动增加的功能------------
rs2.open "Select max(xxxh) from oa_message",conn,1,1
if not rs2.EOF then
if rs2(0) & ""<>"" then
sxxxh=clng(rs2(0))+1
end if
end if
rs2.Close
'-------完成ID自动增加的功能------------
rs.AddNew
rs("xxxh")=sXXXH '消息编号
rs("ygbh")=ayglb(i) '收信息员工的编号
rs("xxnr")=sxxnr '消息内容
rs("fsrbh")=sygbh '发送人编号
rs("xxfssj")=fd_a(now,"yyyy-mm-dd hh:nn:ss") '消息发送时间
rs("ydbz")="0"
rs("ydsj")=""
rs("bz")=""
rs("allsendtime")=allsendtime 'By winner 添加发送次的唯一标量
rs.Update
end if
next
else
rs1.open "select ygbh from rs_ygb where ryzt='0' or ryzt='2' ",conn,1,1 '找出所有在职员工的编号
do while not rs1.eof
sxxxh=1
'-------完成ID自动增加的功能------------
rs2.open "Select max(xxxh) from oa_message",conn,1,1
if not rs2.EOF then
if rs2(0) & ""<>"" then
sxxxh=clng(rs2(0))+1
end if
end if
rs2.Close
'-------完成ID自动增加的功能------------
rs.AddNew
rs("ygbh")=rs1("ygbh")
rs("xxxh")=sXXXH
rs("xxnr")=sxxnr
rs("fsrbh")=sygbh
rs("xxfssj")=fd_a(now,"yyyy-mm-dd hh:nn:ss")
rs("ydbz")="0"
rs("ydsj")=""
rs("bz")=""
rs.Update
rs1.movenext
loop
rs1.close
end if
rs.close
set rs=nothing
set rs1=nothing
set rs2=nothing
end function
function fd_a(s,sformat)
if not isdate(s) then
fd_a=s
exit function
end if
dim y4,y2,m2,m1,d2,d1,h2,h1,n2,n1,s2,s1
dim ss1,ss
ss1=cdate(s)
y4=year(ss1)
y2=right(y4,2)
m1=Month(ss1)
m2=string(2-len(cstr(month(ss1))),"0") & cstr(month(ss1))
d1=day(ss1)
d2=string(2-len(cstr(day(ss1))),"0") & cstr(day(ss1))
h1=Hour(ss1)
h2=string(2-len(cstr(hour(ss1))),"0") & cstr(hour(ss1))
n1=Minute(ss1)
n2=string(2-len(cstr(Minute(ss1))),"0") & cstr(Minute(ss1))
s1=Second(ss1)
s2=string(2-len(cstr(Second(ss1))),"0") & cstr(Second(ss1))
ss=replace(sformat,"yyyy",y4)
ss=replace(ss,"yy",y2)
ss=replace(ss,"mm",m2)
ss=replace(ss,"m",m1)
ss=replace(ss,"dd",d2)
ss=replace(ss,"d",d1)
ss=replace(ss,"hh",h2)
ss=replace(ss,"h",h1)
ss=replace(ss,"nn",n2)
ss=replace(ss,"n",n1)
ss=replace(ss,"ss",s2)
ss=replace(ss,"s",s1)
fd_a=ss
end function
%>
''''''''''''''''''''''''''''''''''pubfun_down_file.asp-------------------组件下载..还原上传文件名---------
调用方法 <a href="../../share/pubfun_down_file.asp?orgfile=<%=rs("taskfjoldname")%>&savefile=<%=fjlj%>" ><%=rtrim(rs("taskfjsm"))%></a>
<%@ Language = "VBScript" %>
<%
Response.Expires=-1
Response.Buffer=true
dim orgfile,savefile
orgfile = request("orgfile")
savefile = request("savefile")
if ucase(right(orgfile,4)) = ".GIF" or ucase(right(orgfile,4)) = ".JPG" THEN
'Response.AddHeader "Content-disposition","inline; filename=" & orgfile
'response.contenttype = "text/HTML"
%>
<html>
<head>
<meta name="VI60_defaultClientScript" content="VBScript">
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<body>
<IMG SRC="<%=savefile%>" BORDER=0>
</body>
</html>
<%
ELSE
Response.AddHeader "Content-disposition","attachment; filename=" & orgfile
response.contenttype = "text/text"
dim x,pathfile
set x=server.CreateObject("lkoaaspcn.clsDownloadFile")
pathfile = server.MapPath(savefile)
Response.BinaryWrite x.GetFileBinStream(pathfile)
'x.DownloadFile cstr(pathfile)
set x=nothing
END IF
'response.contenttype = "Application/msword"
%>