Fetstil Fetstil Kursiv Understrykning linje färgläggning tabellverk Punktlista Nummerlista Vänster Centrerat högerställt Utfyllt Länk Bild htmlmode
  • Forum & Blog
    • Forum - översikt
      • .Net
        • asp.net generellt
        • c#
        • vb.net
        • f#
        • silverlight
        • microsoft surface
        • visual studio .net
      • databaser
        • sql-server
        • databaser
        • access
        • mysql
      • mjukvara klient
        • datorer och komponenter
        • nätverk, lan/wan
        • operativsystem
        • programvaror
        • säkerhet, inställningar
        • windows server
        • allmänt
        • crystal reports
        • exchange/outlook
        • microsoft office
      • mjukvara server
        • active directory
        • biztalk
        • exchange
        • linux
        • sharepoint
        • webbservers
        • sql server
      • appar (win/mobil)
      • programspråk
        • c++
        • delphi
        • java
        • quick basic
        • visual basic
      • scripting
        • asp 3.0
        • flash actionscript
        • html css
        • javascript
        • php
        • regular expresssion
        • xml
      • spel och grafik
        • DirectX
        • Spel och grafik
      • ledning
        • Arkitektur
        • Systemutveckling
        • krav och test
        • projektledning
        • ledningsfrågor
      • vb-sektioner
        • activeX
        • windows api
        • elektronik
        • internet
        • komponenter
        • nätverk
        • operativsystem
      • övriga forum
        • arbete karriär
        • erbjuda uppdrag och tjänster
        • juridiska frågor
        • köp och sälj
        • matematik och fysik
        • intern information
        • skrivklåda
        • webb-operatörer
    • Posta inlägg i forumet
    • Chatta med andra
  • Konto
    • Medlemssida
    • Byta lösenord
    • Bli bonsumedlem
    • iMail
  • Material
    • Tips & tricks
    • Artiklar
    • Programarkiv
  • JOBB
  • Student
    • Studentlicenser
  • KONTAKT
    • Om pellesoft
    • Grundare
    • Kontakta oss
    • Annonsering
    • Partners
    • Felanmälan
  • Logga in

Hem / Forum översikt / inlägg

Posta nytt inlägg


Blocka internmail om den man skickar till har på block-lista

Postades av 2004-06-21 22:35:11 - Johan Svensson, i forum asp - allmänt, Tråden har 27 Kommentarer och lästs av 604 personer

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.

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&""
%>


Svara

Sv: Blocka internmail om den man skickar till har på block-lista

Postades av 2004-06-22 09:51:37 - Andreas Hillqvist

Här är ett exempel:
<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>


Svara

Sv: Blocka internmail om den man skickar till har på block-lista

Postades av 2004-06-23 19:04:16 - Johan Svensson

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.

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.


Svara

Sv: Blocka internmail om den man skickar till har på block-lista

Postades av 2004-06-25 22:25:47 - Andreas Hillqvist

>
>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?


Svara

Sv: Blocka internmail om den man skickar till har på block-lista

Postades av 2004-07-06 19:53:12 - Johan Svensson

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.

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


Svara

Sv: Blocka internmail om den man skickar till har på block-lista

Postades av 2004-07-08 22:15:46 - Andreas Hillqvist

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.


Svara

Sv: Blocka internmail om den man skickar till har på block-lista

Postades av 2004-07-11 01:15:49 - Johan Svensson

Jag förstår.

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;"">&nbsp;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 & ">&nbsp; &nbsp;" &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;"">&nbsp;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 & ">&nbsp; &nbsp;" &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;"">&nbsp;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 & ">&nbsp; &nbsp;" &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&nbsp;<IMG SRC="bilder/iconer/Mail_Normal_Unread.gif" BORDER=0 WIDTH=14 HEIGHT=9>
<BR>

<INPUT TYPE="radio" NAME="Mail_Status" VALUE=50>
Viktigt&nbsp;<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&ouml;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>


