<%@LANGUAGE="VBSCRIPT"%>
<%
' Allowed files (extensions)
Const C_ALLOWED_EXTENSIONS = "('doc','pdf','xls')"
' Possible values are "CDOSYS", "CDONTS", "ASPEmail", "ASPMail", "Jmail"
Const C_MAIL_USE = "CDOSYS"
' If your email server is not the same that your web server, then enter the address in the following line
Const SMTP_SERVER = "corpexch01.rpmcsi.com"
' Send emails?
Const C_SEND_EMAILS = True
' Save Database file?
Const C_SAVE_DATABASE = false
' Exclude fields, add one AddExcludedField call for each excluded field
Dim excluded_fields(100), excluded_fields_count
excluded_fields_count = 0
AddExcludedField "hdwemail"
AddExcludedField "hdwok"
AddExcludedField "hdwnook"
AddExcludedField "hdwuploadfolder"
AddExcludedField "hdwtablename"
' Include extra fieds? (country, IP, referer, etc...)
Const HDW_INCLUDE_EXTRA_FIELDS = True
' Set this param to true to resend the info as GET parameters to the "Thank You" page.
Const HOTDW_RESEND_PARAMS = False
' Some antivirus or firewalls prevents the execution of the filesystem object. In that case you can disable it
' NOTE: This object is required for the FormToDatabase feature!
Const USE_FILESYSTEM_OBJECT = True
' use HDW_ID autonumerical?
Const USE_AUTO_NUMERICAL = True
%>
<%
Server.ScriptTimeout = 1000000000
Response.Expires = 0
Response.Buffer = True
Const SMTP_PORT = 25
Const HDW_F2M_EMAIL = "hdwemail"
Const HDW_F2M_OK = "hdwok"
Const HDW_F2M_NO_OK = "hdwnook"
Const HDW_F2M_UPLOADFOLDER = "hdwuploadfolder"
Dim localpath, fixedColumns
fixedColumns = Array ("Country","IP","Referer","Server Time","Browser","User Agent")
localpath = Server.MapPath("Form2Mail.asp.mdb")
localpath = Left(localpath, Len(localpath)-Len("Form2Mail.asp.mdb") )
Dim fso, MyFile
Dim Attachments, globalbuffer
Attachments = False ' Do not modify this
Dim countryname(212)
Dim emailaddress, fromaddress, emailsubject, body, item, getStr, uploadfolder
Dim csvFile(100), postedFields(1000,2)
Dim cPostedFields, CSVString
cPostedFields = 0
uploadfolder= Request(HDW_F2M_UPLOADFOLDER)
Dim HDW_TABLENAME
Const HDW_TABLENAME_ITEM = "hdwtablename"
SetCountryNames
' To Email Address
If (InStr(1,Request.ServerVariables("CONTENT_TYPE"), "multipart/form-data", 1) <= 0) Then
emailaddress = Request(HDW_F2M_EMAIL)
HDW_TABLENAME = Request(HDW_TABLENAME_ITEM)
End If
emailaddress = Replace(emailaddress,"+","@")
' From Email Address
fromaddress = emailaddress
emailsubject= "Form sent from Insurance Certificate Request"
body ="SUBMITTED INFORMATION
" &_
"***************************
"
getStr = ""
If C_SAVE_DATABASE Then Set fso = CreateObject("Scripting.FileSystemObject")
If (InStr(1,Request.ServerVariables("CONTENT_TYPE"), "multipart/form-data", 1) <= 0) Then
Dim name
for i = 1 to Request.Form.Count
for each name in Request.Form
if (Request.Form(name) is Request.Form(i)) AND (notInThisArray(name)) then
body = body & ""&name&": "&Request.Form(name)&"
"
getStr = getStr & "&"&name&"="&Server.URLEncode(Request.Form(name))
AddPostedField name, Request.Form(name)
end if
next
next
for i = 1 to Request.QueryString.Count
for each name in Request.QueryString
if (Request.QueryString(name) is Request.QueryString(i)) AND (notInThisArray(name)) then
body = body & ""&name&": "&Request.QueryString(name)&"
"
getStr = getStr & "&"&name&"="&Server.URLEncode(Request.QueryString(name))
AddPostedField name, Request.QueryString(name)
end if
next
next
uploadfolder = localpath & "saved_forms\" & uploadfolder & "_" & Left(getHashOfString(Request.ServerVariables("SERVER_NAME")),4)
If C_SAVE_DATABASE Then CreateFiles
Else
Dim UploadRequest, byteCount, RequestBin, keys, i, shortuploadfolder, tfname
Set UploadRequest = CreateObject("Scripting.Dictionary")
byteCount = Request.TotalBytes
RequestBin = Request.BinaryRead(byteCount)
BuildUploadRequest RequestBin
Attachments = True
keys = UploadRequest.Keys
uploadfolder = UploadRequest.Item(HDW_F2M_UPLOADFOLDER).Item("Value")
shortuploadfolder = uploadfolder & "_" & Left(getHashOfString(Request.ServerVariables("SERVER_NAME")),4)
uploadfolder = localpath & "saved_forms\" & shortuploadfolder
If C_SAVE_DATABASE Then CreateFiles
For i = 0 To UploadRequest.Count -1
If Not (UploadRequest.Item(keys(i)).Exists("FileName")) Then
If (keys(i) <> HDW_F2M_OK) And (keys(i) <> HDW_F2M_NO_OK) And (keys(i) <> HDW_F2M_EMAIL) And notInThisArray(keys(i)) Then
body = body & ""&keys(i)&": "&UploadRequest.Item(keys(i)).Item("Value")&"
"
getStr = getStr & "&"&keys(i)&"="&Server.URLEncode(UploadRequest.Item(keys(i)).Item("Value"))
AddPostedField keys(i), UploadRequest.Item(keys(i)).Item("Value")
End If
Else
If notInThisArray(keys(i)) Then
If (Not isValidFile(UploadRequest.Item(keys(i)).Item("FileName"))) And (UploadRequest.Item(keys(i)).Item("FileName") <> "") Then
Response.Redirect UploadRequest.Item(HDW_F2M_NO_OK).Item("Value")
Response.End
End If
tfname = Replace(CStr(Date),"/","-") & "_" & Replace(CStr(Time),":","_")&"-" & UploadRequest.Item(keys(i)).Item("FileName")
If UploadRequest.Item(keys(i)).Item("FileName") <> "" Then UploadRequest.Item(keys(i)).Item("Value").saveToFile ( uploadfolder & "\uploads\" & tfname)
body = body & ""&keys(i)&": "&UploadRequest.Item(keys(i)).Item("FileName")&"
"
getStr = getStr & "&"&keys(i)&"="&Server.URLEncode(UploadRequest.Item(keys(i)).Item("FileName"))
AddPostedField keys(i), "http://" & Request.ServerVariables("HTTP_HOST") & "/HDWASPForm2Database/saved_forms/" & shortuploadfolder & "/uploads/" & tfname
End If
End If
emailaddress = UploadRequest.Item(HDW_F2M_EMAIL).Item("Value")
HDW_TABLENAME = UploadRequest.Item(HDW_TABLENAME_ITEM).Item("Value")
emailaddress = Replace(emailaddress,"+","@")
fromaddress = emailaddress
Next
End If
getStr = "hdw=1" & getStr
If C_SAVE_DATABASE Then SaveToDatabase
If C_SEND_EMAILS Then
If HDW_INCLUDE_EXTRA_FIELDS Then
body = body & "SUPPORT INFORMATION
" &_
"***************************
" &_
"Country: " &getCountryID(Request.ServerVariables("REMOTE_HOST"))&"
" &_
"User IP: "&Request.ServerVariables("REMOTE_ADDR")&"
" &_
"User Host: "&Request.ServerVariables("REMOTE_HOST")&"
" &_
"Referer: "&Request.ServerVariables("HTTP_REFERER")&"
" &_
"Server Time: "&Date & " "& Time&"
" &_
"Browser: "&ckbrowser(Request.ServerVariables("HTTP_USER_AGENT"))&"
" &_
"User Agent: "&Request.ServerVariables("HTTP_USER_AGENT")&"
" &_
"
Delivered by HotDreamweaver Form 2 Database and Mail Script"
Else
body = body & _
"
Delivered by HotDreamweaver Form 2 Database and Mail Script"
End If
SendMail emailaddress, fromaddress, emailsubject, body
End If
If Attachments Then
If (InStr(UploadRequest.Item(HDW_F2M_OK).Item("Value"),"?") > 0) And (getStr <> "") Then getStr = "&" & getStr Else getStr = "?" & getStr
If Not HOTDW_RESEND_PARAMS Then getStr = ""
Response.Redirect UploadRequest.Item(HDW_F2M_OK).Item("Value") & getStr
Else
If (InStr(Request(HDW_F2M_OK),"?") > 0) And (getStr <> "") Then getStr = "&" & getStr Else getStr = "?" & getStr
If Not HOTDW_RESEND_PARAMS Then getStr = ""
Response.Redirect Request(HDW_F2M_OK) & getStr
End If
%>
<%
Function SendMail (var_ToAddress, var_FromAddress, var_Subject, var_Message)
Dim smtp, objMail, i, j, value, iBp, Flds, Binary
Dim objStream
Dim Stm
Dim buffer
' Send the email
If C_MAIL_USE = "CDOSYS" Then
Set objMail = Server.CreateObject("CDO.Message")
'objMail.MailFormat = 1
objMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = SMTP_SERVER
objMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = SMTP_PORT
'objMail.Configuration.Fields.Item _
' ("http://schemas.microsoft.com/cdo/configuration/sendusername") = "YOUR-USERNAME"
'objMail.Configuration.Fields.Item _
' ("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "YOUR-PASSWORD"
objMail.Configuration.Fields.Update
objMail.To = var_ToAddress
objMail.From = var_FromAddress
objMail.Subject = var_Subject
objMail.HTMLBody = var_Message
If Attachments Then
For i = 0 To UploadRequest.Count -1
If (UploadRequest.Item(keys(i)).Exists("FileName")) Then
Set iBp = objMail.Attachments.Add
Set Flds = iBp.Fields
With Flds
.Item("urn:schemas:mailheader:content-type") = "binary; name="&UploadRequest.Item(keys(i)).Item("FileName")
.Item("urn:schemas:mailheader:content-transfer-encoding") = "base64"
.Update
End With
Set Stm = iBp.GetDecodedContentStream
Set value = UploadRequest.Item(keys(i)).Item("Value")
On Error Resume Next
Stm.Write (value.Read)
value.Position = 0
Stm.Flush
Set Stm = Nothing
End If
Next
End If
On Error Resume Next
objMail.Send
Set objMail = Nothing
SendMail = True
End If
If (C_MAIL_USE = "CDONTS") Or ((C_MAIL_USE = "CDOSYS") AND (Err.Number <> 0)) Then
Set objMail = Server.CreateObject("CDONTS.NewMail")
objMail.MailFormat = 0
objMail.BodyFormat = 0
objMail.To = var_ToAddress
objMail.From = var_FromAddress
objMail.Subject = var_Subject
objMail.Body = var_Message
If Attachments Then
For i = 0 To UploadRequest.Count -1
If (UploadRequest.Item(keys(i)).Exists("FileName")) Then
UploadRequest.Item(keys(i)).Item("Value").saveToFile (localpath&"saved_forms\"&UploadRequest.Item(keys(i)).Item("FileName"))
objMail.AttachFile localpath&"_uploadedfile-"&UploadRequest.Item(keys(i)).Item("FileName"), UploadRequest.Item(keys(i)).Item("FileName")
End If
Next
End If
objMail.Send
Set objMail = Nothing
SendMail = True
If (Attachments) And (USE_FILESYSTEM_OBJECT) Then
For i = 0 To UploadRequest.Count -1
If (UploadRequest.Item(keys(i)).Exists("FileName")) Then
Set fso = CreateObject("Scripting.FileSystemObject")
Set MyFile = fso.GetFile( localpath&"saved_forms\"&UploadRequest.Item(keys(i)).Item("FileName") )
MyFile.Delete
End If
Next
End If
ElseIf (C_MAIL_USE = "ASPEmail") Then
Set objMail = Server.CreateObject("Persits.MailSender")
objMail.Host = SMTP_SERVER
objMail.From = var_FromAddress
objMail.FromName = var_FromAddress
objMail.AddAddress var_ToAddress, var_ToAddress
If Attachments Then
For i = 0 To UploadRequest.Count -1
If (UploadRequest.Item(keys(i)).Exists("FileName")) Then
UploadRequest.Item(keys(i)).Item("Value").saveToFile (localpath&"saved_forms\"&UploadRequest.Item(keys(i)).Item("FileName"))
objMail.AddAttachment localpath&"saved_forms\"&UploadRequest.Item(keys(i)).Item("FileName")
End If
Next
End If
objMail.Subject = var_Subject
objMail.Body = var_Message
objMail.IsHTML = true
objMail.Send
If (Attachments) And (USE_FILESYSTEM_OBJECT) Then
For i = 0 To UploadRequest.Count -1
If (UploadRequest.Item(keys(i)).Exists("FileName")) Then
Set fso = CreateObject("Scripting.FileSystemObject")
Set MyFile = fso.GetFile( localpath&"saved_forms\"&UploadRequest.Item(keys(i)).Item("FileName") )
MyFile.Delete
End If
Next
End If
SendMail = True
ElseIf (C_MAIL_USE = "ASPMail") Then
set objMail = Server.CreateObject("SMTPsvg.Mailer")
objMail.RemoteHost = SMTP_SERVER
objMail.FromAddress = var_FromAddress
objMail.FromName = var_FromAddress
objMail.AddRecipient var_ToAddress, var_ToAddress
If Attachments Then
For i = 0 To UploadRequest.Count -1
If (UploadRequest.Item(keys(i)).Exists("FileName")) Then
UploadRequest.Item(keys(i)).Item("Value").saveToFile (localpath&"saved_forms\"&UploadRequest.Item(keys(i)).Item("FileName"))
objMail.AddAttachment localpath&"saved_forms\"&UploadRequest.Item(keys(i)).Item("FileName")
End If
Next
End If
objMail.Subject = var_Subject
objMail.BodyText = var_Message
objMail.ContentType = "text/html"
objMail.SendMail
If (Attachments) And (USE_FILESYSTEM_OBJECT) Then
For i = 0 To UploadRequest.Count -1
If (UploadRequest.Item(keys(i)).Exists("FileName")) Then
Set fso = CreateObject("Scripting.FileSystemObject")
Set MyFile = fso.GetFile( localpath&"saved_forms\"&UploadRequest.Item(keys(i)).Item("FileName") )
MyFile.Delete
End If
Next
End If
SendMail = True
ElseIf (C_MAIL_USE = "Jmail") Then
set objMail = Server.CreateObject("JMail.SMTPMail")
objMail.ServerAddress = SMTP_SERVER
objMail.Sender = var_FromAddress
objMail.AddRecipient var_ToAddress
If Attachments Then
For i = 0 To UploadRequest.Count -1
If (UploadRequest.Item(keys(i)).Exists("FileName")) Then
UploadRequest.Item(keys(i)).Item("Value").saveToFile (localpath&"saved_forms\"&UploadRequest.Item(keys(i)).Item("FileName"))
objMail.AddAttachment localpath&"saved_forms\"&UploadRequest.Item(keys(i)).Item("FileName")
End If
Next
End If
objMail.Subject = var_Subject
objMail.HTMLBody = var_Message
objMail.Execute
If (Attachments) And (USE_FILESYSTEM_OBJECT) Then
For i = 0 To UploadRequest.Count -1
If (UploadRequest.Item(keys(i)).Exists("FileName")) Then
Set fso = CreateObject("Scripting.FileSystemObject")
Set MyFile = fso.GetFile( localpath&"saved_forms\"&UploadRequest.Item(keys(i)).Item("FileName") )
MyFile.Delete
End If
Next
End If
SendMail = True
End If
End Function
%>
<%
Sub BuildUploadRequest(RequestBin)
'Get the boundary
Dim PosBeg, PosEnd, boundary, boundaryPos, Pos, Name, PosFile, PosBound, FileName, i, Value, gd, tmp
Dim ContentType
PosBeg = 1
PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(13)))
boundary = MidB(RequestBin,PosBeg,PosEnd-PosBeg)
boundaryPos = InstrB(1,RequestBin,boundary)
'Get all data inside the boundaries
Do until (boundaryPos=InstrB(RequestBin,boundary & getByteString("--")))
'Members variable of objects are put in a dictionary object
Dim UploadControl
Set UploadControl = CreateObject("Scripting.Dictionary")
'Get an object name
Pos = InstrB(BoundaryPos,RequestBin,getByteString("Content-Disposition"))
Pos = InstrB(Pos,RequestBin,getByteString("name="))
PosBeg = Pos+6
PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(34)))
Name = getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
PosFile = InstrB(BoundaryPos,RequestBin,getByteString("filename="))
PosBound = InstrB(PosEnd,RequestBin,boundary)
'Test if object is of file type
If PosFile<>0 AND (PosFile="&cip)
If rs.EOF Then getCountryID = "LOCAL; INTRANET OR UNKNOWN" Else getCountryID = countryname(rs.Fields.Item("country"))
End Function
Function IPAddress2IPNumber(IPaddress)
Dim i, pos, PrevPos, num
If IPaddress = "" Then
IPAddress2IPNumber = 0
Else
For i = 1 To 4
pos = InStr(PrevPos + 1, IPaddress, ".", 1)
If i = 4 Then pos = Len(IPaddress) + 1
num = Int(Mid(IPaddress, PrevPos + 1, pos - PrevPos - 1))
PrevPos = pos
IPAddress2IPNumber = ((num Mod 256) * (256 ^ (4 - i))) + IPAddress2IPNumber
Next
End If
End Function
Function ereg(find,str)
if Instr(1, str, find, 1) <> 0 Then
ereg = True
Else
ereg = False
End If
End Function
Function ckbrowser(user_agent)
Dim browser
if((ereg("Netscape", user_agent))) Then
browser = "Netscape"
elseif(ereg("Firefox", user_agent)) Then
browser = "Firefox"
elseif(ereg("Safari", user_agent)) Then
browser = "Safari"
elseif(ereg("SAFARI", user_agent)) Then
browser = "SAFARI"
elseif(ereg("MSIE", user_agent)) Then
browser = "MSIE"
elseif(ereg("Lynx", user_agent)) Then
browser = "Lynx"
elseif(ereg("Opera", user_agent)) Then
browser = "Opera"
elseif(ereg("Gecko", user_agent)) Then
browser = "Mozilla"
elseif(ereg("WebTV", user_agent)) Then
browser = "WebTV"
elseif(ereg("Konqueror", user_agent)) Then
browser = "Konqueror"
else
browser = "bot"
End If
ckbrowser = browser
End Function
' country list
Sub SetCountryNames
countryname(0) = "UNKNOWN"
countryname(1) = "AFGHANISTAN"
countryname(2) = "ALBANIA"
countryname(3) = "ALGERIA"
countryname(4) = "AMERICAN SAMOA"
countryname(5) = "ANDORRA"
countryname(6) = "ANGOLA"
countryname(7) = "ANTIGUA AND BARBUDA"
countryname(8) = "ARGENTINA"
countryname(9) = "ARMENIA"
countryname(10) = "AUSTRALIA"
countryname(11) = "AUSTRIA"
countryname(12) = "AZERBAIJAN"
countryname(13) = "BAHAMAS"
countryname(14) = "BAHRAIN"
countryname(15) = "BANGLADESH"
countryname(16) = "BARBADOS"
countryname(17) = "BELARUS"
countryname(18) = "BELGIUM"
countryname(19) = "BELIZE"
countryname(20) = "BENIN"
countryname(21) = "BERMUDA"
countryname(22) = "BHUTAN"
countryname(23) = "BOLIVIA"
countryname(24) = "BOSNIA AND HERZEGOVINA"
countryname(25) = "BOTSWANA"
countryname(26) = "BRAZIL"
countryname(27) = "BRITISH INDIAN OCEAN TERRITORY"
countryname(28) = "BRUNEI DARUSSALAM"
countryname(29) = "BULGARIA"
countryname(30) = "BURKINA FASO"
countryname(31) = "BURUNDI"
countryname(32) = "CAMBODIA"
countryname(33) = "CAMEROON"
countryname(34) = "CANADA"
countryname(35) = "CAPE VERDE"
countryname(36) = "CAYMAN ISLANDS"
countryname(37) = "CENTRAL AFRICAN REPUBLIC"
countryname(38) = "CHAD"
countryname(39) = "CHILE"
countryname(40) = "CHINA"
countryname(41) = "COLOMBIA"
countryname(42) = "COMOROS"
countryname(43) = "CONGO"
countryname(44) = "COOK ISLANDS"
countryname(45) = "COSTA RICA"
countryname(46) = "COTE D'IVOIRE"
countryname(47) = "CROATIA"
countryname(48) = "CUBA"
countryname(49) = "CYPRUS"
countryname(50) = "CZECH REPUBLIC"
countryname(51) = "DENMARK"
countryname(52) = "DJIBOUTI"
countryname(53) = "DOMINICAN REPUBLIC"
countryname(54) = "EAST TIMOR"
countryname(55) = "ECUADOR"
countryname(56) = "EGYPT"
countryname(57) = "EL SALVADOR"
countryname(58) = "EQUATORIAL GUINEA"
countryname(59) = "ERITREA"
countryname(60) = "ESTONIA"
countryname(61) = "ETHIOPIA"
countryname(62) = "FALKLAND ISLANDS (MALVINAS)"
countryname(63) = "FAROE ISLANDS"
countryname(64) = "FIJI"
countryname(65) = "FINLAND"
countryname(66) = "FRANCE"
countryname(67) = "FRENCH POLYNESIA"
countryname(68) = "GABON"
countryname(69) = "GAMBIA"
countryname(70) = "GEORGIA"
countryname(71) = "GERMANY"
countryname(72) = "GHANA"
countryname(73) = "GIBRALTAR"
countryname(74) = "GREECE"
countryname(75) = "GREENLAND"
countryname(76) = "GRENADA"
countryname(77) = "GUADELOUPE"
countryname(78) = "GUAM"
countryname(79) = "GUATEMALA"
countryname(80) = "GUINEA"
countryname(81) = "GUINEA-BISSAU"
countryname(82) = "HAITI"
countryname(83) = "HOLY SEE(VATICAN CITY STATE)"
countryname(84) = "HONDURAS"
countryname(85) = "HONG KONG"
countryname(86) = "HUNGARY"
countryname(87) = "ICELAND"
countryname(88) = "INDIA"
countryname(89) = "INDONESIA"
countryname(90) = "IRAQ"
countryname(91) = "IRELAND"
countryname(92) = "ISLAMIC REPUBLIC OF IRAN"
countryname(93) = "ISRAEL"
countryname(94) = "ITALY"
countryname(95) = "JAMAICA"
countryname(96) = "JAPAN"
countryname(97) = "JORDAN"
countryname(98) = "KAZAKHSTAN"
countryname(99) = "KENYA"
countryname(100) = "KIRIBATI"
countryname(101) = "KUWAIT"
countryname(102) = "KYRGYZSTAN"
countryname(103) = "LAO PEOPLE'S DEMOCRATIC REPUBLIC"
countryname(104) = "LATVIA"
countryname(105) = "LEBANON"
countryname(106) = "LESOTHO"
countryname(107) = "LIBERIA"
countryname(108) = "LIBYAN ARAB JAMAHIRIYA"
countryname(109) = "LIECHTENSTEIN"
countryname(110) = "LITHUANIA"
countryname(111) = "LUXEMBOURG"
countryname(112) = "MACAO"
countryname(113) = "MADAGASCAR"
countryname(114) = "MALAWI"
countryname(115) = "MALAYSIA"
countryname(116) = "MALDIVES"
countryname(117) = "MALI"
countryname(118) = "MALTA"
countryname(119) = "MARTINIQUE"
countryname(120) = "MAURITANIA"
countryname(121) = "MAURITIUS"
countryname(122) = "MEXICO"
countryname(123) = "MONACO"
countryname(124) = "MONGOLIA"
countryname(125) = "MOROCCO"
countryname(126) = "MOZAMBIQUE"
countryname(127) = "MYANMAR"
countryname(128) = "NAMIBIA"
countryname(129) = "NAURU"
countryname(130) = "NEPAL"
countryname(131) = "NETHERLANDS"
countryname(132) = "NETHERLANDS ANTILLES"
countryname(133) = "NEW CALEDONIA"
countryname(134) = "NEW ZEALAND"
countryname(135) = "NICARAGUA"
countryname(136) = "NIGER"
countryname(137) = "NIGERIA"
countryname(138) = "NORTHERN MARIANA ISLANDS"
countryname(139) = "NORWAY"
countryname(140) = "OMAN"
countryname(141) = "PAKISTAN"
countryname(142) = "PALAU"
countryname(143) = "PALESTINIAN TERRITORY"
countryname(144) = "PANAMA"
countryname(145) = "PAPUA NEW GUINEA"
countryname(146) = "PARAGUAY"
countryname(147) = "PERU"
countryname(148) = "PHILIPPINES"
countryname(149) = "POLAND"
countryname(150) = "PORTUGAL"
countryname(151) = "PUERTO RICO"
countryname(152) = "QATAR"
countryname(153) = "REPUBLIC OF KOREA"
countryname(154) = "REPUBLIC OF MOLDOVA"
countryname(155) = "REUNION"
countryname(156) = "ROMANIA"
countryname(157) = "RUSSIAN FEDERATION"
countryname(158) = "RWANDA"
countryname(159) = "SAMOA"
countryname(160) = "SAN MARINO"
countryname(161) = "SAO TOME AND PRINCIPE"
countryname(162) = "SAUDI ARABIA"
countryname(163) = "SENEGAL"
countryname(165) = "SERBIA AND MONTENEGRO"
countryname(166) = "SEYCHELLES"
countryname(167) = "SIERRA LEONE"
countryname(168) = "SINGAPORE"
countryname(169) = "SLOVAKIA"
countryname(170) = "SLOVENIA"
countryname(171) = "SOLOMON ISLANDS"
countryname(172) = "SOMALIA"
countryname(173) = "SOUTH AFRICA"
countryname(174) = "SPAIN"
countryname(175) = "SRI LANKA"
countryname(176) = "SUDAN"
countryname(177) = "SURINAME"
countryname(178) = "SWAZILAND"
countryname(179) = "SWEDEN"
countryname(180) = "SWITZERLAND"
countryname(181) = "SYRIAN ARAB REPUBLIC"
countryname(182) = "TAIWAN"
countryname(183) = "TAJIKISTAN"
countryname(184) = "THAILAND"
countryname(185) = "THE DEMOCRATIC REPUBLIC OF THE CONGO"
countryname(186) = "THE FORMER YUGOSLAV REPUBLIC OF MACEDONIA"
countryname(187) = "TOGO"
countryname(188) = "TOKELAU"
countryname(189) = "TONGA"
countryname(190) = "TRINIDAD AND TOBAGO"
countryname(191) = "TUNISIA"
countryname(192) = "TURKEY"
countryname(193) = "TURKMENISTAN"
countryname(194) = "TUVALU"
countryname(195) = "UGANDA"
countryname(196) = "UKRAINE"
countryname(197) = "UNITED ARAB EMIRATES"
countryname(198) = "UNITED KINGDOM"
countryname(199) = "UNITED REPUBLIC OF TANZANIA"
countryname(200) = "UNITED STATES"
countryname(201) = "URUGUAY"
countryname(202) = "UZBEKISTAN"
countryname(203) = "VANUATU"
countryname(204) = "VENEZUELA"
countryname(205) = "VIET NAM"
countryname(206) = "VIRGIN ISLANDS"
countryname(207) = "WESTERN SAHARA"
countryname(208) = "YEMEN"
countryname(209) = "ZAMBIA"
countryname(210) = "ZIMBABWE"
End Sub
Sub AddExcludedField(value)
excluded_fields_count = excluded_fields_count + 1
excluded_fields(excluded_fields_count) = value
End Sub
Function notInThisArray(value)
Dim i, found
found = False
For i = 1 To excluded_fields_count
If (excluded_fields(i)=value) Then found = True
Next
notInThisArray = Not found
End Function
Sub AddPostedField (name, value)
cPostedFields = cPostedFields + 1
postedFields(cPostedFields,1) = name
postedFields(cPostedFields,2) = value
End Sub
Sub CreateFiles
If Not fso.FolderExists(uploadfolder) Then fso.CreateFolder(uploadfolder)
If Not fso.FolderExists(uploadfolder&"\uploads") Then fso.CreateFolder(uploadfolder&"\uploads")
End Sub
Function FieldExists(tbl, field)
Dim k, fExists
k = 0
fExists = false
While (k < tbl.Columns.Count) And (Not fExists)
If (UCase(tbl.Columns.Item(k)) = UCase(field)) Then fExists = True
k = k + 1
WEnd
FieldExists = fExists
End Function
Sub SaveToDatabase
%><%
Dim cat, tbl
Set cat = Server.CreateObject ("ADOX.Catalog")
Set cat.ActiveConnection = DataC
' look for the table to know if it already exists
Dim i, FoundTable
i = 0
FoundTable = false
While (i < cat.Tables.Count) And (Not FoundTable)
If UCase(cat.Tables(i).Name) = UCase(HDW_TABLENAME) Then FoundTable = True
i = i + 1
WEnd
' create (if needed) and select table
If Not FoundTable Then
Set tbl = Server.CreateObject ("ADOX.Table")
With tbl
.Name = HDW_TABLENAME
Set .ParentCatalog = cat
.Columns.Append HDW_MAIN_FIELD, adInteger
If USE_AUTO_NUMERICAL Then .Columns(HDW_MAIN_FIELD).Properties("AutoIncrement") = True
End With
cat.Tables.Append tbl
Else
Set tbl = cat.Tables(HDW_TABLENAME)
End If
' if the main autoincrement field does not exists, then create it
If Not FieldExists(tbl, HDW_MAIN_FIELD) Then
tbl.Columns.Append HDW_MAIN_FIELD, adInteger
If USE_AUTO_NUMERICAL Then tbl.Columns(HDW_MAIN_FIELD).Properties("AutoIncrement") = True
End If
' Add the remaining posted fields
For i = 1 to cPostedFields
If Not FieldExists(tbl,postedFields(i,1)) Then
If (HDW_DATABASE_TYPE = "MSSQL") Then
DataC.Execute ("ALTER TABLE " & HDW_TABLENAME & " ADD " & postedFields(i,1) & " VARCHAR(1000) DEFAULT ''")
Else
tbl.Columns.Append postedFields(i,1), adLongVarWChar
End If
End If
Next
' Add the fixed fields
If (HDW_INCLUDE_EXTRA_FIELDS) Then
If (HDW_DATABASE_TYPE = "MSSQL") Then
If Not FieldExists(tbl, "hdw_Country") Then DataC.Execute ("ALTER TABLE " & HDW_TABLENAME & " ADD hdw_Country VARCHAR(1000) DEFAULT ''")
If Not FieldExists(tbl, "hdw_IP") Then DataC.Execute ("ALTER TABLE " & HDW_TABLENAME & " ADD hdw_IP VARCHAR(1000) DEFAULT ''")
If Not FieldExists(tbl, "hdw_ServerTime") Then DataC.Execute ("ALTER TABLE " & HDW_TABLENAME & " ADD hdw_ServerTime VARCHAR(1000) DEFAULT ''")
If Not FieldExists(tbl, "hdw_Referer") Then DataC.Execute ("ALTER TABLE " & HDW_TABLENAME & " ADD hdw_Referer VARCHAR(1000) DEFAULT ''")
If Not FieldExists(tbl, "hdw_Browser") Then DataC.Execute ("ALTER TABLE " & HDW_TABLENAME & " ADD hdw_Browser VARCHAR(1000) DEFAULT ''")
If Not FieldExists(tbl, "hdw_UserAgent") Then DataC.Execute ("ALTER TABLE " & HDW_TABLENAME & " ADD hdw_UserAgent VARCHAR(1000) DEFAULT ''")
Else
If Not FieldExists(tbl, "hdw_Country") Then tbl.Columns.Append "hdw_Country", adLongVarWChar
If Not FieldExists(tbl, "hdw_IP") Then tbl.Columns.Append "hdw_IP", adLongVarWChar
If Not FieldExists(tbl, "hdw_ServerTime") Then tbl.Columns.Append "hdw_ServerTime", adLongVarWChar
If Not FieldExists(tbl, "hdw_Referer") Then tbl.Columns.Append "hdw_Referer", adLongVarWChar
If Not FieldExists(tbl, "hdw_Browser") Then tbl.Columns.Append "hdw_Browser", adLongVarWChar
If Not FieldExists(tbl, "hdw_UserAgent") Then tbl.Columns.Append "hdw_UserAgent", adLongVarWChar
End If
End If
Set cat = Nothing
Set tbl = Nothing
Dim qFields, qValues
' generate and execute the insert query
For i = 1 to cPostedFields
' postedFields(i,1) contiene el field
qFields = qFields & "["&postedFields(i,1)&"],"
' postedFields(i,2) contiene el value
qValues = qValues & "'"&Replace(postedFields(i,2), "'", "''")&"',"
Next
' estos campos se salvan siempre:
' te da el country
' te da el IP
' te da el referer
' te da la fecha
' te da el useragent
' te da el browser
If (HDW_INCLUDE_EXTRA_FIELDS) Then
If Not USE_AUTO_NUMERICAL Then qFields = qFields & "HDW_ID,"
qFields = qFields & "hdw_Country,"
qFields = qFields & "hdw_IP,"
qFields = qFields & "hdw_ServerTime,"
qFields = qFields & "hdw_Referer,"
qFields = qFields & "hdw_Browser,"
qFields = qFields & "hdw_UserAgent,"
If Not USE_AUTO_NUMERICAL Then
Dim xd
xd = Date
Randomize
qValues = qValues & "" & Hour(Time) & Minute(Time) & Second(Time) & Int((999 - 100 + 1) * Rnd + 999) & ","
End If
qValues = qValues & "'"&Replace(getCountryID(Request.ServerVariables("REMOTE_HOST")),"''","''")&"',"
qValues = qValues & "'"&Replace(Request.ServerVariables("REMOTE_ADDR"),"''","''")&"',"
qValues = qValues & "'"&Replace(Request.ServerVariables("HTTP_REFERER"),"''","''")&"',"
qValues = qValues & "'"&Replace(Date & " "& Time,"''","''")&"',"
qValues = qValues & "'"&Replace(ckbrowser(Request.ServerVariables("HTTP_USER_AGENT")),"''","''")&"',"
qValues = qValues & "'"&Replace(Replace(Request.ServerVariables("HTTP_USER_AGENT"),",",";"),"''","''")&"',"
End If
qFields = Left(qFields, Len(qFields)-1)
qValues = Left(qValues, Len(qValues)-1)
DataC.Execute("INSERT INTO " & HDW_TABLENAME & " (" & qFields & ") VALUES(" & qValues & ")")
If IsObject(DataC) Then DataC.Close
End Sub
Function isValidFile (str)
Dim ext
ext = "'" & UCase(Right(str, Len(str)-InStrRev(str,"."))) & "'"
isValidFile = (InStr(UCase(C_ALLOWED_EXTENSIONS),ext) > 0)
End Function
%>