10 luglio 2004 alle 15:42:43 stesso problema dei primi due : nel passaggio a 2003 il mod email nel forum non funzia perche settato a CDONTS Il problema è nel post-inc:
<% ' ************************************************************************ ' * ASP-Nuke: Free web portal in ASP * ' ************************************************************************ ' * Copyright (c) 2002-2003 by Gaetan Bouveret (webmaster@asp-nuke.com) * ' * http://www.asp-nuke.com * ' * * ' * This program is free software. You can redistribute it and/or modify * ' * it under the terms of the GNU General Public License as published by * ' * the Free Software Foundation; either version 2 of the License, or * ' * (at your option) any later version. * ' * * ' ************************************************************************ ' --------- Modifiche --------------------- ' Mod: Email nel Forum ' Autore: Settimio TRINCHERA ' Email: webmaster@stzone.it ' Sito: http://www.stzone.it ' Data: 01/11/2003 ' ------------------------------------------- %> <% Function PostMessage(forum, section, parent, feeling, title, message, valide, signature, smileys, persistant, sUserIP) Dim Conn, Rs, rSQL, iLastPostsID, sCurrentDate
Set Conn = DBConnexion(DB_FORUM) rSQL = "SELECT MAX(PostID) FROM Posts" Set Rs = DBRecordSet(Conn, rSQL) sCurrentDate = DateTimeToString(Now)
If Not Rs.EOF Then iLastPostsID = Rs(0) If isNull(iLastPostsID) Then iLastPostsID = 1 Else iLastPostsID = iLastPostsID + 1 End If
If parent = "" or parent = 0 Then parent = iLastPostsID Else rSQL = "SELECT PostTitle FROM Posts WHERE PostID=" & parent Set Rs = DBRecordSet(Conn, rSQL) If Not Rs.EOF Then title = GetTranslation("LANG_ANSWER_POST") & " : " & Rs(0) End If
rSQL = "UPDATE Users SET UserPosts=UserPosts+1 WHERE UserLogin LIKE '" & SQLEncrypt(sPseudo) & "'" DBExecute Conn, rSQL
' ---------------------------------------------------------------------------------------- ' Invia email al webmaster e ai partecipanti la specifica discussione
Dim msg, myMail, sUser, sMailList, Conn1, Rs1, rSQL1
Set Conn = DBConnexion(DB_FORUM) rSQL = "SELECT DISTINCT PostUser FROM Posts WHERE PostParent=" & parent Set Rs = DBRecordSet(Conn, rSQL) If Not Rs.EOF Then While Not Rs.EOF sUser = Rs("PostUser") Set Conn1 = DBConnexion(DB_MAIN) rSQL1 = "SELECT uEMail FROM Users WHERE uLogin='" & sUser & "'" Set Rs1 = DBRecordSet(Conn1, rSQL1) If Not Rs1.EOF Then While Not Rs1.EOF sMailList = sMailList & Rs1("uEMail") & ";" Rs1.MoveNext WEnd End IF Rs.MoveNext WEnd End IF
sSticked = "" If Parent <> "" and Parent <> 0 Then rSQL = "SELECT PostTitle, PostSticked FROM Posts WHERE PostID=PostParent AND PostID=" & Parent Set oRs = DBRecordSet(oCn, rSQL) sTitle = GetTranslation("LANG_ANSWER_POST") & " : " & CodeMessage(oRs("PostTitle"), True) If oRs("PostSticked").Value Then sSticked = "1" Set oRs = Nothing Else sTitle = GetTranslation("LANG_NEW_SUBJECT") End If
iLine = 1 If Parent = "" or Parent = 0 Then Response.Write " <tr class=""tableline" & iLine & """>" & vbCRLF Response.Write " <td width=""100"">" & GetTranslation("LANG_TITLE") & "</td>" & vbCRLF Response.Write " <td><input name=""titre"" size=""50"" class=""cell""></td>" & vbCRLF Response.Write " </tr>" & vbCRLF
iLine = 2 Else Response.Write "<input name=""titre"" type=""hidden"" value="""">" & vbCRLF End If
rSQL = "SELECT * FROM Feelings ORDER BY FeelingID" Set oRs = DBRecordSet(oCn, rSQL) If Not oRs.EOF Then Response.Write " <tr class=""tableline" & iLine & """>" & vbCRLF Response.Write " <td width=""100"">" & GetTranslation("LANG_HUMOR") & "</td>" & vbCRLF Response.Write " <td>" & vbCRLF
X = 0 iLine = 1 + ((iLine-1) XOr 1)
While Not oRs.EOF Response.Write " <input name=""humeur"" type=""radio"" value=""" & oRs("FeelingID") & """" If X = 0 Then Response.Write " checked" Response.Write "><img src=""" & FeelingsPath & oRs("FeelingPath") & """ border=""0""> " & vbCRLF X = X + 1 If X mod 8 = 0 Then Response.Write "<br>" & vbCRLF oRs.MoveNext WEnd
Response.Write " </td>" & vbCRLF Response.Write " </tr>" & vbCRLF End If Set oRs = Nothing
If Parent <> "" and Parent <> 0 Then rSQL = "SELECT TOP 1 PostTitle, PostUser, PostMessage FROM Posts WHERE PostParent=" & Parent & " AND PostValid=1 ORDER BY PostDate DESC" Set oRs = DBRecordSet(oCn, rSQL) If Not oRs.EOF Then CreateTopTable "PreviewOldMessage", GetTranslation("LANG_POST") & " - " & GetTranslation("LANG_PREVIEW") Response.Write GLOBAL_SITE_SUBTABLE & vbCRLF Response.Write " <tr class=""tableline1"">" & vbCRLF Response.Write " <td width=""120"">" & GetTranslation("LANG_TITLE") & "</td>" & vbCRLF Response.Write " <td>" & CodeMessage(oRs("PostTitle"), True) & "<td>" & vbCRLF Response.Write " </tr>" & vbCRLF Response.Write " <tr class=""tableline2"">" & vbCRLF Response.Write " <td>" & GetTranslation("LANG_AUTHOR") & "</td>" & vbCRLF Response.Write " <td>" & Server.HTMLEncode(oRs("PostUser")) & "<td>" & vbCRLF Response.Write " </tr>" & vbCRLF Response.Write " <tr class=""tableline1"">" & vbCRLF Response.Write " <td valign=""top"">" & GetTranslation("LANG_MESSAGE") & "</td>" & vbCRLF Response.Write " <td>" & CodeMessage(oRs("PostMessage"), True) & "<td>" & vbCRLF Response.Write " </tr>" & vbCRLF Response.Write "</table>" & vbCRLF CreateBottomTable "" End If Set oRs = Nothing End If
oCn.Close Set oCn = Nothing Set oRs = Nothing End Sub
Sub DisplayPreviewMessage(forum, section, parent) Dim oCn, oCn2, oRs, rSQL, bDisplaySmileys, bDisplaySignature
If Request.Form("smileys") <> "" Then bDisplaySmileys = True Else bDisplaySmileys = False End If If Request.Form("signature") <> "" Then bDisplaySignature = True Else bDisplaySignature = False End If
oCn.close Set oCn = Nothing Set oRs = Nothing End Sub
Sub DoPost() Dim iHumor, sTitle, sMessage, sSignature, bValid, bSignature, bSmileys, bSticked, iNbPages, iNbPosts Dim Conn, Rs, rSQL
iHumor = Request.Form("humeur") sTitle =Request.Form("titre") sMessage = Request.Form("message") If Request.Form("signature") <> "" Then bSignature = "1" Else bSignature = "0" End If If Request.Form("smileys") <> "" Then bSmileys = "1" Else bSmileys = "0" End If If Request.Form("sticked") <> "" Then bSticked = "1" Else bSticked = "0" End If
Set Conn = DBConnexion(DB_FORUM) rSQL = "SELECT SectionModerated FROM Sections WHERE SectionID=" & mySection Set Rs = DBRecordSet(Conn, rSQL) If Not Rs.EOF Then If Rs(0) Then bValid = "0" Else bValid = "1" End If End If
If myPost = 0 or myPost = "" Then If PostMessage(myForum, mySection, myPost, iHumor, sTitle, sMessage, bValid, bSignature, bSmileys, bSticked, sIP) Then CreateTopTable "Post", GetTranslation("LANG_POST") & " - " & GetTranslation("LANG_ADD_SUCCESS") Response.Write "<a href=""Forum.asp?forum=" & myForum & "§ion=" & mySection & """>" & GetTranslation("LANG_BACK") & " - " & GetTranslation("LANG_SECTION") & "</a>" rSQL = "SELECT TOP 1 PostID FROM Posts WHERE PostSection=" & mySection & " AND PostUser='" & SQLEncrypt(sPseudo) & "' AND PostParent=PostID ORDER BY PostDate DESC" Set Rs = DBRecordSet(Conn, rSQL) If Not Rs.EOF Then Response.Write "<br><a href=""Forum.asp?forum=" & myForum & "§ion=" & mySection & "&post=" & Rs(0) & """>" & GetTranslation("LANG_BACK") & " - " & GetTranslation("LANG_POST") & "</a>" & vbCRLF CreateBottomTable "" Else CreateTable "Post", GetTranslation("LANG_POST") & " - " & GetTranslation("LANG_ADD_ERROR"), "<a href=""Forum.asp?forum=" & myForum & "§ion=" & mySection & "&post=" & myPost & """>" & GetTranslation("LANG_BACK") & "</a>", "" End If Else If PostMessage(myForum, mySection, myPost, iHumor, sTitle, sMessage, bValid, bSignature, bSmileys, bSticked, sIP) Then CreateTopTable "Post", GetTranslation("LANG_POST") & " - " & GetTranslation("LANG_ADD_SUCCESS") Response.Write "<a href=""Forum.asp?forum=" & myForum & "§ion=" & mySection & """>" & GetTranslation("LANG_BACK") & " - " & GetTranslation("LANG_SECTION") & "</a>" & vbCRLF rSQL = "SELECT Count(PostID) FROM Posts WHERE PostSection=" & mySection & " AND PostParent=" & myPost Set Rs = DBRecordSet(Conn, rSQL) iNbPosts = Rs(0) If iNbPosts > FORUM_MAX_THREADS Then iNbPages = iNbPostsFORUM_MAX_THREADS If (iNbPosts+1) mod FORUM_MAX_THREADS <> 0 Then iNbPages = iNbPages + 1 Response.Write "<br><a href=""Forum.asp?forum=" & myForum & "§ion=" & mySection & "&post=" & myPost & "&page=" & iNbPages & """>" & GetTranslation("LANG_BACK") & " - " & GetTranslation("LANG_POST") & "</a>" & vbCRLF Else Response.Write "<br><a href=""Forum.asp?forum=" & myForum & "§ion=" & mySection & "&post=" & myPost & """>" & GetTranslation("LANG_BACK") & " - " & GetTranslation("LANG_POST") & "</a>" & vbCRLF End If CreateBottomTable "" Else CreateTable "Post", GetTranslation("LANG_POST") & " - " & GetTranslation("LANG_ADD_ERROR"), "<a href=""Forum.asp?forum=" & myForum & "§ion=" & mySection & "&post=" & myPost & """>" & GetTranslation("LANG_BACK") & "</a>", "" End If End If
Conn.Close Set Conn = Nothing Set Rs = Nothing End Sub %>
08 agosto 2004 alle 20:27:41 io ho modificato così, funziona tutto tranne che mi arriva in formato txt per vedere il formato html devo inserirlo in un editor, eppure ricevo tranquillamente email in html da altri siti, di sicuro ho sbagliato qualcosa, vi mando il file modificato che comunque funziona.
Set myMail = CreateObject("CDO.Message") myMail.From = "" & GLOBAL_SITE_EMAIL & "" myMail.To = "" & GLOBAL_SITE_EMAIL & "" If bAcceptEMailForum Then myMail.BCc = "" & sMailList & "" myMail.Subject = GetTranslation("LANG_POST_NEW") & " di " & GLOBAL_SITE_NAME myMail.TextBody = msg myMail.Fields("urn:schemas:httpmail:importance").Value = 2 myMail.Fields.Update() myMail.Send msg="" Set myMail = Nothing
Conn1.Close Set Conn1 = Nothing Set Rs1 = Nothing ' ----------------------------------------------------------------------------------------
se qualche guru puo dirmi se c'è un errore lo ringrazio anticipatamente. ciao a tutti.
08 agosto 2004 alle 20:56:24 Per inviare mail in formato html devi riempire il campo myMail.HTMLBody al posto di myMail.TextBody. Ciao
--------------- development@aspnuke.it
eguseo Eliminato
0 Discussione
08 agosto 2004 alle 21:09:14 Fatto adesso funziona bene tutto, se era attiva questa funzione nel forum avrei letto la tua risposta e forse avrei fatto prima Emu grazie della risposta comunque. ecco il codice per chi ne ha bisogno.
If bAcceptEMailForum Then Set myMail = CreateObject("CDO.Message") myMail.From = "" & GLOBAL_SITE_EMAIL & "" myMail.To = "" & GLOBAL_SITE_EMAIL & "" myMail.BCc = "" & sMailList & "" myMail.Subject = GetTranslation("LANG_POST_NEW") & " di " & GLOBAL_SITE_NAME myMail.HtmlBody = msg 'myMail.MailFormat = 0 'myMail.Body = msg myMail.Fields("urn:schemas:httpmail:importance").Value = 2 myMail.Fields.Update() myMail.Send msg="" Set myMail = Nothing End If
ciao
Log in
Cerca
Sostieni AspNuke
Un piccolo gesto per aiutarci a mantenere AspNuke.it online
Promo
MusicWebItalia.it Video Testi Traduzioni Spot Colonne sonore Accordi e Spartiti gratis.
Visitatori
Visitatori Correnti : 212 Membri : 0
Anna
Iscritti
Utenti: 18940
Ultimo iscritto : glauco Lista iscritti Messaggi privati: 3373Commenti: 2210Immagini: 39Downloads: 144Articoli: 49Pagine: 101Siti web: 558Notizie: 180Sondaggi: 11Preferiti: 5688358Post sui forum: 51195Libro degli ospiti: 4Eventi: 7
Anna
Versione stampabile | Questa pagina è stata eseguita in 0,1679688 secondi.
MODULI AGGIUNTIVI
email nel forum passaggio a cdosys
10 luglio 2004 alle 15:42:43 