Svara

Sv: Blocka internmail om den man skickar till har på block-lista

Postades av 2004-07-11 14:31:25 - Andreas Hillqvist

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.

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;"">&nbsp;Kompisar:</OPTION>" & vbCrLf
Case 2
Response.Write "<OPTION VALUE="""" STYLE=""color: #ffffff; background-color: #333333;"">&nbsp;Idioter:</OPTION>" & vbCrLf
Case Else
Response.Write "<OPTION VALUE="""" STYLE=""color: #ffffff; background-color: #333333;"">&nbsp;Ingen relation:</OPTION>" & vbCrLf
End Select
strLastTyp = "" & objGetData("typ")
End If

If Find(Recivers, objGetData("id")) Then
Response.Write "<OPTION VALUE=""" & objGetData("id") & """ SELECTED>&nbsp; &nbsp;" & Server.HTMLEncode(objGetData("username")) & "</OPTION>" & vbCrLf
Else
Response.Write "<OPTION VALUE=""" & objGetData("id") & """>&nbsp; &nbsp;" & 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&nbsp;<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&nbsp;<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.


Svara

Sv: Blocka internmail om den man skickar till har på block-lista

Postades av 2004-07-11 16:02:28 - Johan Svensson

Får följande fel när jag testade din kod:


Microsoft VBScript compilation error '800a0414'

Cannot use parentheses when calling a Sub

/mail_skriv.asp, line 90

WriteReciverList(objCon, Recivers)
----------------------------------^





"^" pekar efter ")"


Svara

Sv: Blocka internmail om den man skickar till har på block-lista

Postades av 2004-07-11 16:49:58 - Andreas Hillqvist

Skriv istället:
<code>
WriteReciverList objCon, Recivers
</code>
Eller:
<code>
Call WriteReciverList(objCon, Recivers)
</code>


Svara

Sv: Blocka internmail om den man skickar till har på block-lista

Postades av 2004-07-11 17:12:02 - Johan Svensson

Japp det funkade men då kom detta upp:

Microsoft VBScript compilation error '800a03ee'

Expected ')'

/mail_skriv.asp, line 133

Redim Preserve Recivers(1 to Count)
--------------------------^




"^" pekar på "t"


Svara

Sv: Blocka internmail om den man skickar till har på block-lista

Postades av 2004-07-11 18:12:36 - Johan Svensson

...har verkligen ingen koll ur jag fixar ovanstående fel.


Svara

Sv: Blocka internmail om den man skickar till har på block-lista

Postades av 2004-07-12 01:46:40 - Andreas Hillqvist

Testa att ändra dim-satsen, i början av koden, för Recivers till:
<code>
Dim Recivers()
</code>
Eller ta bort "1 to":
<code>
Redim Preserve Recivers(Count)
</code>


Svara

Sv: Blocka internmail om den man skickar till har på block-lista

Postades av 2004-08-03 11:29:56 - Johan Svensson

Ok.
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.


Svara

Sv: Blocka internmail om den man skickar till har på block-lista

Postades av 2004-08-04 10:20:42 - Andreas Hillqvist

Skickar du med ett id i din Querystring? Kan vara så att WriteReciverList inte kan hantera en tom array.


Svara

Sv: Blocka internmail om den man skickar till har på block-lista

Postades av 2004-08-04 11:37:16 - Johan Svensson

Jo det gör jag

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.


Svara

Sv: Blocka internmail om den man skickar till har på block-lista

Postades av 2004-08-10 17:34:12 - Andreas Hillqvist

Detta hunkar. Men har då testat mot Access. Vi får se om MySQL klarar av frågan.
<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;"">&nbsp;Kompisar:</OPTION>" & vbCrLf
Case 2
Response.Write "<OPTION VALUE="""" STYLE=""color: #ffffff; background-color: #333333;"">&nbsp;Idioter:</OPTION>" & vbCrLf
Case Else
Response.Write "<OPTION VALUE="""" STYLE=""color: #ffffff; background-color: #333333;"">&nbsp;Ingen relation:</OPTION>" & vbCrLf
End Select
strLastTyp = "" & objGetData("typ")
End If

If Find(Recivers, objGetData("id")) Then
Response.Write "<OPTION VALUE=""" & objGetData("id") & """ SELECTED>&nbsp; &nbsp;" & Server.HTMLEncode(objGetData("username")) & "</OPTION>" & vbCrLf
Else
Response.Write "<OPTION VALUE=""" & objGetData("id") & """>&nbsp; &nbsp;" & 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&nbsp;<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&nbsp;<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>


Svara

Sv: Blocka internmail om den man skickar till har på block-lista

Postades av 2004-08-10 20:48:17 - Johan Svensson

Fungerar fram tills jag klickar på "Skicka mail".


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)


Svara

Sv: Blocka internmail om den man skickar till har på block-lista

Postades av 2004-08-10 21:54:54 - Andreas Hillqvist

*Ler*

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;"">&nbsp;Kompisar:</OPTION>" & vbCrLf
Case 2
Response.Write "<OPTION VALUE="""" STYLE=""color: #ffffff; background-color: #333333;"">&nbsp;Idioter:</OPTION>" & vbCrLf
Case Else
Response.Write "<OPTION VALUE="""" STYLE=""color: #ffffff; background-color: #333333;"">&nbsp;Ingen relation:</OPTION>" & vbCrLf
End Select
strLastTyp = "" & objGetData("typ")
End If

If Find(Recivers, objGetData("id")) Then
Response.Write "<OPTION VALUE=""" & objGetData("id") & """ SELECTED>&nbsp; &nbsp;" & Server.HTMLEncode(objGetData("username")) & "</OPTION>" & vbCrLf
Else
Response.Write "<OPTION VALUE=""" & objGetData("id") & """>&nbsp; &nbsp;" & 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&nbsp;<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&nbsp;<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>


Svara

Sv: Blocka internmail om den man skickar till har på block-list

Postades av 2004-08-10 22:25:48 - Johan Svensson

Testkört det hela nu och det verkar fungera.
Fanken va gött!!!

Tack så mycket!


Svara

Sv: Blocka internmail om den man skickar till har på block-lis

Postades av 2004-08-19 21:45:46 - Johan Svensson

Aj då. Funnit några buggar.

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.


Svara

Sv: Blocka internmail om den man skickar till har på block-li

Postades av 2004-08-20 12:58:37 - Andreas Hillqvist

Är i skolan så jag kan inte felsöka. Du kan testa följande kod:
<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;"">&nbsp;Kompisar:</OPTION>" & vbCrLf
Case 2
Response.Write "<OPTION VALUE="""" STYLE=""color: #ffffff; background-color: #333333;"">&nbsp;Idioter:</OPTION>" & vbCrLf
Case Else
Response.Write "<OPTION VALUE="""" STYLE=""color: #ffffff; background-color: #333333;"">&nbsp;Ingen relation:</OPTION>" & vbCrLf
End Select
strLastTyp = "" & objGetData("typ")
End If

If Find(Recivers, objGetData("id")) Then
Response.Write "<OPTION VALUE=""" & objGetData("id") & """ SELECTED>&nbsp; &nbsp;" & Server.HTMLEncode(objGetData("username")) & "</OPTION>" & vbCrLf
Else
Response.Write "<OPTION VALUE=""" & objGetData("id") & """>&nbsp; &nbsp;" & 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&nbsp;<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&nbsp;<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>


Svara

Sv: Blocka internmail om den man skickar till har på block-l

Postades av 2004-08-20 13:38:01 - Johan Svensson

Ok nu är första buggen fixad, tack. Den andra buggen finns dock kvar.

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.


Svara

Sv: Blocka internmail om den man skickar till har på block-

Postades av 2004-08-20 23:52:30 - Andreas Hillqvist

Tror jag fixat till det 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, 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;"">&nbsp;Kompisar:</OPTION>" & vbCrLf
Case 2
Response.Write "<OPTION VALUE="""" STYLE=""color: #ffffff; background-color: #333333;"">&nbsp;Idioter:</OPTION>" & vbCrLf
Case Else
Response.Write "<OPTION VALUE="""" STYLE=""color: #ffffff; background-color: #333333;"">&nbsp;Ingen relation:</OPTION>" & vbCrLf
End Select
strLastTyp = "" & objGetData("typ")
End If

If Find(Recivers, objGetData("id")) Then
Response.Write "<OPTION VALUE=""" & objGetData("id") & """ SELECTED>&nbsp; &nbsp;" & Server.HTMLEncode(objGetData("username")) & "</OPTION>" & vbCrLf
Else
Response.Write "<OPTION VALUE=""" & objGetData("id") & """>&nbsp; &nbsp;" & 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&nbsp;<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&nbsp;<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>


Svara

Sv: Blocka internmail om den man skickar till har på block

Postades av 2004-08-21 13:31:08 - Johan Svensson

Blev en del fel med den nya koden.

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 :(


Svara

Sv: Blocka internmail om den man skickar till har på bloc

Postades av 2004-08-21 13:53:33 - Andreas Hillqvist

Testa med:
<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;"">&nbsp;Kompisar:</OPTION>" & vbCrLf
Case 2
Response.Write "<OPTION VALUE="""" STYLE=""color: #ffffff; background-color: #333333;"">&nbsp;Idioter:</OPTION>" & vbCrLf
Case Else
Response.Write "<OPTION VALUE="""" STYLE=""color: #ffffff; background-color: #333333;"">&nbsp;Ingen relation:</OPTION>" & vbCrLf
End Select
strLastTyp = "" & objGetData("typ")
End If

If Find(Recivers, objGetData("id")) Then
Response.Write "<OPTION VALUE=""" & objGetData("id") & """ SELECTED>&nbsp; &nbsp;" & Server.HTMLEncode(objGetData("username")) & "</OPTION>" & vbCrLf
Else
Response.Write "<OPTION VALUE=""" & objGetData("id") & """>&nbsp; &nbsp;" & 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&nbsp;<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&nbsp;<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>


Svara

Sv: Blocka internmail om den man skickar till har på blo

Postades av 2004-08-21 14:48:54 - Johan Svensson

Verkar fungera nu, TACK!!!

...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?


Svara

Sv: Blocka internmail om den man skickar till har på bl

Postades av 2004-08-22 03:53:36 - Andreas Hillqvist

Jepp... Tackar så mycket.


Svara

Nyligen

  • 08:28 Butiksskyltar: Hur upplever utbude
  • 22:31 Slappna av
  • 19:55 kick-off med fokus på hälsa?
  • 19:53 kick-off med fokus på hälsa?
  • 16:24 Föreslå en skönhetsklinik online
  • 16:23 Föreslå en skönhetsklinik online
  • 18:42 Hvor finder man håndlavede lamper
  • 18:41 Hvor finder man håndlavede lamper

Sidor

  • Hem
  • Bli bonusmedlem
  • Läs artiklar
  • Chatta med andra
  • Sök och erbjud jobb
  • Kontakta oss
  • Studentlicenser
  • Skriv en artikel

Statistik

Antal besökare:
Antal medlemmar:
Antal inlägg:
Online:
På chatten:
4 570 786
27 960
271 761
718
0

Kontakta oss

Frågor runt konsultation, rådgivning, uppdrag, rekrytering, annonsering och övriga ärenden. Ring: 0730-88 22 24 | pelle@pellesoft.se

© 1986-2013 PelleSoft AB. Last Build 4.1.7169.18070 (2019-08-18 10:02:21) 4.0.30319.42000
  • Om
  • Kontakta
  • Regler
  • Cookies