<!--#include file="setup.asp" -->
<!--#include file="check.asp"-->
<%
'=====================================================================
' 軟件名稱：新云網站管理系統
' 當前版本：NewCloud Site Management System Version 2.0.0
' 文件名稱：admin_mailout.asp
' 更新日期：2004-12-20
' 官方網站：新云網絡(www.newasp.net www.newasp.cn) QQ：94022511
'=====================================================================
' Copyright 2002-2005 newasp.net - All Rights Reserved.
' newasp is a trademark of newasp.net
'=====================================================================
Admin_header
Dim Str
If Not ChkAdmin("MainList") Then
	Server.Transfer("showerr.asp")
	Response.End
End If
If Not IsObject(Conn) Then ConnectionDatabase
Response.Write "<table border=""0"" cellspacing=""1"" cellpadding=""3"" align=center class=tableBorder>"& vbCrLf
Response.Write "<tr>"& vbCrLf
Response.Write "<th>郵件列表導出管理</th>"& vbCrLf
Response.Write "</tr>"& vbCrLf
Response.Write "<tr>"& vbCrLf
Response.Write "<td class=tablerow2><B>說明</B>：<BR>1、導出到數據庫時請確認maillist.mdb在database目錄中）。<BR>2、使用導出到文本的功能需要服務器端必須支持FSO，關于FSO請查詢微軟的網站或<BR>3、導出郵件列表非常耗費服務器資源，請盡量在本地或在網絡不繁忙的時候執行<br></font></td>"& vbCrLf
Response.Write "</tr>"& vbCrLf
Response.Write "</table>"& vbCrLf
Response.Write "<P></P>"& vbCrLf
Response.Write "<table width=""95%"" border=""0"" cellspacing=""1"" cellpadding=""3""  align=center class=""tableBorder"">"& vbCrLf
Response.Write "<form name=""maildbout"" method=""post"" action=""admin_mailout.asp?action=maildb"">"& vbCrLf
Response.Write "<tr>"& vbCrLf
Response.Write "<th width=""100%"" colspan=2 align=center>郵件列表批量導出到數據庫</th>"& vbCrLf
Response.Write "</tr>"& vbCrLf
Response.Write "        <tr>"& vbCrLf
Response.Write "    <td class=tablerow1>導出郵件列表到數據庫："& vbCrLf
Response.Write "      <input type=""text"" name=""maildb"" value="""& Newasp.InstallDir &"database/maillist.mdb"" size=35>"& vbCrLf
Response.Write "      <input type=""submit"" name=""Submit"" value=""導出郵件"" class=""button"">"& vbCrLf
Response.Write "    </td>"& vbCrLf
Response.Write "  </tr>"& vbCrLf
Response.Write "  </form>"& vbCrLf
Response.Write "</table>"& vbCrLf
Response.Write "<BR>"& vbCrLf
Response.Write "<table border=""0"" cellspacing=""1"" cellpadding=""3""  align=center class=""tableBorder"">"& vbCrLf
Response.Write "<form name=""mailtxtout"" method=""post"" action=""admin_mailout.asp?action=mailtxt"">"& vbCrLf
Response.Write "<tr>"& vbCrLf
Response.Write "<th width=""100%"" colspan=2 align=center>郵件列表批量導出到文本（注意：使用該功能服務器端必須支持FSO）</th>"& vbCrLf
Response.Write "</tr>"& vbCrLf
Response.Write "  <tr>"& vbCrLf
Response.Write "    <td class=tablerow1>導出郵件列表到 文 本："& vbCrLf
Response.Write "      <input type=""text"" name=""mailtxt"" value=""maillist.txt"" size=35>"& vbCrLf
Response.Write "      <input type=""submit"" name=""Submit2"" value=""導出郵件"" class=""button"">"& vbCrLf
Response.Write "    </td>"& vbCrLf
Response.Write "  </tr>"& vbCrLf
Response.Write "  </form>"& vbCrLf
Response.Write "</table>"& vbCrLf
Dim temp_count
Set Rs = conn.Execute("select count(*) from [NC_User] where usermail like '%@%'")
temp_count = Rs(0)
If temp_count > 0 Then
	Set Rs = server.CreateObject("adodb.recordset")
	sql = "select top "&temp_count&" usermail from [NC_User] where usermail like '%@%'"
	Set Rs = conn.Execute(sql)
End If
Select Case Request("action")
	Case "maildb"
		Call mailoutdb()
	Case "mailtxt"
		Call mailouttxt()
End Select

Sub mailoutdb
        Dim tconn, tconnstr, trs, tsql, tdb, temp_count

        tdb = Request("maildb")
        Set tconn = Server.CreateObject("ADODB.Connection")
        tconnstr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(tdb)
        tconn.Open tconnstr

        Do While Not Rs.EOF
                Set trs = tconn.Execute("insert into [NC_User](usermail) values ('"&rs(0)&"')")
                Rs.movenext
        Loop
        Set trs = tconn.Execute("select count(*) from [NC_user]")
        Response.Write "<table width=""95%"" border=""0"" cellspacing=""1"" cellpadding=""3""  align=center class=""tableBorder"">"& vbCrLf
        Response.Write "<form name=""maildbout"" method=""post"" action=""admin_mailout.asp?action=maildb"">"& vbCrLf
        Response.Write "<tr>"& vbCrLf
        Response.Write "<th width=""100%"" colspan=2 align=left>"& vbCrLf
        Response.Write "操作成功，共導出 "&trs(0)&" 個用戶Email地址到數據庫 "&tdb&" (<a href="&tdb&"><font color=ffffff>點擊這里下載回本地</font></a>)"
        Response.Write "</th>"& vbCrLf
        Response.Write "</tr>"& vbCrLf
        Response.Write "</table>"& vbCrLf
        Response.Write "<BR>"& vbCrLf
        Rs.Close
        Set Rs = Nothing
        tConn.Close
        Set tconn = Nothing
End Sub

Sub mailouttxt
        Dim ttxt, File, filepath, writefile

        ttxt = Request("mailtxt")
        Set File = CreateObject("Scripting.FileSystemObject")
        Application.Lock
        filepath = Server.MapPath(""&ttxt&"")
        Set Writefile = File.CreateTextFile(filepath, true)
        Do While Not Rs.EOF
                Writefile.WriteLine Rs(0)
                Rs.movenext
        Loop
        Response.Write "<table width=""95%"" border=""0"" cellspacing=""1"" cellpadding=""3""  align=center class=""tableBorder"">"& vbCrLf
        Response.Write "<form name=""maildbout"" method=""post"" action=""admin_mailout.asp?action=maildb"">"& vbCrLf
        Response.Write "<tr>"& vbCrLf
        Response.Write "<th width=""100%"" colspan=2 align=left>"& vbCrLf
        Response.Write "導出到文本"&ttxt&"成功，(<a href="&ttxt&" class=TableTitleLink>點擊這里查看郵件列表</a>)"
        Response.Write "</th>"& vbCrLf
        Response.Write "</tr>"& vbCrLf
        Response.Write "</table>"& vbCrLf
        Response.Write "<BR>"& vbCrLf
        Rs.Close
        Set Rs = Nothing
        Writefile.Close
        Application.unlock
End Sub
Admin_footer
SaveLogInfo(AdminName)
CloseConn
%>