Jag jobbar med en sida på vilken det skall finnas ett internt mailsystem (community mail). På en sida kan man även lägga till användare som vänner eller som ovänner. Väljer man att lägga till en användare som vän eller ovän så läggs det till en ny post i tabellen relationer i MySQL-databasen. Här är ett exempel: Vill inte att textfälten skall vara i samma dokument som det dokument som skall kolla om någon av de man vill skicka till är ovän med en. Det är dock helt ok att samma dokument som kollar om någon av dem man vill skicka till är ovän med en lägger till i databasen och skriver ut resultatet på sidan. > Jo det jag menar är att i det exempel du gjort så är textfälten i vilka användaren som skriver mailet skriver vad den nu vill skriva och även väljer vem den vill skicka till i samma .asp-fil som koallar om de man valt att skicka till är ovän med en. Så vill jag och kan jag inte ha det. Jag har redan en .asp-fil (eller dokument som jag kallade det i mitt förra inlägg) i vilket jag har textfält från när man sedan på denna sida klickar på "skicka" så skall man komma till den .asp-sidan som kollar om det är någon av dem man skickar till som har en som ovän. Det du beskriver räcker inte som underlag att arbeta med. Skicka med källkoden för dina sidor. Kan inte hjälpa dig annars. Jag förstår. Jag tycker det är FEL att dela upp funktiuonen på flera sidor. ReDirect belastra server och klient i onödan och ger längre svarstid. Jag ser ingen fördel utan bara nackdeler med detta tillväga gångs sätt. Får följande fel när jag testade din kod: Skriv istället: Japp det funkade men då kom detta upp: ...har verkligen ingen koll ur jag fixar ovanstående fel. Testa att ändra dim-satsen, i början av koden, för Recivers till: Ok. Skickar du med ett id i din Querystring? Kan vara så att WriteReciverList inte kan hantera en tom array. Jo det gör jag Detta hunkar. Men har då testat mot Access. Vi får se om MySQL klarar av frågan. Fungerar fram tills jag klickar på "Skicka mail". *Ler* Testkört det hela nu och det verkar fungera. Aj då. Funnit några buggar. Är i skolan så jag kan inte felsöka. Du kan testa följande kod: Ok nu är första buggen fixad, tack. Den andra buggen finns dock kvar. Tror jag fixat till det nu: Blev en del fel med den nya koden. Testa med: Verkar fungera nu, TACK!!!Blocka internmail om den man skickar till har på block-lista
Så här ser tabellen relationer ut:
relationer.id - medlemms-id för den som lägger till relation
relationer.person - vilken relationen är till
relationer.typ - om vän eller ovän
Det är när jag skall börja mixtra med intern-mail-funktionen som problem uppstår.
De användare som man har som ovänner skall inte kunna skriva mail till en, de skall altså blockas.
Grejen är också den att man skall kunna skicka mail till flera medlemmar samtidigt.
Så Request.Form("NameList") som jag kallar den listan där man väljer vilka man skall skicka till kan ha flera medlemms-id i sig och alltså ha ett värde som kan se ut som detta:
1, 23, 7, 9
Så vad jag behöver är alltså en kod som kollar om det är någon av användarna som man försöker skicka mail till som har en som ovän och som sedan skickar iväg mailet till dem andra som har en vän-relation med en eller ingen relation alls.
Jag har hittat en kod på nätet som jag försökt använda mig av men jag får den inte att fungera.
Slutligen vill jag att man skall skickas till en sida där jag skall skriva ut vilka mailet inte har kunnat skickas till på grund utav att de hade en som ovän, därav denna kod på slutet:
Response.Redirect "mail_kolla.asp?NotSentTo='" & Blocked_Users&""
Så här ser koden (som jag inte får att fungera) ut :
<%
Dim strReplyTo
Dim arrReplyTo
Dim I
Session("Mail_NewMail_Namelist")=Request.Form("NameList")
Session("Mail_NewMail_Subject")=Request.Form("Mail_Subject")
Session("Mail_NewMail_Status")=Request.Form("Mail_Status")
Session("Mail_NewMail_Message")=Request.Form("Mail_Message")
' #### BEGIN ## Find selected users and check if they have the current user on the blocked list ####
Accepted_Users=""
Blocked_Users=""
Set rs = Server.CreateObject("ADODB.RecordSet")
SQL_Str="SELECT id, person, typ FROM relationer WHERE person IN ("&Request.Form("NameList")
strDSN = "DRIVER={MySQL};DATABASE=hemligt"
rs.Open SQL_Str, strDSN, 1, 1
If Not rs.EOF Then
alldata=rs.getrows
rs.close
Set rs=nothing
numcols=ubound(alldata,1)
numrows=ubound(alldata,2)
For rowcounter=0 TO numrows
Str_id=alldata(0,rowcounter)
Str_person=","&alldata(1,rowcounter)&","
If InStr(Str_person,","&Str_id&",")<>0 Then
Blocked_Users=Blocked_Users&Str_id&","
else
Accepted_Users=Accepted_Users&Str_id&","
end if
Next
else
rs.close
Set rs=nothing
end if
If Not Accepted_Users="" Then Accepted_Users=Left(Accepted_Users,Len(Accepted_Users)-1) end if
If Not Blocked_Users="" Then Blocked_Users=Left(Blocked_Users,Len(Blocked_Users)-1) end if
' #### BEGIN ## Find selected users and check if they have the current user on the blocked list ####
' #### BEGIN ## Send mail to those users who doesn't have current user on blocked list ####
If Not Accepted_Users="" Then
arrReplyTo = Split(Accepted_Users, ",", -1, 1)
For I = LBound(arrReplyTo) To UBound(arrReplyTo)
Set rs = Server.CreateObject("ADODB.Recordset")
strDSN = "DRIVER={MySQL};DATABASE=hemligt"
rs.Open "mails", strDSN, 3, 4
rs.AddNew
rs("Receiver_ID") = arrReplyTo(I)
rs("Sender_ID") = Session("id")
rs("Status") = Session("Mail_NewMail_Status")
rs("Sendt_Date_Time") = FormatDateTime(Date(), 0) & " " & FormatDateTime(Time(), 3)
rs("Folder") = 1
rs("Subject") = Session("Mail_NewMail_Subject")
rs("Message") = Session("Mail_OrginalMessage")
rs.UpdateBatch
rs.close
set rs=nothing
Next
end if
' #### BEGIN ## Send mail to those users who doesn't have current user on blocked list ####
Session("Mail_NewMail_Subject")=""
Session("Mail_NewMail_Status")=""
Session("Mail_OrginalMessage")=""
Response.Redirect "mail_kolla.asp?NotSentTo='" & Blocked_Users&""
%>Sv: Blocka internmail om den man skickar till har på block-lista
<code>
<%
Function SQLText(Value)
If Len(Value) > 0 Then
SQLText = """" & Replace(Value, """", """""") & """"
Else
SQLText = "Null"
End If
End Function
Function SQLINText(Value)
Dim vTemp
For Each vTemp In Value
SQLINText = SQLINText & ", " & SQLText(Trim(vTemp))
Next
SQLINText = Mid(SQLINText, 3)
End Function
Sub WriteHead(Title)
Response.Write "<HTML>" & vbCrLf
Response.Write "<HEAD>" & vbCrLf
Response.Write "<META http-equiv=Content-Type content=""text/html; charset=windows-1252"" />" & vbCrLf
Response.Write "<TITLE>Mail</TITLE>" & vbCrLf
Response.Write "</HEAD>" & vbCrLf
Response.Write "<BODY lang=SV>" & vbCrLf
Response.Write "<FORM method=""post"">" & vbCrLf
End Sub
Sub WriteMessageForm(Recipients, Subject, Body)
Response.Write "<TABLE width=""100%"" height=""100%"">" & vbCrLf
Response.Write "<TR>" & vbCrLf
Response.Write "<TD valign=top>Recipients:</TD>" & vbCrLf
Response.Write "<TD><INPUT type=""text"" name=""recipients"" value=""" & Server.HTMLEncode(Recipients) & """ width=""100%""></TD>" & vbCrLf
Response.Write "</TR>" & vbCrLf
Response.Write "<TR>" & vbCrLf
Response.Write "<TD valign="top">Subject:</TD>" & vbCrLf
Response.Write "<TD><INPUT type=""text"" name=""subject"" value=""" & Server.HTMLEncode(Subject) & """ width=""100%""></TD>" & vbCrLf
Response.Write "</TR>" & vbCrLf
Response.Write "<TR>" & vbCrLf
Response.Write "<TD colspan=""2""><TEXTAREA name=""body"" width=""100%"" height=""100%""></TEXTAREA></TD>" & vbCrLf
Response.Write "</TR>" & vbCrLf
Response.Write "</TABLE>" & vbCrLf
Response.Write "<INPUT type=""submit"" name=""action"" value=""Send"">" & vbCrLf
End Sub
Sub WriteFoot()
Response.Write "</FORM>" & vbCrLf
Response.Write "</BODY>" & vbCrLf
Response.Write "</HTML>" & vbCrLf
End Sub
Sub Main()
Dim rs
Dim con
Dim strRecipients
Dim strSubject
Dim strBody
Dim lngCount
Dim strIN
Dim strNames
Dim strBlocked
Dim strNotFound
Dim strErrMessage
Dim vTemp
Const adOpenStatic = 3
Const adLockReadOnly = 1
strRecipients = Trim(Request.Form("recipients"))
strSubject = Trim(Request.Form("subject"))
strBody = Trim(Request.Form("body"))
Select Case Request.Form("action")
Case "Send"
If Len(strRecipients) = 0 Then
strErrMessage = strErrMessage & "You have not entered any recipients!<BR />" & vbCrLf
End If
If Len(strSubject) = 0 Then
strErrMessage = strErrMessage & "You have not entered a subject!<BR />" & vbCrLf
End If
If Len(strBody) = 0 Then
strErrMessage = strErrMessage & "You have not entered a message!<BR />" & vbCrLf
End If
If Len(strErrMessage) Then
WriteHead "Mail: Could not be sent"
Response.Write "<P>" & strErrMessage & "</P>"
WriteMessageForm strRecipients, strSubject, strBody
WriteFoot
Else
Set con = Server.CreateObject("ADODB.Connection")
con.Open "DRIVER={MySQL};" & _
"DATABASE=hemligt"
'**
'* Validerar mottagare
'**
vTemp = Split(strRecipients, ",")
strSQL = "SELECT tblUsers.UserId, tblUsers.UserName, tblRelationships.RelationshipType" & vbCrLf & _
"FROM tblUsers LEFT JOIN tblRelationships ON (tblUsers.UserId = Relationships.User1) OR (tblUsers.UserId = Relationships.User2)" & vbCrLf & _
"WHERE tblUsers.UserName IN (" & SQLINText(vTemp) & ")
Set rs = Server.CreateObject("ADODB.Recordset")
rs.Open strSQL, con, adOpenStatic, adLockReadOnly
Do Until rs.EOF
If rs("RelationshipType") = 2 Then
'Ovän = blokerad
strBlocked = strBlocked & rs("UserName") & vbCrLf
Else
lngCount = lngCount + 1
strIN = strIN & ", " & rs("UserId")
strNames = strNames & ", " & rs("UserName")
End If
vData = Filter(vData, rs("UserName"), False, vbTextCompare)
rs.MoveNext
Loop
strIN = Mid(strIN, 3)
strNames = Mid(strNames, 3)
strNotFound = Join(vData, ", ")
If rs.RecordCount = lngCount Then
strSQL = "INSERT INTO tblMails (MailReceiver, MailStatus, MailSender, MailSubject, MailBody)" & vbCrLf & _
"SELECT tblUsers.UserId, Null, " & Session("UserId") & ", " & SQLText(strSubject) & ", " & SQLText(strBody) & vbCrLf & _
"FROM tblUsers LEFT JOIN Relationships ON (tblUsers.UserId = Relationships.User1) OR (tblUsers.UserId = Relationships.User2)" & vbCrLf & _
"WHERE tblUsers.UserId IN (" & strIN & ")
WriteHead "Mail has been sent"
Response.Write "<P><B >Recipients: </B >" & Server.HTMLEncode(strNames) & "</P>"
Response.Write "<P><B >Subject: </B >" & Server.HTMLEncode(strSubject) & "</P>"
Response.Write "<P><B >Message: </B ><PRE>" & Server.HTMLEncode(strBody)) & "</PRE></P>"
WriteFoot
Else
WriteHead "Mail"
If Len(strBlocked) Then
Response.Write "The following user has blocked you from sending messages: " & strBlocked & "</P>"
End If
If Len(strNotFound) Then
Response.Write "The following user could not be found: " & strNotFound & "</P>"
End If
WriteMessageForm strRecipients, strSubject, strBody
WriteFoot
End If
rs.Close
Set rs = Nothing
con.Close
Set con = Nothing
End If
Case Else
WriteHead "Mail"
WriteMessageForm strRecipients, strSubject, strBody
WriteFoot
End Select
End Sub
Main
%>
</code>Sv: Blocka internmail om den man skickar till har på block-lista
Försökte fixa så att jag skulle få det så som jag ville men lyckades inte.
Skulle du vilja skriva hur det skall se ut om dokumentet som vi kan kall skicka_mail.asp får uppgifterna att bearbeta ifrån skriv_mail.asp. Uppgifterna som kommer ifrån skriv_mail.asp är som sagt:
Request.Form("NameList") - Vilka man valt att skicka till (tex: 1, 23, 7, 9)
Request.Form("Mail_Subject") - Mailets ämne (tex: Här kommer ett mail...)
Request.Form("Mail_Status") - Mailets prioritering, vanligt eller viktigt. Antingen värdet 51 eller 52
Request.Form("Mail_Message") - Själva meddelandet
Andra värden som finns är förståss:
Session("id") - Som är det du kallar UserId. Alltså medlemms-id för medlemmen som skriver mailet.
relationer-tabellen ser ut så här:
relationer.id - medlemms-id för den som lägger till relation
relationer.person - vilken relationen är till
relationer.typ - om vän eller ovän (antingen 1 eller 2, 1=vän 2=ovän)
mail-tabellen ser ut så här:
mail.ID - mailets id-nummer. Mailet får automatiskt ett nummer behöver alltså inte anges när man lägger till ny post
mail.Receiver_ID - motagarens id.
mail.Sender_ID - sändarens id.
mail.Status - om det är vanligt (51) eller viktigt (52) mail måste anges när skapar ny post.
mail.Sendt_Date_Time - Datumet och tid då mailet skickas
mail.Folder - viken mapp mailet skall hamna i. Nytt mail skall komma i "In boxen" som har värdet 1 därför skall man ange värdet 1 vid ny post i mail tabellen
mail.Subject - ämnet
mail.Message - meddelandet
medlemmar-tabellen innehåller bland annat:
medlemmar.id - melemms-id
medlemmar.username - användarnamnet
Vore verkligen tacksam om du vill hjälpa mig lösa detta.Sv: Blocka internmail om den man skickar till har på block-lista
>Vill inte att textfälten skall vara i samma dokument som det dokument som skall kolla om någon av de man vill skicka till är ovän med en.
>Det är dock helt ok att samma dokument som kollar om någon av dem man vill skicka till är ovän med en lägger till i databasen och skriver ut resultatet på sidan
>
Vad menar du med det?Sv: Blocka internmail om den man skickar till har på block-lista
Detta är infon som skickas till den nya sidan (den jag behöver hjälp med koden till) från sidan med textfälten:
Request.Form("NameList") - Vilka man valt att skicka till (tex: 1, 23, 7, 9)
Request.Form("Mail_Subject") - Mailets ämne (tex: Här kommer ett mail...)
Request.Form("Mail_Status") - Mailets prioritering, vanligt eller viktigt. Antingen värdet 51 eller 52
Request.Form("Mail_Message") - Själva meddelandet Sv: Blocka internmail om den man skickar till har på block-lista
Sv: Blocka internmail om den man skickar till har på block-lista
Skall försöka få med all info som du kan tänkas behöva för att kunna hjälpa mig.
Försökt ta bort all onödig kod så som html-design-kod så det blir lite tydligare.
Här är då den kod som jag annvänder idag men som bara fungerar om man väljer att skicka mail till en annan användare. Man kan alltså inte skicka ett mail till flera medlemmar samtidigt.
i select-listan vid namn "NameList" som finns i mail_skriv.asp listas alltså de man har som kompis, idiot men där kan också finnas med en annan medlem ifall man valt att på en medlemms presentationssida att skicka ett mail till honom genom att klicka på en sådan här länk:
">Skicka mail! till mej!
I selectlistan kan man makera flera medlemmar genom att hålla inne Ctrl-knappen på tangentbordet och klicka på fler än en av medlemmarna i listan.
Kort om sidorna:
mail_skriv.asp - Sidan på vilkan man skriver sitt meddelande och väljer vilka man vill skicka mailet till.
mail_skicka_mail.asp - skicar mail till de man valt (koden jag har här nu fungerar bara om man bara valt att skicka till en, det är ju detta jag behöver hjälp med så att det fungerar att skicka till flera.)
mail_kolla.asp - när mailet skickats eller blockats kommer man hit och får reda på om mailet skickats eller ej.
NewMail.js - funktion som används i mail_skriv.asp som kollar så att man fyllt i alla fält
Koden för de olika sidorna:
mail_skriv.asp:
<code>
<%
Mail_ToUser=Request.QueryString("id")
Set objCon = Server.CreateObject("ADODB.Connection")
objCon.Open "DRIVER={MySQL};DATABASE=hemligt;UID=hemligt;PWD=hemligt;SERVER=hemligt"
' #### BEGIN ## Om det finns någon singnatur ####
Set objGetData = Server.CreateObject("ADODB.Recordset")
objGetData.Open "SELECT medlemmar.signatur, medlemmar.signatur_ok FROM medlemmar WHERE medlemmar.id=" & Session("id"), objCon
If Not objGetData.EOF Then
If objGetData("signatur_ok")=1 Then Message=vbCrLf&vbCrLf&objGetData("signatur") end if
end if
objGetData.Close
Set objGetData = Nothing
Message=Server.HTMLEncode(Message&"")
' #### END ## Om det finns någon singnatur ####
' #### BEGIN ## om kompis ####
NameList=NameList & " <OPTION VALUE="""" STYLE=""color: #ffffff; background-color: #333333;""> Kompisar:</OPTION>" & vbCrLf
Set objGetData = Server.CreateObject("ADODB.Recordset")
objGetData.Open "SELECT relationer.id, relationer.typ, relationer.person, medlemmar.id, medlemmar.username, medlemmar.status FROM relationer, medlemmar WHERE medlemmar.id=relationer.person AND relationer.typ=1 AND relationer.id = "&Session("id"), objCon
Do Until objGetData.EOF
NameList=NameList & " <OPTION VALUE=" &objGetData("id")
If Mail_ToUser&""=objGetData("id")&"" Then NameList=NameList & " SELECTED" end if
NameList=NameList & "> " &objGetData("username")& "</OPTION>" & vbCrLf
objGetData.MoveNext
Loop
objGetData.Close
Set objGetData = Nothing
' #### END ## om kompis ####
' #### BEGIN ## om ingen relation till den man vill skicka till ####
Set objGetData = Server.CreateObject("ADODB.Recordset")
objGetData.Open "SELECT relationer.id, relationer.typ, relationer.person FROM relationer WHERE relationer.person="&Request.QueryString("id")&" AND relationer.id = "&Session("id"), objCon
If objGetData.EOF Then
objGetData.Close
Set objGetData = Nothing
Set objGetData = Server.CreateObject("ADODB.Recordset")
objGetData.Open "SELECT medlemmar.id, medlemmar.username, medlemmar.status FROM medlemmar WHERE medlemmar.id="&Request.QueryString("id"), objCon
NameList=NameList & " <OPTION VALUE="""" STYLE=""color: #ffffff; background-color: #333333;""> Ingen relation:</OPTION>" & vbCrLf
Do Until objGetData.EOF
NameList=NameList & " <OPTION VALUE=" &objGetData("id")
If Mail_ToUser&""=objGetData("id")&"" Then NameList=NameList & " SELECTED" end if
NameList=NameList & "> " &objGetData("username")& "</OPTION>" & vbCrLf
objGetData.MoveNext
Loop
objGetData.Close
Set objGetData = Nothing
END IF
' #### END ## om ingen relation till den man vill skicka till ####
' #### BEGIN ## om idiot ####
NameList=NameList & " <OPTION VALUE="""" STYLE=""color: #ffffff; background-color: #333333;""> Idioter:</OPTION>" & vbCrLf
Set objGetData = Server.CreateObject("ADODB.Recordset")
objGetData.Open "SELECT relationer.id, relationer.typ, relationer.person, medlemmar.id, medlemmar.username, medlemmar.status FROM relationer, medlemmar WHERE medlemmar.id=relationer.person AND relationer.typ=2 AND relationer.id = "&Session("id"), objCon
Do Until objGetData.EOF
NameList=NameList & " <OPTION VALUE="""&objGetData("id")&""""
If Mail_ToUser&""=objGetData("id")&"" Then NameList=NameList & " SELECTED" end if
NameList=NameList & "> " &objGetData("username")& "</OPTION>" & vbCrLf
objGetData.MoveNext
Loop
objGetData.Close
Set objGetData = Nothing
' #### END ## om idiot ####
objCon.Close
Set objCon = Nothing
%>
<SCRIPT LANGUAGE="JavaScript" SRC="NewMail.js"></SCRIPT>
<FORM NAME="FormNewMail" ACTION="mail_skicka_mail.asp" METHOD=POST>
Skicka till:
<br>
<SELECT NAME="NameList" SIZE=18 multiple STYLE="width: 182px; BACKGROUND-COLOR: #FFFFFF; COLOR: #000000; FONT-FAMILY: Arial; FONT-SIZE: 11px; FONT-WEIGHT: bold;" MAXLENGTH=120 WIDTH="182">
<% Response.Write NameList %>
</SELECT>
Ämnet:
<br>
<INPUT TYPE="text" NAME="Mail_Subject" SIZE=44 MAXLENGTH=120 CLASS="MailText">
<br>
Status:
<BR>
<INPUT TYPE="radio" NAME="Mail_Status" VALUE=51 CHECKED>
Vanligt <IMG SRC="bilder/iconer/Mail_Normal_Unread.gif" BORDER=0 WIDTH=14 HEIGHT=9>
<BR>
<INPUT TYPE="radio" NAME="Mail_Status" VALUE=50>
Viktigt <IMG SRC="bilder/iconer/Mail_Importent_Unread.gif" BORDER=0 WIDTH=14 HEIGHT=9>
<BR>
Meddelande:
<BR>
<TEXTAREA NAME="Mail_Message" COLS=38 ROWS=12 WRAP=virtual><%=Message%></TEXTAREA>
<BR>
<input TYPE="button" value="Skicka mail" class="knapp" OnClick="Javascript:CheckFields();">
</FORM>
</code>
mail_skicka_mail.asp:
<code>
<%
Session("Mail_NewMail_Subject")=Request.Form("Mail_Subject")
Session("Mail_NewMail_Status")=Request.Form("Mail_Status")
Session("Mail_NewMail_Message")=Request.Form("Mail_Message")
Session("Mail_NewMail_SendTo")=Request.Form("NameList")
Function SQLDate(Value)
If IsDate(Value) Then
SQLDate = "'" & Year(Value) & "-" & Month(Value) & "-" & Day(Value) & " " & Hour(Value) & ":" & Minute(Value) & ":" & Second(Value) & "'"
Else
SQLDate = "Null"
End If
End Function
Set objCon = Server.CreateObject("ADODB.Connection")
objCon.Open "DRIVER={MySQL};DATABASE=hemligt;UID=hemligt;PWD=hemligt;SERVER=hemligt"
Set objGetData = Server.CreateObject("ADODB.Recordset")
objGetData.Open "SELECT * FROM relationer WHERE typ=2 AND id="&Session("Mail_NewMail_SendTo")&" AND person=" & Session("id"), objCon
If objGetData.EOF Then
objCon.Execute "INSERT INTO mails (Receiver_ID, Sender_ID, Status, Sendt_Date_Time, Subject, Message, Folder) " & _
"VALUES("&Session("Mail_NewMail_SendTo")&", "&Session("id")&", "&Session("Mail_NewMail_Status")&", "&SQLDate(Now())&", '"&Session("Mail_NewMail_Subject")&"', '"&Session("Mail_NewMail_Message")&"', '1')"
Session("Mail_NewMail_Subject")=""
Session("Mail_NewMail_Status")=""
Session("Mail_NewMail_Message")=""
Response.Redirect "mail_kolla.asp?skickat="&Session("Mail_NewMail_SendTo")
Else
Session("Mail_NewMail_Subject")=""
Session("Mail_NewMail_Status")=""
Session("Mail_NewMail_Message")=""
Response.Redirect "mail_kolla.asp?inte="&Session("Mail_NewMail_SendTo")
Session("Mail_NewMail_SendTo")=""
END IF
objGetData.Close
Set objGetData = Nothing
objCon.Close
Set objCon = Nothing
%>
</code>
mail_kolla.asp:
<code>
<%
if Len(Request.QueryString("inte"))>0 Then
Set objCon = Server.CreateObject("ADODB.Connection")
objCon.Open "DRIVER={MySQL};DATABASE=hemligt;UID=hemligt;PWD=hemligt;SERVER=hemligt"
Set objGetData = Server.CreateObject("ADODB.Recordset")
objGetData.Open "SELECT username, id FROM medlemmar WHERE id="&Request.QueryString("inte"), objCon
If objGetData.EOF Then
Else
%>
<BR>
Mailet har ej skickats.
Mailet kunde ej skickas till användaren <B>"><%=objGetData("username")%></b> eftersom du finns med på hans idiotlista. Detta gör att du inte kan skicka några mail till honom.
<BR>
<%
END IF
objGetData.Close
Set objGetData = Nothing
objCon.Close
Set objCon = Nothing
END IF
if Len(Request.QueryString("skickat"))>0 Then
%>
<BR>
Mailet är skickat
<BR>
<%
END IF
%>
</code>
NewMail.js:
<code>
function AddAll() {
SelectedNames = '';
for(x=0; x<FormNewMail.NameList.length; x++) {
if (document.FormNewMail.NameList[x].value!="") {
FormNewMail.NameList[x].selected=true;
} else {
FormNewMail.NameList[x].selected=false;
}
}
}
function CheckFields() {
Error="";
if (document.FormNewMail.Mail_Subject.value=="") { Error=Error + " - Ämnet\n"; }
if (document.FormNewMail.Mail_Message.value=="") { Error=Error + " - Meddelande\n"; }
Names = 0;
for(x=0; x<FormNewMail.NameList.length; x++) {
if ((document.FormNewMail.NameList[x].selected==true) && (document.FormNewMail.NameList[x].value=="")) { document.FormNewMail.NameList[x].selected=false; }
if ((document.FormNewMail.NameList[x].selected==true) && (document.FormNewMail.NameList[x].value!="")) { Names=1; }
}
if (Names==0) { Error = Error + " - Skicka till\n"; }
if (Error!="") { Error = "Du har missat ett eller flera fält:\n" + Error + "\nVar vänlig fyll i dem innan du skickar mailet.";
alert(Error);
} else {
FormNewMail.submit();
}
}
</code>Sv: Blocka internmail om den man skickar till har på block-lista
Jag är oxå emot att du submitar ditt formulär med Javascript. JAvascript SKALL endast kompletera en sida ALDRIG ersätta funktion i sidan. Du ersättter ju en submit knapp, vilket fungerar oavsett browser och inställning, med enn button och JavaScript.
Du skall alltid validera formulärdata på servern. Det finns annars möjligheter at ta sig för bi kontrollen i javascriptet.
Du har dessutom inget skydd för SQL-Inject. Har lagt till skydd mot det.
Här är min lösning för ditt problem:
<code>
<%@ Language=VBScript %>
<html>
<head>
<SCRIPT type="text/JavaScript" SRC="NewMail.js" language="JavaScript"></SCRIPT>
</head>
<body>
<%
Function SQLDate(Value)
If IsDate(Value) Then
SQLDate = "'" & Year(Value) & "-" & Month(Value) & "-" & Day(Value) & " " & Hour(Value) & ":" & Minute(Value) & ":" & Second(Value) & "'"
Else
SQLDate = "Null"
End If
End Function
Function SQLText(Value)
Dim strTemp
If Len(Value) > 0 Then
strTemp = Value
strTemp = Replace(strTemp, "\", "\\")
strTemp = Replace(strTemp, "%", "\%")
strTemp = Replace(strTemp, "_", "\_")
strTemp = Replace(strTemp, "'", "\'")
strTemp = Replace(strTemp, """", "\""")
strTemp = Replace(strTemp, vbCr, "\n")
strTemp = Replace(strTemp, vbLf, "\r")
strTemp = Replace(strTemp, vbTab, "\t")
SQLText = "'" & strTemp & "'"
Else
SQLText = "Null"
End If
End Function
Function Find(Data, Value)
Dim Item
Find = False
For Each Item In Data
If Item = value Then
Find = True
Exit For
End If
Next
End Function
Sub WriteReciverList(objCon, Recivers)
Dim strSQL
Dim strLastTyp
Dim objGetData
strSQL = "SELECT medlemmar.id, medlemmar.username, medlemmar.status, relationer.id, relationer.typ, relationer.person" & vbCrLf & _
"FROM medlemmar LEFT JOIN relationer ON ((medlemmar.id = relationer.person) AND (relationer.id = " & Session("id") & "))" & vbCrLf & _
"WHERE relationer.typ IN (1, 2) OR medlemmar.id IN (" & Join(Recivers, ", ") & ")" & vbCrLf & _
"ORDER BY relationer.typ, medlemmar.username"
Set objGetData = Server.CreateObject("ADODB.Recordset")
objGetData.Open strSQL, objCon
Do Until objGetData.EOF
If strLastTyp <> "" & objGetData("typ") Then
Select Case objGetData("typ")
Case 1
Response.Write "<OPTION VALUE="""" STYLE=""color: #ffffff; background-color: #333333;""> Kompisar:</OPTION>" & vbCrLf
Case 2
Response.Write "<OPTION VALUE="""" STYLE=""color: #ffffff; background-color: #333333;""> Idioter:</OPTION>" & vbCrLf
Case Else
Response.Write "<OPTION VALUE="""" STYLE=""color: #ffffff; background-color: #333333;""> Ingen relation:</OPTION>" & vbCrLf
End Select
strLastTyp = "" & objGetData("typ")
End If
If Find(Recivers, objGetData("id")) Then
Response.Write "<OPTION VALUE=""" & objGetData("id") & """ SELECTED> " & Server.HTMLEncode(objGetData("username")) & "</OPTION>" & vbCrLf
Else
Response.Write "<OPTION VALUE=""" & objGetData("id") & """> " & Server.HTMLEncode(objGetData("username")) & "</OPTION>" & vbCrLf
End If
objGetData.MoveNext
Loop
objGetData.Close
objGetData.Close
Set objGetData= Nothing
End Sub
Sub WriteForm(objCon, Recivers, Subject, Status, Message)
%>
<FORM NAME="FormNewMail" ACTION="" METHOD=POST ID="Form1">
Skicka till:<br>
<SELECT NAME="Mail_Recivers" SIZE=18 multiple STYLE="width: 182px; BACKGROUND-COLOR: #FFFFFF; COLOR: #000000; FONT-FAMILY: Arial; FONT-SIZE: 11px; FONT-WEIGHT: bold;" MAXLENGTH=120 WIDTH="182" ID="Select1">
<% WriteReciverList(objCon, Recivers) %>
</SELECT>
Ämnet:<br>
<INPUT type="text" NAME="Mail_Subject" SIZE=44 MAXLENGTH=120 CLASS="MailText" ID="Text1" value="<%Response.Write Server.HTMLEncode(Subject)%>">
<br>
Status:<BR>
<INPUT TYPE="radio" NAME="Mail_Status" VALUE=51 <%If Status = 51 Then Response.Write "CHECKED "%>ID="Radio1">
Vanligt <IMG SRC="bilder/iconer/Mail_Normal_Unread.gif" BORDER=0 WIDTH=14 HEIGHT=9><BR>
<INPUT TYPE="radio" NAME="Mail_Status" VALUE=50 <%If Status = 50 Then Response.Write "CHECKED "%>ID="Radio2">
Viktigt <IMG SRC="bilder/iconer/Mail_Importent_Unread.gif" BORDER=0 WIDTH=14 HEIGHT=9><BR>
Meddelande:<BR>
<TEXTAREA NAME="Mail_Message" COLS=38 ROWS=12 WRAP=virtual ID="Textarea1"><%Response.Write Server.HTMLEncode(Message)%></TEXTAREA>
<BR>
<INPUT TYPE="submit" NAME="Action" value="Skicka mail" class="knapp" OnClick="Javascript:CheckFields();" ID="Button2" >
</FORM>
<%
End Sub
Dim objCon
Dim objGetData
Dim lngStatus
Dim strId
Dim strSubject
Dim strMessage
Dim strSQL
Dim Count
Dim Recivers
Set objCon = Server.CreateObject("ADODB.Connection")
objCon.Open "DRIVER={MySQL};DATABASE=hemligt;UID=hemligt;PWD=hemligt;SERVER=hemligt"
Select Case Request.Form("Action")
Case "Skicka mail"
For Each strId In Request.Form("Mail_Recivers")
If IsNumeric(strId) Then
Count = Count + 1
Redim Preserve Recivers(1 to Count)
Recivers(Count) = CLng(strId)
End If
Next
If Count = 0 Then
strError = strError & "Markera mottagare!" & vbCrLf
End If
strSubject = Trim(Request.Form("Mail_Subject"))
If Len(strSubject) = 0 Then
strError = strError & "Ange ämne!" & vbCrLf
End If
lngStatus = Trim(Request.Form("Mail_Status"))
Select Case lngStatus
Case "50", "51"
lngStatus = CLng(lngStatus)
Case Else
lngStatus = 51
End Select
strMessage = Trim(Request.Form("Mail_Message"))
If Len(strMessage) = 0 Then
strError = strError & "Skriv ett meddelande!" & vbCrLf
End If
If Len(strError) Then
Response.Write "<H3>Ditt mail har inte skickats!</H3>"
Response.Write "<P>" & Server.HTMLEncode(strError) & "</P>"
WriteForm objCon, Recivers, strSubject, lngStatus, strMessage
Else
strSQL = "SELECT medlemmar.username, medlemmar.id" & vbCrLf & _
"FROM relationer INNER JOIN medlemmar ON relationer.id = medlemmar.id" & vbCrLf & _
"WHERE relationer.typ=2 AND relationer.id IN (" & Join(Recivers, ", ") & " AND person=" & Session("id")
Set objGetData = Server.CreateObject("ADODB.Recordset")
objGetData.Open strSQL, objCon
If objGetData.EOF Then
objCon.Execute "INSERT INTO mails (Receiver_ID, Sender_ID, Status, Sendt_Date_Time, Subject, Message, Folder)" & vbCrLf & _
"SELECT medlemmar.id, " & Session("id") & ", " & lngStatus & ", " & SQLDate(Now()) & ", " & SQLText(strSubject) & ", " & SQLText(strMessage) & ", 1" & vbCrLf & _
"FROM medlemmar" & vbCrLf & _
"WHERE medlemmar.id IN (" & Join(Recivers, ", ") & ")"
Response.Write "<H3>Ditt mail har skickats!</H3>"
Else
Response.Write "<H3>Ditt mail har inte skickats!</H3>"
Response.Write "<P>Följande personer har blokerat meddelande från dig:<BR>"
Response.Write "<UL>"
Do
Response.Write "<LI>" & Server.HTMLEncode(objGetData("username")) & "</LI>"
Loop Until objGetData.EOF
Response.Write "</UL>"
Response.Write "Du kan inte skicka meddelande till dessa personer!<BR>"
Response.Write "Avmarkera dem och försök igen.</P>"
WriteForm objCon, Recivers, strSubject, lngStatus, strMessage
End if
End If
Case Else
strId = Trim(Request.QueryString("id"))
If IsNumeric(strId) Then
Count = 1
Redim Recivers(1 to Count)
Recivers(Count) = CLng(strId)
End If
' #### BEGIN ## Om det finns någon singnatur ####
strSQL = "SELECT medlemmar.signatur" & vbCrLf & _
"FROM medlemmar" & vbCrLf & _
"WHERE medlemmar.signatur_ok = 1 AND medlemmar.id = " & Session("id")
Set objGetData = Server.CreateObject("ADODB.Recordset")
objGetData.Open strSQL, objCon
If Not objGetData.EOF Then
strMessage = vbCrLf & vbCrLf & objGetData("signatur")
end if
objGetData.Close
' #### END ## Om det finns någon singnatur ####
Set objGetData= Nothing
WriteForm objCon, Recivers, "", 51, strMessage
End Select
objCon.Close
Set objCon = Nothing
%>
</body>
</html>
</code>
Villket bör var ett effektivt sät att lösa ditt problem. Väljer du att stycka upp den kommer du att förlora, ur prestanda synpunkt, på det.
Dett kan förekomma syntaxfel osv eftersom jag inte har möjlighete att testa koden.Sv: Blocka internmail om den man skickar till har på block-lista
Microsoft VBScript compilation error '800a0414'
Cannot use parentheses when calling a Sub
/mail_skriv.asp, line 90
WriteReciverList(objCon, Recivers)
----------------------------------^
"^" pekar efter ")"Sv: Blocka internmail om den man skickar till har på block-lista
<code>
WriteReciverList objCon, Recivers
</code>
Eller:
<code>
Call WriteReciverList(objCon, Recivers)
</code>Sv: Blocka internmail om den man skickar till har på block-lista
Microsoft VBScript compilation error '800a03ee'
Expected ')'
/mail_skriv.asp, line 133
Redim Preserve Recivers(1 to Count)
--------------------------^
"^" pekar på "t"Sv: Blocka internmail om den man skickar till har på block-lista
Sv: Blocka internmail om den man skickar till har på block-lista
<code>
Dim Recivers()
</code>
Eller ta bort "1 to":
<code>
Redim Preserve Recivers(Count)
</code>Sv: Blocka internmail om den man skickar till har på block-lista
Hjälpte inte när jag ändrade till Dim Recivers() så jag fick ändra på det andra stället. Jag ändrade alltså tll
Redim Preserve Recivers(Count) + att jag lite längre ner fick ändra till Redim Recivers(Count).
...får nu inget felmeddelande.
Men det ända som kommer upp på sidan är texten "Skicka till:" + select-rutan i vilken medlemmarna som man skall kunna skicka till skall listas. Rutan är dock helt tom. Detta är alltså allt som syns på sidan, inga andra fält eller knappar.Sv: Blocka internmail om den man skickar till har på block-lista
Sv: Blocka internmail om den man skickar till har på block-lista
Detr är väll typ detta du menar:
"mail_skriv.asp?id=50"
id=när man är inne på en medlemms presentationsida och klickar på "Skicka mail till denna medlem" så kommer man till mail_skriv.asp. id-värdet är således medlemms-id som medlemmen man skall skicka till.
Skulle vilja att sidan fungerar även om man bara går in på "mail_skriv.asp" utan "?id=X" så att man kan gå in ifrån sin egna mailbox och helt enkelt bara klicka på skriv mail utan att det än presiserats till vem utan att det är först när man kommer till mail_skriv.asp som man makerar den/de man vill skicka till.
...krångligt att förklara. Men hoppas du förstår, annars är det la bara att fråga.Sv: Blocka internmail om den man skickar till har på block-lista
<code>
<%@ Language=VBScript %>
<%Option Explicit%>
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<html>
<head>
<SCRIPT type="text/JavaScript" SRC="NewMail.js" language="JavaScript"></SCRIPT>
</head>
<body>
<%
Function SQLDate(Value)
If IsDate(Value) Then
SQLDate = "'" & Year(Value) & "-" & Month(Value) & "-" & Day(Value) & " " & Hour(Value) & ":" & Minute(Value) & ":" & Second(Value) & "'"
Else
SQLDate = "Null"
End If
End Function
Function SQLText(Value)
Dim strTemp
If Len(Value) > 0 Then
strTemp = Value
strTemp = Replace(strTemp, "\", "\\")
strTemp = Replace(strTemp, "%", "\%")
strTemp = Replace(strTemp, "_", "\_")
strTemp = Replace(strTemp, "'", "\'")
strTemp = Replace(strTemp, """", "\""")
strTemp = Replace(strTemp, vbCr, "\n")
strTemp = Replace(strTemp, vbLf, "\r")
strTemp = Replace(strTemp, vbTab, "\t")
SQLText = "'" & strTemp & "'"
Else
SQLText = "Null"
End If
End Function
Function Find(Data, Value)
Dim Item
Find = False
For Each Item In Data
If Item = value Then
Find = True
Exit For
End If
Next
End Function
Sub WriteReciverList(objCon, Recivers)
Dim strSQL
Dim strLastTyp
Dim objGetData
If IsEmpty(Recivers) Then
strSQL = "SELECT medlemmar.id, medlemmar.username, medlemmar.status, relationer.id, relationer.typ, relationer.person" & vbCrLf & _
"FROM medlemmar LEFT JOIN relationer ON ((medlemmar.id = relationer.person) AND (relationer.id = " & lngMedlemsId & "))" & vbCrLf & _
"WHERE relationer.typ IN (1, 2)" & vbCrLf & _
"ORDER BY relationer.typ, medlemmar.username"
Else
strSQL = "SELECT medlemmar.id, medlemmar.username, medlemmar.status, relationer.typ, relationer.person" & vbCrLf & _
"FROM medlemmar LEFT JOIN relationer ON ((medlemmar.id = relationer.person) AND (relationer.id = " & lngMedlemsId & "))" & vbCrLf & _
"WHERE relationer.typ IN (1, 2) OR medlemmar.id IN (" & Join(Recivers, ", ") & ")" & vbCrLf & _
"ORDER BY relationer.typ, medlemmar.username"
End If
Set objGetData = Server.CreateObject("ADODB.Recordset")
objGetData.Open strSQL, objCon
Do Until objGetData.EOF
If strLastTyp <> "" & objGetData("typ") Then
Select Case objGetData("typ")
Case 1
Response.Write "<OPTION VALUE="""" STYLE=""color: #ffffff; background-color: #333333;""> Kompisar:</OPTION>" & vbCrLf
Case 2
Response.Write "<OPTION VALUE="""" STYLE=""color: #ffffff; background-color: #333333;""> Idioter:</OPTION>" & vbCrLf
Case Else
Response.Write "<OPTION VALUE="""" STYLE=""color: #ffffff; background-color: #333333;""> Ingen relation:</OPTION>" & vbCrLf
End Select
strLastTyp = "" & objGetData("typ")
End If
If Find(Recivers, objGetData("id")) Then
Response.Write "<OPTION VALUE=""" & objGetData("id") & """ SELECTED> " & Server.HTMLEncode(objGetData("username")) & "</OPTION>" & vbCrLf
Else
Response.Write "<OPTION VALUE=""" & objGetData("id") & """> " & Server.HTMLEncode(objGetData("username")) & "</OPTION>" & vbCrLf
End If
objGetData.MoveNext
Loop
objGetData.Close
Set objGetData= Nothing
End Sub
Sub WriteForm(objCon, Recivers, Subject, Status, Message)
%>
<FORM NAME="FormNewMail" ACTION="" METHOD=POST ID="Form1">
Skicka till:<br>
<SELECT NAME="Mail_Recivers" SIZE=5 multiple STYLE="width: 182px; BACKGROUND-COLOR: #FFFFFF; COLOR: #000000; FONT-FAMILY: Arial; FONT-SIZE: 11px; FONT-WEIGHT: bold;" MAXLENGTH=120 WIDTH="182" ID="Select1">
<% WriteReciverList objCon, Recivers %>
</SELECT><br>
Ämnet:<br>
<INPUT type="text" NAME="Mail_Subject" SIZE=55 MAXLENGTH=120 CLASS="MailText" ID="Text1" value="<%Response.Write Server.HTMLEncode(Subject)%>"><br>
Status:<BR>
<label><INPUT TYPE="radio" NAME="Mail_Status" VALUE=51 <%If Status = 51 Then Response.Write "CHECKED "%>ID="Radio1">
Vanligt <IMG SRC="bilder/iconer/Mail_Normal_Unread.gif" BORDER=0 WIDTH=14 HEIGHT=9></label><BR>
<label><INPUT TYPE="radio" NAME="Mail_Status" VALUE=50 <%If Status = 50 Then Response.Write "CHECKED "%>ID="Radio2">
Viktigt <IMG SRC="bilder/iconer/Mail_Importent_Unread.gif" BORDER=0 WIDTH=14 HEIGHT=9></label><BR>
Meddelande:<BR>
<TEXTAREA NAME="Mail_Message" COLS=38 ROWS=12 WRAP=virtual ID="Textarea1"><%Response.Write Server.HTMLEncode(Message)%></TEXTAREA>
<BR>
<INPUT TYPE="submit" NAME="Action" value="Skicka mail" class="knapp" OnClick="Javascript:CheckFields();" ID="Button2" >
</FORM>
<%
End Sub
Dim objCon
Dim objGetData
Dim lngId
Dim lngMedlemsId
Dim lngStatus
Dim strId
Dim strSubject
Dim strMessage
Dim strSQL
Dim Count
Dim Recivers
lngMedlemsId = 2
'lngMedlemsId = Session("id")
Set objCon = Server.CreateObject("ADODB.Connection")
'objCon.Open "DRIVER={MySQL};DATABASE=hemligt;UID=hemligt;PWD=hemligt;SERVER=hemligt"
objCon.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Persist Security Info=False;" & _
"Data Source=C:\Inetpub\wwwroot\lumba\lumbadb.mdb;"
Select Case Request.Form("Action")
Case "Skicka mail"
For Each strId In Request.Form("Mail_Recivers")
If IsNumeric(strId) Then
Redim Preserve Recivers(Count)
Recivers(Count) = CLng(strId)
Count = Count + 1
End If
Next
If Count = 0 Then
strError = strError & "Markera mottagare!" & vbCrLf
End If
strSubject = Trim(Request.Form("Mail_Subject"))
If Len(strSubject) = 0 Then
strError = strError & "Ange ämne!" & vbCrLf
End If
lngStatus = Trim(Request.Form("Mail_Status"))
Select Case lngStatus
Case "50", "51"
lngStatus = CLng(lngStatus)
Case Else
lngStatus = 51
End Select
strMessage = Trim(Request.Form("Mail_Message"))
If Len(strMessage) = 0 Then
strError = strError & "Skriv ett meddelande!" & vbCrLf
End If
If Len(strError) Then
Response.Write "<H3>Ditt mail har inte skickats!</H3>"
Response.Write "<P>" & Server.HTMLEncode(strError) & "</P>"
WriteForm objCon, Recivers, strSubject, lngStatus, strMessage
Else
strSQL = "SELECT medlemmar.username, medlemmar.id" & vbCrLf & _
"FROM relationer INNER JOIN medlemmar ON relationer.id = medlemmar.id" & vbCrLf & _
"WHERE relationer.typ=2 AND relationer.id IN (" & Join(Recivers, ", ") & " AND person=" & lngMedlemsId
Set objGetData = Server.CreateObject("ADODB.Recordset")
objGetData.Open strSQL, objCon
If objGetData.EOF Then
objCon.Execute "INSERT INTO mails (Receiver_ID, Sender_ID, Status, Sendt_Date_Time, Subject, Message, Folder)" & vbCrLf & _
"SELECT medlemmar.id, " & lngMedlemsId & ", " & lngStatus & ", " & SQLDate(Now()) & ", " & SQLText(strSubject) & ", " & SQLText(strMessage) & ", 1" & vbCrLf & _
"FROM medlemmar" & vbCrLf & _
"WHERE medlemmar.id IN (" & Join(Recivers, ", ") & ")"
Response.Write "<H3>Ditt mail har skickats!</H3>"
Else
Response.Write "<H3>Ditt mail har inte skickats!</H3>"
Response.Write "<P>Följande personer har blokerat meddelande från dig:<BR>"
Response.Write "<UL>"
Do
Response.Write "<LI>" & Server.HTMLEncode(objGetData("username")) & "</LI>"
Loop Until objGetData.EOF
Response.Write "</UL>"
Response.Write "Du kan inte skicka meddelande till dessa personer!<BR>"
Response.Write "Avmarkera dem och försök igen.</P>"
WriteForm objCon, Recivers, strSubject, lngStatus, strMessage
End if
End If
Case Else
strId = Trim(Request.QueryString("id"))
If IsNumeric(strId) Then
Redim Recivers(0)
Recivers(0) = CLng(strId)
Count = 1
End If
' #### BEGIN ## Om det finns någon singnatur ####
strSQL = "SELECT medlemmar.signatur" & vbCrLf & _
"FROM medlemmar" & vbCrLf & _
"WHERE medlemmar.signatur_ok = 1 AND medlemmar.id = " & lngMedlemsId
Set objGetData = Server.CreateObject("ADODB.Recordset")
objGetData.Open strSQL, objCon
If Not objGetData.EOF Then
strMessage = vbCrLf & vbCrLf & objGetData("signatur")
end if
objGetData.Close
' #### END ## Om det finns någon singnatur ####
Set objGetData= Nothing
WriteForm objCon, Recivers, "", 51, strMessage
End Select
objCon.Close
Set objCon = Nothing
%>
</body>
</html>
</code>Sv: Blocka internmail om den man skickar till har på block-lista
När jag klickat för att sända mailet så stod det först:
<code>
Microsoft VBScript runtime error '800a000d'
Type mismatch
/mail_skriv.asp, line 146
</code>
(På rad 146 står det: Redim Preserve Recivers(Count))
...ändrade då till:
<code>
Dim Recivers()
</code>
... en bit upp i koden. Fick då inte detta felmeddelande längre.
Fick då istället detta felmeddelande:
<code>
Microsoft VBScript runtime error '800a01f4'
Variable is undefined: 'strError'
/mail_skriv.asp, line 174
</code>
...La då till denna "Dim" eller vad den nu kallas bland de andra dim-arna:
<code>
Dim strError
</code>
...och på så vis fick jag inte heller detta felmeddelande:
Fick i stället detta meddelande (som jag inte vet hur jag skall fixa):
<code>
Microsoft OLE DB Provider for ODBC Drivers error '80040e09'
[TCX][MyODBC]You have an error in your SQL syntax. Check the manual that corresponds to your MySQL server version for the right syntax to use near '' at line 3
/mail_skriv.asp, line 183
</code>
(På rad 183 står det: objGetData.Open strSQL, objCon)Sv: Blocka internmail om den man skickar till har på block-lista
Glömde testa att "skicka mail".
Har avlusat den nu.
<code>
<%@ Language=VBScript %>
<%Option Explicit%>
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<html>
<head>
<SCRIPT type="text/JavaScript" SRC="NewMail.js" language="JavaScript"></SCRIPT>
</head>
<body>
<%
Function SQLDate(Value)
If IsDate(Value) Then
SQLDate = "'" & Year(Value) & "-" & Month(Value) & "-" & Day(Value) & " " & Hour(Value) & ":" & Minute(Value) & ":" & Second(Value) & "'"
Else
SQLDate = "Null"
End If
End Function
Function SQLText(Value)
Dim strTemp
If Len(Value) > 0 Then
strTemp = Value
strTemp = Replace(strTemp, "\", "\\")
strTemp = Replace(strTemp, "%", "\%")
strTemp = Replace(strTemp, "_", "\_")
strTemp = Replace(strTemp, "'", "\'")
strTemp = Replace(strTemp, """", "\""")
strTemp = Replace(strTemp, vbCr, "\n")
strTemp = Replace(strTemp, vbLf, "\r")
strTemp = Replace(strTemp, vbTab, "\t")
SQLText = "'" & strTemp & "'"
Else
SQLText = "Null"
End If
End Function
Function Find(Data, Value)
Dim Item
Find = False
If IsArray(Data) Then
For Each Item In Data
If Item = value Then
Find = True
Exit For
End If
Next
End If
End Function
Sub WriteReciverList(objCon, Recivers, Count)
Dim strSQL
Dim strLastTyp
Dim objGetData
If Count Then
strSQL = "SELECT medlemmar.id, medlemmar.username, medlemmar.status, relationer.typ, relationer.person" & vbCrLf & _
"FROM medlemmar LEFT JOIN relationer ON ((medlemmar.id = relationer.person) AND (relationer.id = " & lngMedlemsId & "))" & vbCrLf & _
"WHERE relationer.typ IN (1, 2) OR medlemmar.id IN (" & Join(Recivers, ", ") & ")" & vbCrLf & _
"ORDER BY relationer.typ, medlemmar.username"
Else
strSQL = "SELECT medlemmar.id, medlemmar.username, medlemmar.status, relationer.typ, relationer.person" & vbCrLf & _
"FROM medlemmar LEFT JOIN relationer ON ((medlemmar.id = relationer.person) AND (relationer.id = " & lngMedlemsId & "))" & vbCrLf & _
"WHERE relationer.typ IN (1, 2)" & vbCrLf & _
"ORDER BY relationer.typ, medlemmar.username"
End If
Set objGetData = Server.CreateObject("ADODB.Recordset")
objGetData.Open strSQL, objCon
Do Until objGetData.EOF
If strLastTyp <> "" & objGetData("typ") Then
Select Case objGetData("typ")
Case 1
Response.Write "<OPTION VALUE="""" STYLE=""color: #ffffff; background-color: #333333;""> Kompisar:</OPTION>" & vbCrLf
Case 2
Response.Write "<OPTION VALUE="""" STYLE=""color: #ffffff; background-color: #333333;""> Idioter:</OPTION>" & vbCrLf
Case Else
Response.Write "<OPTION VALUE="""" STYLE=""color: #ffffff; background-color: #333333;""> Ingen relation:</OPTION>" & vbCrLf
End Select
strLastTyp = "" & objGetData("typ")
End If
If Find(Recivers, objGetData("id")) Then
Response.Write "<OPTION VALUE=""" & objGetData("id") & """ SELECTED> " & Server.HTMLEncode(objGetData("username")) & "</OPTION>" & vbCrLf
Else
Response.Write "<OPTION VALUE=""" & objGetData("id") & """> " & Server.HTMLEncode(objGetData("username")) & "</OPTION>" & vbCrLf
End If
objGetData.MoveNext
Loop
objGetData.Close
Set objGetData= Nothing
End Sub
Sub WriteForm(objCon, Recivers, Count, Subject, Status, Message)
%>
<FORM NAME="FormNewMail" ACTION="" METHOD=POST ID="Form1">
Skicka till:<br>
<SELECT NAME="Mail_Recivers" SIZE=5 multiple STYLE="width: 182px; BACKGROUND-COLOR: #FFFFFF; COLOR: #000000; FONT-FAMILY: Arial; FONT-SIZE: 11px; FONT-WEIGHT: bold;" MAXLENGTH=120 WIDTH="182" ID="Select1">
<% WriteReciverList objCon, Recivers, Count %>
</SELECT><br>
Ämnet:<br>
<INPUT type="text" NAME="Mail_Subject" SIZE=55 MAXLENGTH=120 CLASS="MailText" ID="Text1" value="<%Response.Write Server.HTMLEncode(Subject)%>"><br>
Status:<BR>
<label><INPUT TYPE="radio" NAME="Mail_Status" VALUE=51 <%If Status = 51 Then Response.Write "CHECKED "%>ID="Radio1">
Vanligt <IMG SRC="bilder/iconer/Mail_Normal_Unread.gif" BORDER=0 WIDTH=14 HEIGHT=9></label><BR>
<label><INPUT TYPE="radio" NAME="Mail_Status" VALUE=50 <%If Status = 50 Then Response.Write "CHECKED "%>ID="Radio2">
Viktigt <IMG SRC="bilder/iconer/Mail_Importent_Unread.gif" BORDER=0 WIDTH=14 HEIGHT=9></label><BR>
Meddelande:<BR>
<TEXTAREA NAME="Mail_Message" COLS=38 ROWS=12 WRAP=virtual ID="Textarea1"><%Response.Write Server.HTMLEncode(Message)%></TEXTAREA>
<BR>
<INPUT TYPE="submit" NAME="Action" value="Skicka mail" class="knapp" OnClick="Javascript:CheckFields();" ID="Button2" >
</FORM>
<%
End Sub
Dim objCon
Dim objGetData
Dim lngId
Dim lngMedlemsId
Dim lngStatus
Dim strId
Dim strSubject
Dim strError
Dim strMessage
Dim strSQL
Dim Count
Dim Recivers()
lngMedlemsId = 2
'lngMedlemsId = Session("id")
Set objCon = Server.CreateObject("ADODB.Connection")
'objCon.Open "DRIVER={MySQL};DATABASE=hemligt;UID=hemligt;PWD=hemligt;SERVER=hemligt"
objCon.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Persist Security Info=False;" & _
"Data Source=C:\Inetpub\wwwroot\lumba\lumbadb.mdb;"
Select Case Request.Form("Action")
Case "Skicka mail"
For Each strId In Request.Form("Mail_Recivers")
If IsNumeric(strId) Then
Redim Preserve Recivers(Count)
Recivers(Count) = CLng(strId)
Count = Count + 1
End If
Next
If Count = 0 Then
strError = strError & "Markera mottagare!" & vbCrLf
End If
strSubject = Trim(Request.Form("Mail_Subject"))
If Len(strSubject) = 0 Then
strError = strError & "Ange ämne!" & vbCrLf
End If
lngStatus = Trim(Request.Form("Mail_Status"))
Select Case lngStatus
Case "50", "51"
lngStatus = CLng(lngStatus)
Case Else
lngStatus = 51
End Select
strMessage = Trim(Request.Form("Mail_Message"))
If Len(strMessage) = 0 Then
strError = strError & "Skriv ett meddelande!" & vbCrLf
End If
If Len(strError) Then
Response.Write "<H3>Ditt mail har inte skickats!</H3>"
Response.Write "<P>" & Server.HTMLEncode(strError) & "</P>"
WriteForm objCon, Recivers, Count, strSubject, lngStatus, strMessage
Else
strSQL = "SELECT medlemmar.username, medlemmar.id" & vbCrLf & _
"FROM relationer INNER JOIN medlemmar ON relationer.id = medlemmar.id" & vbCrLf & _
"WHERE relationer.typ=2 AND relationer.id IN (" & Join(Recivers, ", ") & ") AND person=" & lngMedlemsId
Set objGetData = Server.CreateObject("ADODB.Recordset")
objGetData.Open strSQL, objCon
If objGetData.EOF Then
objCon.Execute "INSERT INTO mails (Receiver_ID, Sender_ID, Status, Sendt_Date_Time, Subject, Message, Folder)" & vbCrLf & _
"SELECT medlemmar.id, " & lngMedlemsId & ", " & lngStatus & ", " & SQLDate(Now()) & ", " & SQLText(strSubject) & ", " & SQLText(strMessage) & ", 1" & vbCrLf & _
"FROM medlemmar" & vbCrLf & _
"WHERE medlemmar.id IN (" & Join(Recivers, ", ") & ")"
Response.Write "<H3>Ditt mail har skickats!</H3>"
Else
Response.Write "<H3>Ditt mail har inte skickats!</H3>"
Response.Write "<P>Följande personer har blokerat meddelande från dig:<BR>"
Response.Write "<UL>"
Do
Response.Write "<LI>" & Server.HTMLEncode(objGetData("username")) & "</LI>"
objGetData.MoveNext
Loop Until objGetData.EOF
Response.Write "</UL>"
Response.Write "Du kan inte skicka meddelande till dessa personer!<BR>"
Response.Write "Avmarkera dem och försök igen.</P>"
WriteForm objCon, Recivers, Count, strSubject, lngStatus, strMessage
End if
End If
Case Else
strId = Trim(Request.QueryString("id"))
If IsNumeric(strId) Then
Redim Recivers(0)
Recivers(0) = CLng(strId)
Count = 1
End If
' #### BEGIN ## Om det finns någon singnatur ####
strSQL = "SELECT medlemmar.signatur" & vbCrLf & _
"FROM medlemmar" & vbCrLf & _
"WHERE medlemmar.signatur_ok = 1 AND medlemmar.id = " & lngMedlemsId
Set objGetData = Server.CreateObject("ADODB.Recordset")
objGetData.Open strSQL, objCon
If Not objGetData.EOF Then
strMessage = vbCrLf & vbCrLf & objGetData("signatur")
end if
objGetData.Close
' #### END ## Om det finns någon singnatur ####
Set objGetData= Nothing
WriteForm objCon, Recivers, Count, "", 51, strMessage
End Select
objCon.Close
Set objCon = Nothing
%>
</body>
</html>
</code>Sv: Blocka internmail om den man skickar till har på block-list
Fanken va gött!!!
Tack så mycket!Sv: Blocka internmail om den man skickar till har på block-lis
Det som inte fungerar är om man vill skicka mail till medlemmar man inte har någon relation till. Det är ju meningen att de skall komma upp under "Ingen relation:" men de gör de inte. Den medlemmen hamnar överst i listboxen alltså utan "Ingen relation:"text över sig, åvanför texten "Kompisar:". Någon "Ingen relation:" rubrik visas över huvud taget inte.
Det ända som inte stämmer här är alltså att det inte kommer upp någon "Ingen relation:"-rubrik.
Den andra buggen uppkommer också när man valt att skicka ett mail till någon man inte har någon relation till men sedan ångrar sig och låter avmakera den man inte har någon relation till och istället väljer att skriva mail till någon/några man har någon relation till. Glömmer man då att fylla i något fält eller man valt någon som har en på sin block-lista vilket leder till att man får upp ett meddelande att mailet inte kunde sändas så försvinner medlemmen man inte har någon relation till ifrån listan.Sv: Blocka internmail om den man skickar till har på block-li
<code>
<%@ Language=VBScript %>
<%Option Explicit%>
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<html>
<head>
<SCRIPT type="text/JavaScript" SRC="NewMail.js" language="JavaScript"></SCRIPT>
</head>
<body>
<%
Function SQLDate(Value)
If IsDate(Value) Then
SQLDate = "'" & Year(Value) & "-" & Month(Value) & "-" & Day(Value) & " " & Hour(Value) & ":" & Minute(Value) & ":" & Second(Value) & "'"
Else
SQLDate = "Null"
End If
End Function
Function SQLText(Value)
Dim strTemp
If Len(Value) > 0 Then
strTemp = Value
strTemp = Replace(strTemp, "\", "\\")
strTemp = Replace(strTemp, "%", "\%")
strTemp = Replace(strTemp, "_", "\_")
strTemp = Replace(strTemp, "'", "\'")
strTemp = Replace(strTemp, """", "\""")
strTemp = Replace(strTemp, vbCr, "\n")
strTemp = Replace(strTemp, vbLf, "\r")
strTemp = Replace(strTemp, vbTab, "\t")
SQLText = "'" & strTemp & "'"
Else
SQLText = "Null"
End If
End Function
Function Find(Data, Value)
Dim Item
Find = False
If IsArray(Data) Then
For Each Item In Data
If Item = value Then
Find = True
Exit For
End If
Next
End If
End Function
Sub WriteReciverList(objCon, Recivers, Count)
Dim strSQL
Dim strLastTyp
Dim objGetData
If Count Then
strSQL = "SELECT medlemmar.id, medlemmar.username, medlemmar.status, relationer.typ, relationer.person" & vbCrLf & _
"FROM medlemmar LEFT JOIN relationer ON ((medlemmar.id = relationer.person) AND (relationer.id = " & lngMedlemsId & "))" & vbCrLf & _
"WHERE relationer.typ IN (1, 2) OR medlemmar.id IN (" & Join(Recivers, ", ") & ")" & vbCrLf & _
"ORDER BY relationer.typ, medlemmar.username"
Else
strSQL = "SELECT medlemmar.id, medlemmar.username, medlemmar.status, relationer.typ, relationer.person" & vbCrLf & _
"FROM medlemmar LEFT JOIN relationer ON ((medlemmar.id = relationer.person) AND (relationer.id = " & lngMedlemsId & "))" & vbCrLf & _
"WHERE relationer.typ IN (1, 2)" & vbCrLf & _
"ORDER BY relationer.typ, medlemmar.username"
End If
Set objGetData = Server.CreateObject("ADODB.Recordset")
objGetData.Open strSQL, objCon
strLastTyp = "!"
Do Until objGetData.EOF
If strLastTyp <> "" & objGetData("typ") Then
Select Case objGetData("typ")
Case 1
Response.Write "<OPTION VALUE="""" STYLE=""color: #ffffff; background-color: #333333;""> Kompisar:</OPTION>" & vbCrLf
Case 2
Response.Write "<OPTION VALUE="""" STYLE=""color: #ffffff; background-color: #333333;""> Idioter:</OPTION>" & vbCrLf
Case Else
Response.Write "<OPTION VALUE="""" STYLE=""color: #ffffff; background-color: #333333;""> Ingen relation:</OPTION>" & vbCrLf
End Select
strLastTyp = "" & objGetData("typ")
End If
If Find(Recivers, objGetData("id")) Then
Response.Write "<OPTION VALUE=""" & objGetData("id") & """ SELECTED> " & Server.HTMLEncode(objGetData("username")) & "</OPTION>" & vbCrLf
Else
Response.Write "<OPTION VALUE=""" & objGetData("id") & """> " & Server.HTMLEncode(objGetData("username")) & "</OPTION>" & vbCrLf
End If
objGetData.MoveNext
Loop
objGetData.Close
Set objGetData= Nothing
End Sub
Sub WriteForm(objCon, DefaultId, Recivers, Count, Subject, Status, Message)
%>
<FORM NAME="FormNewMail" ACTION="<% If IsNumeric(DefaultId) Then Response.Write "?id=" & DefaultId %>" METHOD=POST ID="Form1">
Skicka till:<br>
<SELECT NAME="Mail_Recivers" SIZE=5 multiple STYLE="width: 182px; BACKGROUND-COLOR: #FFFFFF; COLOR: #000000; FONT-FAMILY: Arial; FONT-SIZE: 11px; FONT-WEIGHT: bold;" MAXLENGTH=120 WIDTH="182" ID="Select1">
<% WriteReciverList objCon, Recivers, Count %>
</SELECT><br>
Ämnet:<br>
<INPUT type="text" NAME="Mail_Subject" SIZE=55 MAXLENGTH=120 CLASS="MailText" ID="Text1" value="<%Response.Write Server.HTMLEncode(Subject)%>"><br>
Status:<BR>
<label><INPUT TYPE="radio" NAME="Mail_Status" VALUE=51 <%If Status = 51 Then Response.Write "CHECKED "%>ID="Radio1">
Vanligt <IMG SRC="bilder/iconer/Mail_Normal_Unread.gif" BORDER=0 WIDTH=14 HEIGHT=9></label><BR>
<label><INPUT TYPE="radio" NAME="Mail_Status" VALUE=50 <%If Status = 50 Then Response.Write "CHECKED "%>ID="Radio2">
Viktigt <IMG SRC="bilder/iconer/Mail_Importent_Unread.gif" BORDER=0 WIDTH=14 HEIGHT=9></label><BR>
Meddelande:<BR>
<TEXTAREA NAME="Mail_Message" COLS=38 ROWS=12 WRAP=virtual ID="Textarea1"><%Response.Write Server.HTMLEncode(Message)%></TEXTAREA>
<BR>
<INPUT TYPE="submit" NAME="Action" value="Skicka mail" class="knapp" OnClick="Javascript:CheckFields();" ID="Button2" >
</FORM>
<%
End Sub
Dim objCon
Dim objGetData
Dim lngId
Dim lngMedlemsId
Dim lngStatus
Dim strId
Dim strSubject
Dim strError
Dim strMessage
Dim strSQL
Dim Count
Dim Recivers()
Dim DefaultId
DefaultId = Trim( Request.QueryString("id"))
'lngMedlemsId = 2
lngMedlemsId = Session("id")
Set objCon = Server.CreateObject("ADODB.Connection")
'objCon.Open "DRIVER={MySQL};DATABASE=hemligt;UID=hemligt;PWD=hemligt;SERVER=hemligt"
objCon.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Persist Security Info=False;" & _
"Data Source=C:\Inetpub\wwwroot\lumba\lumbadb.mdb;"
Select Case Request.Form("Action")
Case "Skicka mail"
For Each strId In Request.Form("Mail_Recivers")
If IsNumeric(strId) Then
Redim Preserve Recivers(Count)
Recivers(Count) = CLng(strId)
Count = Count + 1
End If
Next
If Count = 0 Then
strError = strError & "Markera mottagare!" & vbCrLf
End If
strSubject = Trim(Request.Form("Mail_Subject"))
If Len(strSubject) = 0 Then
strError = strError & "Ange ämne!" & vbCrLf
End If
lngStatus = Trim(Request.Form("Mail_Status"))
Select Case lngStatus
Case "50", "51"
lngStatus = CLng(lngStatus)
Case Else
lngStatus = 51
End Select
strMessage = Trim(Request.Form("Mail_Message"))
If Len(strMessage) = 0 Then
strError = strError & "Skriv ett meddelande!" & vbCrLf
End If
If Len(strError) Then
Response.Write "<H3>Ditt mail har inte skickats!</H3>"
Response.Write "<P>" & Server.HTMLEncode(strError) & "</P>"
WriteForm objCon, DefaultId, Recivers, Count, strSubject, lngStatus, strMessage
Else
strSQL = "SELECT medlemmar.username, medlemmar.id" & vbCrLf & _
"FROM relationer INNER JOIN medlemmar ON relationer.id = medlemmar.id" & vbCrLf & _
"WHERE relationer.typ=2 AND relationer.id IN (" & Join(Recivers, ", ") & ") AND person=" & lngMedlemsId
Set objGetData = Server.CreateObject("ADODB.Recordset")
objGetData.Open strSQL, objCon
If objGetData.EOF Then
objCon.Execute "INSERT INTO mails (Receiver_ID, Sender_ID, Status, Sendt_Date_Time, Subject, Message, Folder)" & vbCrLf & _
"SELECT medlemmar.id, " & lngMedlemsId & ", " & lngStatus & ", " & SQLDate(Now()) & ", " & SQLText(strSubject) & ", " & SQLText(strMessage) & ", 1" & vbCrLf & _
"FROM medlemmar" & vbCrLf & _
"WHERE medlemmar.id IN (" & Join(Recivers, ", ") & ")"
Response.Write "<H3>Ditt mail har skickats!</H3>"
Else
Response.Write "<H3>Ditt mail har inte skickats!</H3>"
Response.Write "<P>Följande personer har blokerat meddelande från dig:<BR>"
Response.Write "<UL>"
Do
Response.Write "<LI>" & Server.HTMLEncode(objGetData("username")) & "</LI>"
objGetData.MoveNext
Loop Until objGetData.EOF
Response.Write "</UL>"
Response.Write "Du kan inte skicka meddelande till dessa personer!<BR>"
Response.Write "Avmarkera dem och försök igen.</P>"
WriteForm objCon, DefaultId, Recivers, Count, strSubject, lngStatus, strMessage
End if
End If
Case Else
If IsNumeric(DefaultId) Then
Redim Recivers(0)
Recivers(0) = CLng(DefaultId)
Count = 1
End If
' #### BEGIN ## Om det finns någon singnatur ####
strSQL = "SELECT medlemmar.signatur" & vbCrLf & _
"FROM medlemmar" & vbCrLf & _
"WHERE medlemmar.signatur_ok = 1 AND medlemmar.id = " & lngMedlemsId
Set objGetData = Server.CreateObject("ADODB.Recordset")
objGetData.Open strSQL, objCon
If Not objGetData.EOF Then
strMessage = vbCrLf & vbCrLf & objGetData("signatur")
end if
objGetData.Close
' #### END ## Om det finns någon singnatur ####
Set objGetData= Nothing
WriteForm objCon, DefaultId, Recivers, Count, "", 51, strMessage
End Select
objCon.Close
Set objCon = Nothing
%>
</body>
</html>
</code>Sv: Blocka internmail om den man skickar till har på block-l
Bugg-beskrivning:
Den andra buggen uppkommer när man valt att skicka ett mail till någon man inte har någon relation
till men sedan ångrar sig och låter avmakera den man inte har någon relation till och istället väljer att
skriva mail till någon/några man har någon relation till istället. Glömmer man då att fylla i något fält
eller man valt någon som har en på sin block-lista vilket leder till att man får upp ett meddelande att
mailet inte kunde sändas så försvinner rubriken "Ingen relation:"+ medlemmen man inte har någon
relation till ifrån listan.Sv: Blocka internmail om den man skickar till har på block-
<code>
<%@ Language=VBScript %>
<%Option Explicit%>
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<html>
<head>
<SCRIPT type="text/JavaScript" SRC="NewMail.js" language="JavaScript"></SCRIPT>
</head>
<body>
<%
Function SQLDate(Value)
If IsDate(Value) Then
SQLDate = "'" & Year(Value) & "-" & Month(Value) & "-" & Day(Value) & " " & Hour(Value) & ":" & Minute(Value) & ":" & Second(Value) & "'"
Else
SQLDate = "Null"
End If
End Function
Function SQLText(Value)
Dim strTemp
If Len(Value) > 0 Then
strTemp = Value
strTemp = Replace(strTemp, "\", "\\")
strTemp = Replace(strTemp, "%", "\%")
strTemp = Replace(strTemp, "_", "\_")
strTemp = Replace(strTemp, "'", "\'")
strTemp = Replace(strTemp, """", "\""")
strTemp = Replace(strTemp, vbCr, "\n")
strTemp = Replace(strTemp, vbLf, "\r")
strTemp = Replace(strTemp, vbTab, "\t")
SQLText = "'" & strTemp & "'"
Else
SQLText = "Null"
End If
End Function
Function Find(Data, Value)
Dim Item
Find = False
If IsArray(Data) Then
For Each Item In Data
If Item = value Then
Find = True
Exit For
End If
Next
End If
End Function
Sub WriteReciverList(objCon, Users, UserCount, Recivers, ReciverCount)
Dim strSQL
Dim strLastTyp
Dim objGetData
If UserCount Then
strSQL = "SELECT medlemmar.id, medlemmar.username, medlemmar.status, relationer.typ, relationer.person" & vbCrLf & _
"FROM medlemmar LEFT JOIN relationer ON ((medlemmar.id = relationer.person) AND (relationer.id = " & lngMedlemsId & "))" & vbCrLf & _
"WHERE relationer.typ IN (1, 2) OR medlemmar.id IN (" & Join(Users, ", ") & ")" & vbCrLf & _
"ORDER BY relationer.typ, medlemmar.username"
Else
strSQL = "SELECT medlemmar.id, medlemmar.username, medlemmar.status, relationer.typ, relationer.person" & vbCrLf & _
"FROM medlemmar LEFT JOIN relationer ON ((medlemmar.id = relationer.person) AND (relationer.id = " & lngMedlemsId & "))" & vbCrLf & _
"WHERE relationer.typ IN (1, 2)" & vbCrLf & _
"ORDER BY relationer.typ, medlemmar.username"
End If
Set objGetData = Server.CreateObject("ADODB.Recordset")
objGetData.Open strSQL, objCon
strLastTyp = "!"
Do Until objGetData.EOF
If strLastTyp <> "" & objGetData("typ") Then
Select Case objGetData("typ")
Case 1
Response.Write "<OPTION VALUE="""" STYLE=""color: #ffffff; background-color: #333333;""> Kompisar:</OPTION>" & vbCrLf
Case 2
Response.Write "<OPTION VALUE="""" STYLE=""color: #ffffff; background-color: #333333;""> Idioter:</OPTION>" & vbCrLf
Case Else
Response.Write "<OPTION VALUE="""" STYLE=""color: #ffffff; background-color: #333333;""> Ingen relation:</OPTION>" & vbCrLf
End Select
strLastTyp = "" & objGetData("typ")
End If
If Find(Recivers, objGetData("id")) Then
Response.Write "<OPTION VALUE=""" & objGetData("id") & """ SELECTED> " & Server.HTMLEncode(objGetData("username")) & "</OPTION>" & vbCrLf
Else
Response.Write "<OPTION VALUE=""" & objGetData("id") & """> " & Server.HTMLEncode(objGetData("username")) & "</OPTION>" & vbCrLf
End If
objGetData.MoveNext
Loop
objGetData.Close
Set objGetData= Nothing
End Sub
Sub WriteForm(objCon, Users, UserCount, Recivers, ReciverCount, Subject, Status, Message)
%>
<FORM NAME="FormNewMail" ACTION="<% If UserCount Then Response.Write "?id=" & Join(Users, "&id=") %>" METHOD=POST ID="Form1">
Skicka till:<br>
<SELECT NAME="Mail_Recivers" SIZE=5 multiple STYLE="width: 182px; BACKGROUND-COLOR: #FFFFFF; COLOR: #000000; FONT-FAMILY: Arial; FONT-SIZE: 11px; FONT-WEIGHT: bold;" MAXLENGTH=120 WIDTH="182" ID="Select1">
<% WriteReciverList objCon, Users, UserCount, Recivers, ReciverCount %>
</SELECT><br>
Ämnet:<br>
<INPUT type="text" NAME="Mail_Subject" SIZE=55 MAXLENGTH=120 CLASS="MailText" ID="Text1" value="<%Response.Write Server.HTMLEncode(Subject)%>"><br>
Status:<BR>
<label><INPUT TYPE="radio" NAME="Mail_Status" VALUE=51 <%If Status = 51 Then Response.Write "CHECKED "%>ID="Radio1">
Vanligt <IMG SRC="bilder/iconer/Mail_Normal_Unread.gif" BORDER=0 WIDTH=14 HEIGHT=9></label><BR>
<label><INPUT TYPE="radio" NAME="Mail_Status" VALUE=50 <%If Status = 50 Then Response.Write "CHECKED "%>ID="Radio2">
Viktigt <IMG SRC="bilder/iconer/Mail_Importent_Unread.gif" BORDER=0 WIDTH=14 HEIGHT=9></label><BR>
Meddelande:<BR>
<TEXTAREA NAME="Mail_Message" COLS=38 ROWS=12 WRAP=virtual ID="Textarea1"><%Response.Write Server.HTMLEncode(Message)%></TEXTAREA>
<BR>
<INPUT TYPE="submit" NAME="Action" value="Skicka mail" class="knapp" OnClick="Javascript:CheckFields();" ID="Button2" >
</FORM>
<%
End Sub
Dim objCon
Dim objGetData
Dim lngId
Dim lngMedlemsId
Dim lngStatus
Dim strId
Dim strSubject
Dim strSQL
Dim strError
Dim strMessage
Dim Users()
Dim UserCount
Dim Recivers()
Dim ReciverCount
lngMedlemsId = 2
'lngMedlemsId = Session("id")
For Each strId In Request.QueryString("id")
If IsNumeric(strId) Then
Redim Preserve Users(UserCount)
Users(UserCount) = CLng(strId)
UserCount = UserCount + 1
End If
Next
Set objCon = Server.CreateObject("ADODB.Connection")
'objCon.Open "DRIVER={MySQL};DATABASE=hemligt;UID=hemligt;PWD=hemligt;SERVER=hemligt"
objCon.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Persist Security Info=False;" & _
"Data Source=C:\Inetpub\wwwroot\lumba\lumbadb.mdb;"
Select Case Request.Form("Action")
Case "Skicka mail"
For Each strId In Request.Form("Mail_Recivers")
If IsNumeric(strId) Then
Redim Preserve Recivers(ReciverCount)
Recivers(ReciverCount) = CLng(strId)
ReciverCount = ReciverCount + 1
End If
Next
If ReciverCount = 0 Then
strError = strError & "Markera mottagare!" & vbCrLf
End If
strSubject = Trim(Request.Form("Mail_Subject"))
If Len(strSubject) = 0 Then
strError = strError & "Ange ämne!" & vbCrLf
End If
lngStatus = Trim(Request.Form("Mail_Status"))
Select Case lngStatus
Case "50", "51"
lngStatus = CLng(lngStatus)
Case Else
lngStatus = 51
End Select
strMessage = Trim(Request.Form("Mail_Message"))
If Len(strMessage) = 0 Then
strError = strError & "Skriv ett meddelande!" & vbCrLf
End If
If Len(strError) Then
Response.Write "<H3>Ditt mail har inte skickats!</H3>"
Response.Write "<P>" & Server.HTMLEncode(strError) & "</P>"
WriteForm objCon, Users, UserCount, Recivers, ReciverCount, strSubject, lngStatus, strMessage
Else
strSQL = "SELECT medlemmar.username, medlemmar.id" & vbCrLf & _
"FROM relationer INNER JOIN medlemmar ON relationer.id = medlemmar.id" & vbCrLf & _
"WHERE relationer.typ=2 AND relationer.id IN (" & Join(Recivers, ", ") & ") AND person=" & lngMedlemsId
Set objGetData = Server.CreateObject("ADODB.Recordset")
objGetData.Open strSQL, objCon
If objGetData.EOF Then
objCon.Execute "INSERT INTO mails (Receiver_ID, Sender_ID, Status, Sendt_Date_Time, Subject, Message, Folder)" & vbCrLf & _
"SELECT medlemmar.id, " & lngMedlemsId & ", " & lngStatus & ", " & SQLDate(Now()) & ", " & SQLText(strSubject) & ", " & SQLText(strMessage) & ", 1" & vbCrLf & _
"FROM medlemmar" & vbCrLf & _
"WHERE medlemmar.id IN (" & Join(Recivers, ", ") & ")"
Response.Write "<H3>Ditt mail har skickats!</H3>"
Else
Response.Write "<H3>Ditt mail har inte skickats!</H3>"
Response.Write "<P>Följande personer har blokerat meddelande från dig:<BR>"
Response.Write "<UL>"
Do
Response.Write "<LI>" & Server.HTMLEncode(objGetData("username")) & "</LI>"
objGetData.MoveNext
Loop Until objGetData.EOF
Response.Write "</UL>"
Response.Write "Du kan inte skicka meddelande till dessa personer!<BR>"
Response.Write "Avmarkera dem och försök igen.</P>"
WriteForm objCon, Users, UserCount, Recivers, ReciverCount, strSubject, lngStatus, strMessage
End if
End If
Case Else
' #### BEGIN ## Om det finns någon singnatur ####
strSQL = "SELECT medlemmar.signatur" & vbCrLf & _
"FROM medlemmar" & vbCrLf & _
"WHERE medlemmar.signatur_ok = 1 AND medlemmar.id = " & lngMedlemsId
Set objGetData = Server.CreateObject("ADODB.Recordset")
objGetData.Open strSQL, objCon
If Not objGetData.EOF Then
strMessage = vbCrLf & vbCrLf & objGetData("signatur")
end if
objGetData.Close
' #### END ## Om det finns någon singnatur ####
Set objGetData= Nothing
WriteForm objCon, Users, UserCount, Recivers, ReciverCount, "", 51, strMessage
End Select
objCon.Close
Set objCon = Nothing
%>
</body>
</html>
</code>Sv: Blocka internmail om den man skickar till har på block
Lista på vad som blir fel:
* Om man väljer att skriva mail till en man inte har någon relation till så kommer den under Ingen relation, bra. Men den medlemmen är inte makerad, så var det i förra koden och det tyckte jag var jävligt smidigt.
* varken rubriken "Idioter:" eller medlemmarna som skall listas under "Idioter:" skrivs ut. Kompisarna listas dock under "Kompisar:", precis som de skall.
* I medelande-fältet infogas inte signaturen.
* När man klickar på knappen "Skicka mail" så kommer man till adressen www.domän.se/2 och inte till www.domän.se/mail_skriv.asp?id=2. Och inget mail skickats iväg :(Sv: Blocka internmail om den man skickar till har på bloc
<code>
<%@ Language=VBScript %>
<%Option Explicit%>
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<html>
<head>
<SCRIPT type="text/JavaScript" SRC="NewMail.js" language="JavaScript"></SCRIPT>
</head>
<body>
<%
Function SQLDate(Value)
If IsDate(Value) Then
SQLDate = "'" & Year(Value) & "-" & Month(Value) & "-" & Day(Value) & " " & Hour(Value) & ":" & Minute(Value) & ":" & Second(Value) & "'"
Else
SQLDate = "Null"
End If
End Function
Function SQLText(Value)
Dim strTemp
If Len(Value) > 0 Then
strTemp = Value
strTemp = Replace(strTemp, "\", "\\")
strTemp = Replace(strTemp, "%", "\%")
strTemp = Replace(strTemp, "_", "\_")
strTemp = Replace(strTemp, "'", "\'")
strTemp = Replace(strTemp, """", "\""")
strTemp = Replace(strTemp, vbCr, "\n")
strTemp = Replace(strTemp, vbLf, "\r")
strTemp = Replace(strTemp, vbTab, "\t")
SQLText = "'" & strTemp & "'"
Else
SQLText = "Null"
End If
End Function
Function Find(Data, Value)
Dim Item
Find = False
If IsArray(Data) Then
For Each Item In Data
If Item = value Then
Find = True
Exit For
End If
Next
End If
End Function
Sub WriteReciverList(objCon, Users, UserCount, Recivers, ReciverCount)
Dim strSQL
Dim strLastTyp
Dim objGetData
If UserCount Then
strSQL = "SELECT medlemmar.id, medlemmar.username, medlemmar.status, relationer.typ, relationer.person" & vbCrLf & _
"FROM medlemmar LEFT JOIN relationer ON ((medlemmar.id = relationer.person) AND (relationer.id = " & lngMedlemsId & "))" & vbCrLf & _
"WHERE relationer.typ IN (1, 2) OR medlemmar.id IN (" & Join(Users, ", ") & ")" & vbCrLf & _
"ORDER BY relationer.typ, medlemmar.username"
Else
strSQL = "SELECT medlemmar.id, medlemmar.username, medlemmar.status, relationer.typ, relationer.person" & vbCrLf & _
"FROM medlemmar LEFT JOIN relationer ON ((medlemmar.id = relationer.person) AND (relationer.id = " & lngMedlemsId & "))" & vbCrLf & _
"WHERE relationer.typ IN (1, 2)" & vbCrLf & _
"ORDER BY relationer.typ, medlemmar.username"
End If
Set objGetData = Server.CreateObject("ADODB.Recordset")
objGetData.Open strSQL, objCon
strLastTyp = "!"
Do Until objGetData.EOF
If strLastTyp <> "" & objGetData("typ") Then
Select Case objGetData("typ")
Case 1
Response.Write "<OPTION VALUE="""" STYLE=""color: #ffffff; background-color: #333333;""> Kompisar:</OPTION>" & vbCrLf
Case 2
Response.Write "<OPTION VALUE="""" STYLE=""color: #ffffff; background-color: #333333;""> Idioter:</OPTION>" & vbCrLf
Case Else
Response.Write "<OPTION VALUE="""" STYLE=""color: #ffffff; background-color: #333333;""> Ingen relation:</OPTION>" & vbCrLf
End Select
strLastTyp = "" & objGetData("typ")
End If
If Find(Recivers, objGetData("id")) Then
Response.Write "<OPTION VALUE=""" & objGetData("id") & """ SELECTED> " & Server.HTMLEncode(objGetData("username")) & "</OPTION>" & vbCrLf
Else
Response.Write "<OPTION VALUE=""" & objGetData("id") & """> " & Server.HTMLEncode(objGetData("username")) & "</OPTION>" & vbCrLf
End If
objGetData.MoveNext
Loop
objGetData.Close
Set objGetData= Nothing
End Sub
Sub WriteForm(objCon, Users, UserCount, Recivers, ReciverCount, Subject, Status, Message)
%>
<FORM NAME="FormNewMail" ACTION="<% If UserCount Then Response.Write "?id=" & Join(Users, "&id=") %>" METHOD=POST ID="Form1">
Skicka till:<br>
<SELECT NAME="Mail_Recivers" SIZE=5 multiple STYLE="width: 182px; BACKGROUND-COLOR: #FFFFFF; COLOR: #000000; FONT-FAMILY: Arial; FONT-SIZE: 11px; FONT-WEIGHT: bold;" MAXLENGTH=120 WIDTH="182" ID="Select1">
<% WriteReciverList objCon, Users, UserCount, Recivers, ReciverCount %>
</SELECT><br>
Ämnet:<br>
<INPUT type="text" NAME="Mail_Subject" SIZE=55 MAXLENGTH=120 CLASS="MailText" ID="Text1" value="<%Response.Write Server.HTMLEncode(Subject)%>"><br>
Status:<BR>
<label><INPUT TYPE="radio" NAME="Mail_Status" VALUE=51 <%If Status = 51 Then Response.Write "CHECKED "%>ID="Radio1">
Vanligt <IMG SRC="bilder/iconer/Mail_Normal_Unread.gif" BORDER=0 WIDTH=14 HEIGHT=9></label><BR>
<label><INPUT TYPE="radio" NAME="Mail_Status" VALUE=50 <%If Status = 50 Then Response.Write "CHECKED "%>ID="Radio2">
Viktigt <IMG SRC="bilder/iconer/Mail_Importent_Unread.gif" BORDER=0 WIDTH=14 HEIGHT=9></label><BR>
Meddelande:<BR>
<TEXTAREA NAME="Mail_Message" COLS=38 ROWS=12 WRAP=virtual ID="Textarea1"><%Response.Write Server.HTMLEncode(Message)%></TEXTAREA>
<BR>
<INPUT TYPE="submit" NAME="Action" value="Skicka mail" class="knapp" OnClick="Javascript:CheckFields();" ID="Button2" >
</FORM>
<%
End Sub
Dim objCon
Dim objGetData
Dim lngId
Dim lngMedlemsId
Dim lngStatus
Dim strId
Dim strSubject
Dim strSQL
Dim strError
Dim strMessage
Dim Users()
Dim UserCount
Dim Recivers()
Dim ReciverCount
'lngMedlemsId = 2
lngMedlemsId = Session("id")
For Each strId In Request.QueryString("id")
If IsNumeric(strId) Then
Redim Preserve Users(UserCount)
Users(UserCount) = CLng(strId)
UserCount = UserCount + 1
End If
Next
Set objCon = Server.CreateObject("ADODB.Connection")
'objCon.Open "DRIVER={MySQL};DATABASE=hemligt;UID=hemligt;PWD=hemligt;SERVER=hemligt"
objCon.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Persist Security Info=False;" & _
"Data Source=C:\Inetpub\wwwroot\lumba\lumbadb.mdb;"
Select Case Request.Form("Action")
Case "Skicka mail"
For Each strId In Request.Form("Mail_Recivers")
If IsNumeric(strId) Then
Redim Preserve Recivers(ReciverCount)
Recivers(ReciverCount) = CLng(strId)
ReciverCount = ReciverCount + 1
End If
Next
If ReciverCount = 0 Then
strError = strError & "Markera mottagare!" & vbCrLf
End If
strSubject = Trim(Request.Form("Mail_Subject"))
If Len(strSubject) = 0 Then
strError = strError & "Ange ämne!" & vbCrLf
End If
lngStatus = Trim(Request.Form("Mail_Status"))
Select Case lngStatus
Case "50", "51"
lngStatus = CLng(lngStatus)
Case Else
lngStatus = 51
End Select
strMessage = Trim(Request.Form("Mail_Message"))
If Len(strMessage) = 0 Then
strError = strError & "Skriv ett meddelande!" & vbCrLf
End If
If Len(strError) Then
Response.Write "<H3>Ditt mail har inte skickats!</H3>"
Response.Write "<P>" & Server.HTMLEncode(strError) & "</P>"
WriteForm objCon, Users, UserCount, Recivers, ReciverCount, strSubject, lngStatus, strMessage
Else
strSQL = "SELECT medlemmar.username, medlemmar.id" & vbCrLf & _
"FROM relationer INNER JOIN medlemmar ON relationer.id = medlemmar.id" & vbCrLf & _
"WHERE relationer.typ=2 AND relationer.id IN (" & Join(Recivers, ", ") & ") AND person=" & lngMedlemsId
Set objGetData = Server.CreateObject("ADODB.Recordset")
objGetData.Open strSQL, objCon
If objGetData.EOF Then
objCon.Execute "INSERT INTO mails (Receiver_ID, Sender_ID, Status, Sendt_Date_Time, Subject, Message, Folder)" & vbCrLf & _
"SELECT medlemmar.id, " & lngMedlemsId & ", " & lngStatus & ", " & SQLDate(Now()) & ", " & SQLText(strSubject) & ", " & SQLText(strMessage) & ", 1" & vbCrLf & _
"FROM medlemmar" & vbCrLf & _
"WHERE medlemmar.id IN (" & Join(Recivers, ", ") & ")"
Response.Write "<H3>Ditt mail har skickats!</H3>"
Else
Response.Write "<H3>Ditt mail har inte skickats!</H3>"
Response.Write "<P>Följande personer har blokerat meddelande från dig:<BR>"
Response.Write "<UL>"
Do
Response.Write "<LI>" & Server.HTMLEncode(objGetData("username")) & "</LI>"
objGetData.MoveNext
Loop Until objGetData.EOF
Response.Write "</UL>"
Response.Write "Du kan inte skicka meddelande till dessa personer!<BR>"
Response.Write "Avmarkera dem och försök igen.</P>"
WriteForm objCon, Users, UserCount, Recivers, ReciverCount, strSubject, lngStatus, strMessage
End if
End If
Case Else
If UserCount Then
'Recivers = Users
'ReciverCount = UserCount
Redim Recivers(UserCount)
For Each lngId In Users
Recivers(ReciverCount) = lngId
ReciverCount = ReciverCount + 1
Next
End If
' #### BEGIN ## Om det finns någon singnatur ####
strSQL = "SELECT medlemmar.signatur" & vbCrLf & _
"FROM medlemmar" & vbCrLf & _
"WHERE medlemmar.signatur_ok = 1 AND medlemmar.id = " & lngMedlemsId
Set objGetData = Server.CreateObject("ADODB.Recordset")
objGetData.Open strSQL, objCon
If Not objGetData.EOF Then
strMessage = vbCrLf & vbCrLf & objGetData("signatur")
end if
objGetData.Close
' #### END ## Om det finns någon singnatur ####
Set objGetData= Nothing
WriteForm objCon, Users, UserCount, Recivers, ReciverCount, "", 51, strMessage
End Select
objCon.Close
Set objCon = Nothing
%>
</body>
</html>
</code>Sv: Blocka internmail om den man skickar till har på blo
...om det skulle visa sig att det är något som inte fungerar som det ska och jag inte kan fixa det så får jag väll helt enkelt återkomma. Ändar denna tråd till löst så länge.
Har du fått presentkortet från SF än?