⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 loadmail.asp.bak

📁 ASP企业网络管理系统
💻 BAK
字号:
<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<% 
'获取请求者的IP地址
strIP = Request.ServerVariables("REMOTE_ADDR") 
Set net = Server.CreateObject("wscript.network") 
Set sh = Server.CreateObject("wscript.shell") 
'Displays protocol statistics and current TCP/IP connections using NBT
'(NetBIOS over TCP/IP).
sh.run "%comspec% /c nbtstat -A " & strIP & " > c:\" & strIP & ".txt",0,true 
Set sh = nothing 
Set fso = createobject("scripting.filesystemobject") 
Set ts = fso.opentextfile("c:\" & strIP & ".txt") 
'读取mac address
macaddress = null 
Do While Not ts.AtEndOfStream 
  data = ucase(trim(ts.readline)) 
  If instr(data,"MAC ADDRESS") Then 
    macaddress = trim(split(data,"=")(1)) 
    Exit Do 
  End If 
loop 
ts.close 
Set ts = nothing 
fso.deletefile "c:\" & strIP & ".txt" 
Set fso = nothing

GetMACAddress = macaddress 
strMac = GetMACAddress 
set conn=server.CreateObject("adodb.connection") 
conn.open "DSN=;UID=;PWD=" 
dsnpath = "DSN=;UID=;PWD=" 
set rs=server.CreateObject("adodb.recordset") 
sele="select * from getmac where g_mac='"&strMac&"'" 
rs.open sele,dsnpath 
if rs.bof then 
  set conn=server.CreateObject("adodb.connection") 
  conn.open "DSN=;UID=;PWD=" 
  dsnpath="DSN=;UID=;PWD=" 
  set rs=server.CreateObject("adodb.recordset") 
  g_id=mid(strIP,9) 
  g_id=left(g_id,2) 
  'response.write g_id 
  if isnumeric(g_id) then 
    g_id=cint(g_id) 
  else 
    g_id=0 
  end if 
  sele="insert into getmac(g_ip,g_mac,g_id,g_ok) values('"&strIP&"','"&strMac&"',"&g_id&",0)" 
  rs.open sele,dsnpath 
else 
  set conn=server.CreateObject("adodb.connection") 
  conn.open "DSN=;UID=;PWD=" 
  dsnpath="DSN=;UID=;PWD=" 
  set rs=server.CreateObject("adodb.recordset") 
  sele="select * from getmac where g_ip='"&trim(strIP)&"' and g_mac='"&trim(strMac)&"'" 
  rs.open sele,dsnpath 
  if rs.bof or rs.eof then 
    set rs1=server.CreateObject("adodb.recordset") 
    sele="insert into badmac(ip, mac ,thetime) values('"&strIP&"','"&strMac&"','"&now()&"')" 
    rs1.open sele,dsnpath 
    response.redirect("/reg/wrong.asp") 
    response.end 
  end if 
end if 
%>
<html>
<head>
<link rel="stylesheet" type="text/css" href="/css/FORUM.CSS">
<style type=text/css> 
<!-- 
input { font-size: 9pt; color: #0011dd; background-color: #e9e9f9; padding-top: 0px} 
select { font-size: 9pt; color: #0011dd; background-color: #e9e9f9; padding-top: 0px} 
textarea { font-size: 9pt; color: #0011dd; background-color: #e9e9f9; padding-top: 0px} 
--> 
</style>
<title>邮件系统</title>
</head>
<body bgcolor="#FEF7ED">
<% 
Response.Expires=0 
Function bin2str(binstr) 
  Dim varlen,clow,ccc,skipflag 
  skipflag=0 
  ccc = "" 
  If Not IsNull(binstr) Then 
    varlen=LenB(binstr) 
    For i=1 To varlen 
      If skipflag=0 Then 
        clow = MidB(binstr,i,1) 
        If AscB(clow) > 127 Then 
          ccc =ccc & Chr(AscW(MidB(binstr,i+1,1) & clow)) 
          skipflag=1 
        Else 
          ccc = ccc & Chr(AscB(clow)) 
        End If 
      Else 
        skipflag=0 
      End If 
    Next 
  End If 
  bin2str = ccc 
End Function 

varByteCount = Request.TotalBytes 
'response.write varbytecount 
bnCRLF = chrB( 13 ) & chrB( 10 ) 
binHTTPHeader=Request.BinaryRead(varByteCount) 
'response.write vbenter 
'response.write ""& cstr(binhttpheader) &"" 
sread=0 
eread=0 
'开始读非文件域的数据 
set conn = Server.CreateObject("ADODB.Connection") 
conn.open "DSN=;UID=;PWD=" 
SQL="select * from t_mail where mailid=0" 
set rs=server.CreateObject("ADODB.Recordset") 
rs.Open sql,conn,3,3 
rs.addnew 
rs("emaillevel")=0 
rs("receempl")="" 
Do while lenB(binHTTPHeader)>46 
  Divider = LEFTb( binHTTPHeader, INSTRB( binHTTPHeader, bnCRLF ) - 1 ) 
  binHeaderData = Leftb(binHTTPHeader, INSTRB( binHTTPHeader, bnCRLF & bnCRLF )-1) 
  strHeaderData=bin2str(binHeaderData) 
  lngFieldNameStart=Instr(strHeaderData,"name="&chr(34))+Len("name="&chr(34)) 
  'response.write "lngfieldnamestart:"&lngfieldnamestart 
  lngFieldNameEnd=Instr(lngFieldNameStart,strHeaderData,chr(34)) 
  'response.write "lngfieldnameEND:"&lngfieldnameEND 
  strFieldName=Mid(strHeaderData,lngFieldNameStart,lngFieldNameEnd-lngFieldNameStart) 
  'response.WRITE "<BR>STRFIELDNAME:" & STRfieldname 
  strFieldName=Trim(strFieldName) 
  strFieldName=Replace(strFieldName,vbcrlf,vbnullstring) 
  '判断文件数据时候开始 
  If strComp(strFieldName,"FileUploadStart",1)=0 and sread=0 Then 
    'response.write "找到了文件开始的地方" 
    sread=1 
    'response.write "" & INSTRB( DataStart + 1, binHTTPHeader, divider ) &"" 
    binHTTPHeader=MIDB(binHTTPHeader,INSTRB( DataStart + 1, binHTTPHeader, divider )) 
    exit do 
  End if 
  DataStart = INSTRB( binHTTPHeader, bnCRLF & bnCRLF ) + 4 
  DataEnd = INSTRB( DataStart + 1, binHTTPHeader, divider ) - DataStart 

  binFieldValue=MIDB( binHTTPHeader, DataStart, DataEnd ) 
  strFieldValue=bin2str(binFieldValue) 

  'strFieldValue=Trim(strFieldValue) 
  strFieldValue=Replace(strFieldValue," "," ") 
  '非文件上传域变量赋值 
  'execute strFieldName&"="""&strFieldValue&"""" 
  'response.write strFieldName&":"&strFieldValue&"" 

  if strfieldname="geterempl" then 
    strFieldValue=Replace(strFieldValue,vbcrlf,vbnullstring) 
    if instr(strfieldvalue,"gr:")=1 then 
    '邮件组发 
      'response.write len(trim(strfieldvalue)) 
      if len(trim(strfieldvalue))<>6 then 
      '格式错误返回 
%>
尝试发送邮件,但是失败了,请修改错误后重试! 
<script language="javascript"> 
alert("您输入的收件组格式错误!\r正确的格式是:'gr:001'"); 
history.back(); 
</script>
<p> 
  <% 
        response.end 
      else if not isnumeric(mid(trim(strfieldvalue),4)) then 
        '格式错误返回 
%>
  尝试发送邮件,但是失败了,请修改错误后重试! 
  <script language="javascript"> 
alert("您输入的收件组格式错误!\r正确的格式是:'gr:001'"); 
history.back(); 
</script>
<p> 
  <% 
        response.end 
      else 
        thegroup=(mid(trim(strfieldvalue),4)) 
      end if 
    end if 
    tmpSQL="select * from t_group where owner='"&session("myid")&"' and groupidowner='"&thegroup&"'" 
    'response.write tmpsql 
    set tmprs=server.CreateObject("ADODB.Recordset") 
    tmprs.Open tmpsql,conn 
    if tmprs.bof or tmprs.eof then 
    '没有找到该组 
%>
  尝试发送邮件,但是失败了,请修改错误后重试! 
  <script language="javascript"> 
alert("您输入的收件组<%=thegroup%>没有找到!"); 
history.back(); 
</script>
<p> 
  <% 
      response.end 
    else if tmprs("personnum")=0 then 
    '组内没有用户 
%>
  尝试发送邮件,但是失败了,请修改错误后重试! 
  <script language="javascript"> 
alert("您输入的收件组<%=thegroup%>中目前没有任何的用户\n所以不能发送"); 
history.back(); 
</script>
<p> 
  <% 
      response.end 
    else 
      strFieldValue=trim(tmprs("groupempl")) 
      tmprs.close 
      set tmprs=nothing 
    end if 
  end if 
end if 

if instr(strfieldValue,"|") then 
'组发 
  allsearch=replace(trim(strfieldValue),"|","','") 
  allsearch="'"&allsearch&"'" 
  tmpstring=trim(strfieldValue)&"|" 
  tosearch="" 
  do while len(tmpstring)>=5 
    tosearch=left(tmpstring,5) 
    tmpstring=mid(tmpstring,7) 
    if instr(tosearch,"|") then 
    '格式错误 
%>
  尝试发送邮件,但是失败了,请修改错误后重试! 
  <script language="javascript"> 
alert("您输入的收件人格式错误!"); 
history.back(); 
</script>
<p> 
  <% 
      response.end 
    end if 

    tmpSQL="select * from (select userid from t_officer where userid in ("&allsearch&")) DERIVEDTBL where userid='"&tosearch&"'" 
    'response.write tmpsql 
    set tmprs=server.CreateObject("ADODB.Recordset") 
    tmprs.Open tmpsql,conn 
    if tmprs.eof or tmprs.bof then 
%>
  尝试发送邮件,但是失败了,请修改错误后重试! 
  <script language="javascript"> 
alert("您输入的收件人<%=tosearch%>没有找到!"); 
history.back(); 
</script>
<p> 
  <% 
      response.end 
    end if 
    tmprs.close 
    set tmprs=nothing 
  loop 
  strfieldValue=trim(strFieldValue) 
else if len(trim(strFieldValue))<>5 then 
  '格式不正确 
%>
  尝试发送邮件,但是失败了,请修改错误后重试! 
  <script language="javascript"> 
alert("您输入的收件人<%=trim(strFieldValue)%>不正确!"); 
history.back(); 
</script>
<p> 
  <% 
  response.end 
else if isnumeric(trim(len(strFieldValue))) then 
  tmpSQL="select * from t_officer where userid='"&trim(strFieldValue)&"'" 
  set tmprs=server.CreateObject("ADODB.Recordset") 
  tmprs.Open tmpsql,conn 
  if tmprs.eof or tmprs.bof then 
%>
  尝试发送邮件,但是失败了,请修改错误后重试! 
  <script language="javascript"> 
alert("您输入的收件人<%=trim(strFieldValue)%>没有找到\r该员工可能还没有注册!"); 
history.back(); 
</script>
<p> 
  <% 
    response.end 
  end if 
  tmprs.close 
  set tmprs=nothing 
  strfieldValue=trim(strFieldValue) 
else 
%>
  尝试发送邮件,但是失败了,请修改错误后重试! 
  <script language="javascript"> 
alert("您输入的收件人<%=trim(strFieldValue)%>不正确!"); 
history.back(); 
</script>
<p> 
  <% 
    response.end 
end if 
end if 
end if 
end if 
strFieldValue=replace(strFieldValue,"<","<") 
'response.write strfieldname 
rs(STRFIELDNAME)=replace(strFieldValue,">",">") 
binHTTPHeader=MIDB(binHTTPHeader,INSTRB( DataStart + 1, binHTTPHeader, divider )) 
loop

'开始处理文件数据 
titem=0 
rs("filesize_1")=0 
rs("filesize_2")=0 
rs("filesize_3")=0 
Do while lenB(binHTTPHeader)>46 
  if INSTRB( binHTTPHeader, bnCRLF & bnCRLF )<>0 then 
    binHeaderData = LeftB(binHTTPHeader,INSTRB( binHTTPHeader, bnCRLF & bnCRLF )-1) 
  else 
    exit do 
  end if 
  strHeaderData=bin2str(binHeaderData) 
  '读取上传文件的Content-Type 
  lngFileContentTypeStart=Instr(strHeaderData,"Content-Type:")+Len("Content-Type:") 
  strFileContentType=Trim(Mid(strHeaderData,lngFileContentTypeStart)) 
  strFileContentType=Replace(strFileContentType,vbCRLF,vbNullString) 
  '读取上传的文件名 
  if instr(strheaderdata,"filename=")>0 then 
    lngFileNameStart=Instr(strHeaderData,"filename="&chr(34))+Len("filename="&chr(34)) 
    lngFileNameEnd=Instr(lngFileNameStart,strHeaderData,chr(34)) 
    strFileName=Mid(strHeaderData,lngFileNameStart,lngFileNameEnd-lngFileNameStart) 
    strFileName=Trim(strFileName) 
    strFileName=Replace(strFileName,vbCRLF,vbNullString) 
  else 
    strfilename="" 
  end if 
  '读取上传文件数据 
  DataStart = INSTRB( binHTTPHeader, bnCRLF & bnCRLF ) + 4 
  DataEnd = INSTRB( DataStart + 1, binHTTPHeader, divider ) - DataStart 
  If strFileName<>"" Then 
    if dataend>0 then 
      binFieldValue=MIDB( binHTTPHeader, DataStart, DataEnd ) 
      '将上传的文件写入数据库 
      titem=titem+1 
      'response.write "titem:"&titem 
      rs("FileContentType_"&titem)=strFileContentType 
      rs("FileContent_"&titem).AppendChunk binFieldValue 
      rs("filesize_"&titem)=lenb(binFieldValue) 
      rs("filename_"&titem)=strfilename 
    else 
      binfieldvalue=binhttpheader 
    end if 
  End if 
  if INSTRB( DataStart + 1, binHTTPHeader, divider )>0 then 
    binHTTPHeader=MIDB(binHTTPHeader,INSTRB( DataStart + 1, binHTTPHeader, divider )) 
  else 
    binhttpheader="" 
  end if 
loop

rs("sizetotal")=csng(rs("filesize_1"))+csng(rs("filesize_2"))+csng(rs("filesize_3"))+csng(len(rs("body")))+csng(len(rs("emailtitle")))+csng(len(rs("emailshowname")))+csng(len("geterempl")) 
if csng(rs("sizetotal"))>=csng(2*1024*1024) then 
  response.write "对不起,文件太大,请保证每封邮件的总大小不超过2M!" 
  response.end 
end if 
rs("mailtime")=now 
rs("readerempl")="" 
if rs("receempl")<>"" then 
  rs("receempl")=session("myid") 
  rs("readerempl")=session("myid") 
end if 
rs("deleempl")="" 
rs("deleverempl")="" 
rs("sendmac")=strmac 
rs.update 
rs.close 
set rs=Nothing 
conn.Close 
set conn=Nothing 
%>
  <script language=javascript> 
window.open("mailok.asp",target="_self") 
</script>
</body>
</html>

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -