<%Dim fullname, pprefix, pnum, fprefix, fnum, cprefix, cnum, email, remarks, isok, xmsg, rc, body, ToEmail, phone, fax, cell
isok = True : ToEmail = "studio2www@gmail.com"
If Request.Form <> "" Then
fullname = Request.Form("fullname") : pprefix = Request.Form("pprefix") : pnum = Request.Form("pnum") : fprefix = Request.Form("fprefix")
fnum = Request.Form("fnum") : cprefix = Request.Form("cprefix") : cnum = Request.Form("cnum") : email = Request.Form("email")
remarks = Request.Form("remarks") : phone = Request.Form("phone") : fax = Request.Form("fax") : cell = Request.Form("cell")
fullname = Replace(Replace(fullname, "'", "'"), Chr(34), """)
remarks = Replace(Replace(remarks, "'", "'"), Chr(34), """)
email = ReplaceChars(email, True, True, True)
'If pprefix <> "" And pnum <> "" Then phone = pprefix & "-" & pnum
'If fprefix <> "" And fnum <> "" Then fax = fprefix & "-" & fnum
'If cprefix <> "" And cnum <> "" Then cell = cprefix & "-" & cnum
If isok Then
' MESSAGE TO USER:
body = "" & vbCrLf & _
"" & vbCrLf & _
" תודה שפניתם אלינו! " & vbCrLf & _
fullname & " שלום, " & vbCrLf & _
"הודעתכם התקבלה בהצלחה! אחד מנציגינו יצור עמכם קשר במהלך 24 השעות הקרובות. (הודעה זו נשלחה באופן אוטומטי.)" & vbCrLf & _
"
אנא נסה שנית.
(" & rc & ")" : isok = False
End If
End If
If isok Then
' MESSAGE TO ADMIN:
body = "" & vbCrLf & _
"" & vbCrLf & _
" פרטי ההודעה " & vbCrLf & _
"שם מלא: " & fullname & "" & vbCrLf & _
"טלפון: " & phone & "" & vbCrLf & _
"פקס: " & fax & "" & vbCrLf & _
"סלולרי: " & cell & "" & vbCrLf & _
"אימייל: " & email & "" & vbCrLf & _
"הערות: " & Replace(remarks, vbCrLf, "
") & "" & vbCrLf & _
"
אנא נסה שנית.
(" & rc & ")" : isok = False
End If
End If
If isok Then
xmsg = "ההודעה נשלחה בהצלחה."
Response.Redirect "thanks.php"
End If
End If
' *****************************************************************************
Function SendEmail(iToEmail, iCC, iBCc, iSubject, iBody, iPriority)
On Error Resume Next
Dim xMail, temp, i
'Select Case iPriority
' Case 1,3,5:
' as is
' Case Else:
' iPriority = 3
'End Select
If iPriority = "" And iPriority <> 1 And iPriority <> 3 And iPriority <> 5 Then iPriority = 3 ' 3=normal
Set xMail = Server.CreateObject("Persits.MailSender")
With xMail
.Host = "mail.megahost.co.il" : .Username = "post@megahost.co.il" : .Password = "MegaHost001"
.CharSet = "WINDOWS-1255"
.From = "info@studio.co.il"
.FromName = "studio.co.il"
For i = 0 To UBound(Split(iToEmail, ","))
.AddAddress Split(iToEmail, ",")(i)
Next
For i = 0 To UBound(Split(iCC, ","))
.AddCC Split(iCC, ",")(i)
Next
For i = 0 To UBound(Split(iBCc, ","))
.AddBcc Split(iBCc, ",")(i)
Next
.IsHTML = True
.Priority = iPriority ' 1=high, 3=normal, 5=low
.Body = iBody
.Subject = xMail.EncodeHeader(iSubject, "WINDOWS-1255")
.Send()
End With
Set xMail = Nothing
If err.number <> 0 Then temp = err.Description Else temp = ""
SendEmail = temp
End Function
' *****************************************************************************
Function SendEmail2(iToEmail, iCC, iBCc, iSubject, iBody)
On Error Resume Next
Dim mailer, temp
Set mailer = Server.CreateObject("CDO.Message")
mailer.From = "מגה הוסט ישראל "
mailer.To = iToEmail
mailer.BCC = iBCc
mailer.CC = iCC
mailer.BodyPart.Charset = "WINDOWS-1255"
mailer.Subject = iSubject
mailer.HTMLBody = iBody
'mailer.AddAttachment file
mailer.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
mailer.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
'Authentication
mailer.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 ' means basic authentication
mailer.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "mail.megahost.co.il"
mailer.Configuration.Fields("http://schemas.microsoft.com/cdo/configuration/sendusername") = "mailform@megahost.co.il"
mailer.Configuration.Fields("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "MegaHost999"
mailer.Configuration.Fields.Update
mailer.Send
Set mailer = Nothing
If err.number <> 0 Then temp = err.Description Else temp = ""
SendEmail2 = temp
End Function
' *****************************************************************************
Function Validate(value, expression)
Dim myReg, temp, xstr
Set myReg = New RegExp
If expression = "" Then
Validate = False
Exit Function
End If
Select Case expression
Case "email":
xstr = "^([_a-z0-9A-Z][^א-ת][^\<]+)(\.[_a-z0-9A-Z][^א-ת][^\<]+)*@([a-z0-9A-Z-][^א-ת][^\<]+)(\.[_a-z0-9A-Z][^א-ת][^\<]+)*[^\.][^\<]$"
Case "phone":
xstr = "^(([0]{1})(([2|3|4|8|9]{1})|([72|73|74|75|77]{2}))(-)*([0-9]{7})+)|(([0]{1}[0-9]{2})(-)*([0-9]{6,7})+)$"
Case "cell": ' 05[0/2/4/7][-]xxxxxxx
xstr = "^([05]{2}([0|2|4|7]{1})([-]{0,1})([0-9]{7}))$"
Case "cell2":
xstr = "^([\+]{1}[972]{3}[5]{1}[0|2|4|7]{1}[0-9]{7})$"
Case "cellfull": ' [+]972[-]5[0/2/4/7][-]xxxxxxx
xstr = "^(([\+]{0,1})([972]{3})([-]{0,1})([5]{1})([0|2|4|7]{1})([-]{0,1})([0-9]{7}))$"
Case "zip": ' xxxxx
xstr = "^([0-9]{5})$"
Case "date":
' dd/mm/20yy:
xstr = "^(((0[1-9]{1})|(1[1-9]{1})|(2[1-9]{1})|(30|31))\/((0[1-9]{1})|(10|11|12))\/(20[0-9]{2}))$"
Case "pickdate":
' dd-mm-yyyy:
xstr = "^((([0]{1}[1-9]{1})|([1]{1}[0-9]{1})|([2]{1}[0-9]{1})|([30|31]{2}))[-]{1}(([0]{1}[1-9]{1})|([1]{1}[0|1|2]{1}))[-]{1}([2]{1}[0-9]{3}))$"
'xstr = "^(((0[1-9]{1})|(1[1-9]{1})|(2[1-9]{1})|(30|31))[-]{1}((0[1-9]{1})|(10|11|12))[-]{1}([2]{1}[0-9]{3}))$"
Case "time":
xstr = "^(((0{1}[0-9]{1})|(1{1}[0-9]{1})|(2{1}[0-4]{1})):{1}[0-5]{1}[0-9]{1})$"
Case "tz": ' xxxxxxxxx
xstr = "^[0-9]{1,9}$"
Case "login":
xstr = "^([_a-z0-9A-Z-][^א-ת][^\<]+)$"
Case Else:
xstr = expression
End Select
With myReg
.Global = True
.IgnoreCase = True
.Pattern = xstr
temp = .Test(value)
End With
Set myReg = Nothing
Validate = temp
End Function
' *****************************************************************************
Function ReplaceChars(TheString, RemoveFullComma, RemoveFullQuotes, RemoveSpaces)
Dim xtemp, CommaString, QuotesString
If TheString <> "" Then
If RemoveFullComma Then CommaString = "" Else CommaString = "''"
If RemoveFullQuotes Then QuotesString = "" Else QuotesString = "''''"
xtemp = Replace(TheString, "'", CommaString) : xtemp = Replace(xtemp, Chr(34), QuotesString)
xtemp = Replace(xtemp, "<", "<") : xtemp = Replace(xtemp, ">", ">")
If RemoveSpaces Then xtemp = Replace(xtemp, Chr(32), "")
End If
ReplaceChars = xtemp
End Function
' *****************************************************************************
Function DisplayChars(TheString)
Dim xtemp
If TheString <> "" Then
xtemp = Replace(TheString, "''''", "||**||") : xtemp = Replace(xtemp, "''", "'")
xtemp = Replace(xtemp, "||**||", "''")
End If
DisplayChars = xtemp
End Function
' *****************************************************************************
%>
טופס יצירת קשר
|
