Remote Host Information Posting (advanced) [Module requests]

Remote Host Information Posting (advanced)

2004/7/13 13:04
ChadK
Quite a regular
Posts: 242
Since: 2004/7/9 1

I have an ASP script I was using on an old site. The
purpose of the script was to allow a user to post a
classified ad into my system while at the same time, taking
the text and posting it to various other classified ad
websites that I defined.

The ASP script isn't really that complicated once you see
what it's doing. Basically it takes information posted and
parses it according to the site it's going to.

Say I have 3 other sites defined. The items I define are:
Site address: regular url to website
Login Address: Site to log in (if needed)
Login ID: Name to log in with (if login address>"")
Login PW: Password to send (again only if needed)
Post Address: specific URL to post classified info to
SuccessString: the string to look for in the resulting page
after the submit to see if the ad was posted correctly.

All of the following use the information from the ad they
submitted if it's available otherwise it uses a default
value defined on a site-by-site basis. This is because one
site might require phone # to be (555)555-5555 and another
might want it in the format: 5555555555

Name: user's name
Phone: user's phone # if on the ad
Title: title of ad
Description: body of ad & a footer defined by me
URL: Classified URL if available, user's URL if available,
website address at my site where ad details can be displayed
(first available in this order)
Photo URL: if available

and a few others perhaps..

So I see it as needing to be set up with:
Table: xoops_sites
Fields: SID (site ID), Title, URL, LoginURL, Login, Pass,
PostURL, SuccessString

Table: xoops_sites_variables
Fields: SID, SiteField (the field name on the destination
website's form), SourceField (the field name on my
classified submission form, if any), DefaultValue (the
default value to use if no source field is supplied or
sourcefield submitted is empty).

Maybe a history table recording what ads were submitted
where and if they were successful or not.

I'm a decent ASP script writer but I lack the skill with PHP
to accomplish this. Help. ;)

If anyone is interested in helping I can send you the ASP
script I was using (that worked). I'll attach the script
later when I have access to it.

Re: Remote Host Information Posting (advanced)

2004/7/14 1:55
ChadK
Quite a regular
Posts: 242
Since: 2004/7/9 1

I'm really hoping to get some help with this so here's the ASP page I was referring to in the previous post. It's rather long, I know.. it had been a work in progress for about a year to get it to this stage... of course, not constantly but a little here, a little there.. you know.

Quote:

<%@ CodePage=65001 Language="VBScript" EnableSessionState = False%>

<%
Server.ScriptTimeout=180
GetConfigVariables
SetupDatabase
Dim iBookmark
%>

<%=sBBSName%> : Automated Parrot Sell/Buy Form

<%
Dim sFullMsg
Dim sPost
Dim sError0

Dim ApplicantUserInfo, sEmailAddress, sWhy, iThreadID, iMessageID
sUserName = Request.Form("UserName")
sPassword = Request.Form("Password")
checkUsername sUsername, sPassword, sResult
Dim iMemberID

if sLogonType <> "ok" then response.redirect validateURL(sBaseURL & sForumRoot) & "/logon.asp?error=needregistration"
'Do you want to send this to a mailing list? If so, what is the address?
Dim sMailingList
Dim TESTING, iForumID
TESTING=False
'TESTING = sUserName="Chad"

'Do you wish to post a message in a forum with the request information?
Const bPostApplication = True
'Email the applicant a copy of the application?
Const bEmailApplicant = True
'Email your moderators a copy of the application?
Const bEmailModerators = False
'Email the site Administrators?
'Usually not necessary if you have bEmailModerators set to True (or don't list your
'administrators as moderators anywhere)
Const bEmailAdministrators = False
'Email a copy to all of your active and registered users?
Const bEmailUsers = False
'Do you wish to Send Private Messages?
Const bSendPM = False
'How many people do you want to receive the PM? (change the #)
Dim PM(2)
'Please define the PM recipients
PM(1) = "Chad"
PM(2) = "Toni"
Dim sObj, sObj2
Set sObj = New cDynString
Set sObj2 = New cDynString

'sObj.Append "
/=The actual character proceeding the / (/- means it must be a -)"
'sObj.Append "
*=Alpha, numeric, special character, or blank"
'sObj.Append "
$=Numeric character only"
'sObj.Append "
#=Numeric character or blank"
'sObj.Append "
%=Alpha character only"
'sObj.Append "
X=Alpha character or blank"
'sObj.Append "
@=Alpha character or zero"
'sObj.Append "
&=Alpha or numeric character"
'sObj.Append "
~=Space=Imbedded blank"
'sObj.Append "
!=Special character only (i.e.. dashes, forward slashes, periods etc.)"
'sObj.Append "
+=Special, numeric, or alpha character (this symbol is the same as an * without the blank)"
'sFormatKey = sObj
'sObj.Initialize
'Which Question should be included in the subject?
Const iSubjQ = 5
'Which Question contains the price?
Const iPriceQ = 8
Const iPhoneQ=3
Const iLocationQ=4
Const iQuestionsQ=38
Const iCommentsQ=28
'How many Questions does your application have? Change the # in the () for both variables
Dim Question(39,6)
'Please define your questions following this example:
Dim X
X=0
Question(X,0) = "What Type of Classified Ad"
Question(X,1) = "Ad Type"
Question(X,2) = "combo"
Question(X,3) = ";------SELECT ONE------;For Sale;Bird Wanted"
Question(X,4) = "Both"
Question(X,5) = "\S*"
Question(X,6) = "You must select either For Sale or Bird Wanted"
X=X+1
Question(X,0) = "This section relates to Both buying and Selling"
Question(X,1) = "Both"
Question(X,2) = "label"
Question(X,3) = "Answer as many questions as you are comfortable with"
Question(X,4) = "----"
Question(X,5) = ""
Question(X,6) = ""
X=X+1
Question(X,0) = "Contact Name"
Question(X,1) = "Name"
Question(X,2) = "text"
Question(X,3) = "30"
Question(X,4) = "Both"
Question(X,5) = "\w{3,}"
Question(X,6) = "Please enter at least your First Name"
X=X+1
Question(X,0) = "Phone Number"
Question(X,1) = "Phone"
Question(X,2) = "text"
Question(X,3) = "15"
Question(X,4) = "Both"
Question(X,5) = "\+?1?$?[0-9]{3}$?\-?\s?[0-9]{3}\-?\s?[0-9]{4}"
Question(X,6) = "Enter as (515)770-1636 or (44)52-231..."
X=X+1
Question(X,0) = "Your Location"
Question(X,1) = "Location"
Question(X,2) = "text"
Question(X,3) = "30"
Question(X,4) = "Both"
Question(X,5) = "\w{2,}"
Question(X,6) = "Please enter your State or Region (IA, Midwest)"
X=X+1
Question(X,0) = "Breed of Parrot"
Question(X,1) = "Breed"
Question(X,2) = "text"
Question(X,3) = "30"
Question(X,4) = "Both"
Question(X,5) = "\w{3,}"
Question(X,6) = "You must specify a Breed of Parrot"
X=X+1
Question(X,0) = "What type of bird"
Question(X,1) = "Bird Type"
Question(X,2) = "combo"
Question(X,3) = "; ;Pet;Breeder;Special Needs;Other"
Question(X,4) = "Both"
Question(X,5) = ""
Question(X,6) = ""
X=X+1
Question(X,0) = "Quantity (if more than one)"
Question(X,1) = "Qty"
Question(X,2) = "text"
Question(X,3) = "2"
Question(X,4) = "Both"
Question(X,5) = "^(\d+)?$"
Question(X,6) = "Numbers Only 1, 2 and so on"
X=X+1
Question(X,0) = "Price EACH (US $)"
Question(X,1) = "Price"
Question(X,2) = "text"
Question(X,3) = "7"
Question(X,4) = "Both"
'Old : ^\d+(\.\d+)?$
'Not allow zero: ^[1-9]+\d*(\.\d+)?$
Question(X,5) = "^\d+(\.\d+)?$"
Question(X,6) = "Your Price must be a number (or 0). Enter as 500 or 500.00 but do not include the $ or any other characters."
X=X+1
Question(X,0) = "Price Negotiable"
Question(X,1) = "Negotiable"
Question(X,2) = "radio"
Question(X,3) = ";Yes;No"
Question(X,4) = "Both"
Question(X,5) = ""
Question(X,6) = ""
X=X+1
Question(X,0) = "Cage(s) Included in price"
Question(X,1) = "Cage included"
Question(X,2) = "radio"
Question(X,3) = ";Yes;No"
Question(X,4) = "Both"
Question(X,5) = ""
Question(X,6) = ""
X=X+1
Question(X,0) = "Cage(s) Available Separately"
Question(X,1) = "Cage for sale"
Question(X,2) = "radio"
Question(X,3) = ";Yes;No"
Question(X,4) = "Both"
Question(X,5) = ""
Question(X,6) = ""
X=X+1
Question(X,0) = "Banded"
Question(X,1) = "Banded"
Question(X,2) = "radio"
Question(X,3) = ";Closed;Open;None;Unknown"
Question(X,4) = "Both"
Question(X,5) = ""
Question(X,6) = ""
X=X+1
Question(X,0) = "Socialized"
Question(X,1) = "Social"
Question(X,2) = "radio"
Question(X,3) = ";Yes;No"
Question(X,4) = "Both"
Question(X,5) = ""
Question(X,6) = ""
X=X+1
Question(X,0) = "Do you have an Avian Vet"
Question(X,1) = "AvianVet Selected"
Question(X,2) = "radio"
Question(X,3) = ";Yes;No"
Question(X,4) = "Both"
Question(X,5) = ""
Question(X,6) = ""
X=X+1
Question(X,0) = "This bird Vet Checked"
Question(X,1) = "Vet Check"
Question(X,2) = "radio"
Question(X,3) = ";Yes;No"
Question(X,4) = "Both"
Question(X,5) = ""
Question(X,6) = ""
X=X+1
Question(X,0) = "Bird Sexed"
Question(X,1) = "Sexed"
Question(X,2) = "combo"
Question(X,3) = ";No;No-Optional/Dont Care;Male;Female;DNA-Male;DNA-Female;Surgical-Male;Surgical-Female;NA-Dimorphic-Male;NA-Dimorphic-Female"
Question(X,4) = "Both"
Question(X,5) = ""
Question(X,6) = ""
X=X+1
Question(X,0) = "Age (or range) of Parrot(s)"
Question(X,1) = "Age"
Question(X,2) = "text"
Question(X,3) = "10"
Question(X,4) = "Both"
Question(X,5) = ""
Question(X,6) = ""
X=X+1
Question(X,0) = "Handfed"
Question(X,1) = "Handfed"
Question(X,2) = "radio"
Question(X,3) = ";Yes;No"
Question(X,4) = "Both"
Question(X,5) = ""
Question(X,6) = ""
X=X+1
Question(X,0) = "Fully Weaned"
Question(X,1) = "Weaned"
Question(X,2) = "radio"
Question(X,3) = ";Yes;No"
Question(X,4) = "Both"
Question(X,5) = ""
Question(X,6) = ""
X=X+1
Question(X,0) = "Bird ok with Small Children"
Question(X,1) = "OK with Kids"
Question(X,2) = "radio"
Question(X,3) = ";Yes;No;Unknown/NA"
Question(X,4) = "Both"
Question(X,5) = ""
Question(X,6) = ""
X=X+1
Question(X,0) = "Care Instructions Avail/Needed"
Question(X,1) = "Care Instructions"
Question(X,2) = "radio"
Question(X,3) = ";Yes;No"
Question(X,4) = "Both"
Question(X,5) = ""
Question(X,6) = ""
X=X+1
Question(X,0) = "Guarantee Offered/Requested"
Question(X,1) = "Guarantee"
Question(X,2) = "text"
Question(X,3) = "40"
Question(X,4) = "Both"
Question(X,5) = ""
Question(X,6) = ""
X=X+1
Question(X,0) = "Will you work with a Parrot Broker"
Question(X,1) = "Brokers OK"
Question(X,2) = "radio"
Question(X,3) = ";Yes;No"
Question(X,4) = "Both"
Question(X,5) = ""
Question(X,6) = ""
X=X+1
Question(X,0) = "Aviary Size/Type"
Question(X,1) = "Aviary Type"
Question(X,2) = "combo"
Question(X,3) = "; ;None;Hobby;Small;Large;Professional"
Question(X,4) = "Both"
Question(X,5) = ""
Question(X,6) = ""
X=X+1
Question(X,0) = "Shipping Available"
Question(X,1) = "Shipping"
Question(X,2) = "combo"
Question(X,3) = ";No-Local Buyers Only;No-Pickup Only;Yes-Senders Expense;Yes-Receivers Expense"
Question(X,4) = "Both"
Question(X,5) = ""
Question(X,6) = ""
X=X+1
Question(X,0) = "Does this species require permit/license?"
Question(X,1) = "Permit Required"
Question(X,2) = "radio"
Question(X,3) = ";Yes;No"
Question(X,4) = "Both"
Question(X,5) = ""
Question(X,6) = ""
X=X+1
Question(X,0) = "If a permit or license is required, what type?"
Question(X,1) = "Permit Type"
Question(X,2) = "text"
Question(X,3) = "40"
Question(X,4) = "Both"
Question(X,5) = ""
Question(X,6) = ""
X=X+1
Question(X,0) = "Comments"
Question(X,1) = "Comments"
Question(X,2) = "textarea"
Question(X,3) = "40;4"
Question(X,4) = "Both"
Question(X,5) = ""
Question(X,6) = ""
X=X+1
Question(X,0) = "This Section pertains to SELLING a bird"
Question(X,1) = "Selling"
Question(X,2) = "label"
Question(X,3) = "This Section pertains to SELLING a bird"
Question(X,4) = "----"
Question(X,5) = ""
Question(X,6) = ""
X=X+1
Question(X,0) = "Breeding Experience (Years)"
Question(X,1) = "Yrs Experience"
Question(X,2) = "text"
Question(X,3) = "10"
Question(X,4) = "Sell"
Question(X,5) = ""
Question(X,6) = "Enter as 5 or 5 yrs"
X=X+1
Question(X,0) = "References Avail/Needed"
Question(X,1) = "References"
Question(X,2) = "radio"
Question(X,3) = ";Yes;No"
Question(X,4) = "Sell"
Question(X,5) = ""
Question(X,6) = ""
X=X+1
Question(X,0) = "This Section pertains to BUYING a bird"
Question(X,1) = "Buying"
Question(X,2) = "label"
Question(X,3) = "This Section pertains to BUYING a bird"
Question(X,4) = "----"
Question(X,5) = ""
Question(X,6) = ""
X=X+1
Question(X,0) = "Do you own 1 or more other birds "
Question(X,1) = "Other Birds"
Question(X,2) = "radio"
Question(X,3) = ";Yes;No"
Question(X,4) = "Buy"
Question(X,5) = ""
Question(X,6) = ""
X=X+1
Question(X,0) = "Do you own 1 or more dogs/cats (non-bird)"
Question(X,1) = "Other Pets"
Question(X,2) = "radio"
Question(X,3) = ";Yes;No"
Question(X,4) = "Buy"
Question(X,5) = ""
Question(X,6) = ""
X=X+1
Question(X,0) = "What type of home do you live in"
Question(X,1) = "Home"
Question(X,2) = "combo"
Question(X,3) = "; ;House;Apartment;Condo;Other"
Question(X,4) = "Buy"
Question(X,5) = ""
Question(X,6) = ""
X=X+1
Question(X,0) = "Have you reviewed all local laws/regulations"
Question(X,1) = "Laws and Regs"
Question(X,2) = "radio"
Question(X,3) = ";Yes;No"
Question(X,4) = "Buy"
Question(X,5) = ""
Question(X,6) = ""
X=X+1
Question(X,0) = "Items MOST important to you (select 2)"
Question(X,1) = "Important"
Question(X,2) = "checkbox"
Question(X,3) = ";Talks;Age;Clean;Smart;Social;Colors;Cost;Size"
Question(X,4) = "Buy"
Question(X,5) = ""
Question(X,6) = ""
X=X+1
Question(X,0) = "Questions"
Question(X,1) = "Questions"
Question(X,2) = "textarea"
Question(X,3) = "40;4"
Question(X,4) = "Buy"
Question(X,5) = ""
Question(X,6) = ""
X=X+1
Question(X,0) = "This section relates to how your ad will be posted"
Question(X,1) = "HowPosted"
Question(X,2) = "label"
Question(X,3) = ""
Question(X,4) = "----"
Question(X,5) = ""
Question(X,6) = ""

Dim sError
Redim sError(X)

Dim Site(7,8)
Site(1,1)="Up at Six"
Site(2,1)="http://www.upatsix.com/classifieds/fs_results.php"
Site(1,2)="Too Lady"
Site(2,2)="http://www.toolady.com/classifieds/birdsforsale.html"
'Site(1,3)="Bird Mart"
'Site(2,3)="http://www.birdmart.com/classifieds/forsale/"
Site(1,3)="Baby Birds"
Site(2,3)="http://www.babybirds.com/forsale.html"
Site(1,4)="Spray Millet"
Site(2,4)="http://www.spraymillet.com/classifieds/"
Site(1,5)="Birds n Ways"
Site(2,5)="http://www.birdsnways.com/birds/bpreown.htm"
'This site banned my IP address from posting
'Site(1,7)="Parrot Conservation Group"
'Site(2,7)="http://members.boardhost.com/ParrotConserve/"
'Site(1,8)="Global Pets"
'Site(2,8)="http://globalpets.com/cgi-local/SoftCart.exe/online-store/scstore/ads.html?L+scstore+arrk0037"

'Site(1,7)="Parrot Pages"
'Site(2,7)="http://www.parrotpages.com/classifiedads.shtml"
Site(1,7)="Planned Parrothood"
Site(2,7)="http://www.plannedparrothood.com/Classifieds/class_ad.htm"
'Site(1,9)="Birds of a Feather"
'Site(2,9)="http://www.boaf.com/classifiedads.shtml"
Site(1,8)="Feather Fantasy"
Site(2,8)="http://www.featherfantasy.com/classifieds/classifieds.asp?catid=1&catname=Classified+Ads"
'Site(1,9)="Bird Farm"
'Site(2,9)="http://birdfarm.com/gbook/index.html"
Site(1,6)="Bird Net"
Site(2,6)="http://www.bird-net.com/ca-sale.shtml"

'Do you wish to display any sort of footer under the application?
Dim sFooter
sFooter = "Submitting this request does NOT guarantee that a buyer matching your criteria will contact you.
This request will be submitted for members of this site to read and reply to. You consent to making this information available. You CAN delete this request at any time."
' You do not need to edit below this line
ApplicantUserInfo = GetUserInfo(sUserName)
sEmailAddress = ApplicantUserInfo(UI_emailaddr)
iMemberID = ApplicantUserInfo(UI_memberid)

Dim Prices, Index, PriceSetDate
Redim Prices(ubound(site,2))
If isAdmin(sUserName,sPassword) and ValidateNumeric(Request("Reset"))>0 Then Application("Classified_Prices_Date")=DateAdd("d",-1,date)
If Application("Classified_Prices_Date") Application("Classified_Prices_Date")=Date
Randomize
For Index = 1 to ubound(site,2)
Prices(Index)=Charge_ExtSite*Abs((Int(Rnd(Timer) * 10) + 1) <= 8)
Application("Classified_Prices_" & Index) = Prices(Index)
Next
Application("Classified_Prices") = Prices
Else
Prices = Application("Classified_Prices")
' For Index = 1 to ubound(site,2)
' Prices(Index)=ValidateNumeric(Application("Classified_Prices_" & Index))
' Next
End If

''Temporary: Too Lady is always free!
'Prices(2)=0

Dim strPayPalLink
strPayPalLink = "https://www.paypal.com/xclick/business=paypal@techknowledgeyinc.com&item_name=Credit&item_number=" & sUserName & "&amount=5.00&no_shipping=1&return=http://aviary.info&cancel_return=http://aviary.info¬ify_url=http://pay.aviary.info/paypal.asp¤cy_code=USD"
Dim sJoin
sJoin = ""
If bSendPM then sObj.Append "
Send a private message to selected members.
"
If bPostApplication Then sObj.Append "
Create a message post in the Parrots For Sale or Wanted Forum for prospective buyers to review.
"
If sMailingList<>"" then sObj.Append "
A copy of your message will be sent to the For Sale or Wanted mailing list subscribers.
"
If bEmailApplicant Then sObj.Append "
Create an email copy of the request and send it to YOU at: " & sEmailAddress & "
"
If bEmailModerators Then sObj.Append "
Create an email copy of this request and email it to the site Moderators (for processing).
"
If bEmailAdmin Then sObj.Append "
Create an email copy of this request and email it to the site Administrators (for review).
"
If bStoreApplications then sObj.Append "
Store request for future reference.
"
sActions = sObj
'sObj.NewString

if sActions = "" then sActions = "
No Actions Pending. Submitting a request does nothing."

' Setup default values
Dim iPrice
Dim bError
bError = False
if request("action") = "newad" then
If Request.Form((Question(0,1)))="------SELECT ONE------" then
sError(0) = "You must select either FOR SALE or BIRD WANTED"
sError0="Please correct the following errors"
bError = True
Else
If Request.Form((Question(0,1)))="For Sale" then
iForumID=4
sMailingList = "forsale@aviary.info"
Else
If Request.Form((Question(0,1)))="Bird Wanted" then
iForumID=6
sMailingList = "wanted@aviary.info"
End If
End If
End If
Dim bAbort, sResponse, sChr, iValue
Dim regEx, retVal
Set regEx = New RegExp
regEx.IgnoreCase = true
iPrice = request.Form((Question(iPriceQ,1)))
iPrice=ValidateNumeric(iPrice)

'---------------------
'Check for begging
If Request.Form((Question(0,1)))="Bird Wanted" then
'Must be "Bird Wanted"
If iPrice=0 Then
'Price must be ZERO
sPhrases="(unwanted|will take|any and all|loving home|will rescue|will adopt|for free|free bird)+"
regEx.Pattern=sPhrases
'If either the Questions or Comments field contains any of the words
If regEx.Test(lcase(request.Form((Question(iQuestionsQ,1))))) Then
sError(iQuestionsQ)="The suspicion that you are asking for a free parrot in this post has caused the system to reject it for submission. There is ABOSOLUTELY NO posting of 'wanted for free' or parrot beggins ads on this site.
Avoid the following phrases: " & sPhrases
sError0="THERE ARE ERRORS IN THE INFORMATION YOU HAVE ENTERED THAT NEED TO BE CORRECTED"
bError=True
End If
If regEx.Test(lcase(request.Form((Question(iCommentsQ,1))))) Then
sError(iCommentsQ)="The suspicion that you are asking for a free parrot in this post has caused the system to reject it for submission. There is ABOSOLUTELY NO posting of 'wanted for free' or parrot beggins ads on this site.
Avoid the following phrases: " & sPhrases
sError0="THERE ARE ERRORS IN THE INFORMATION YOU HAVE ENTERED THAT NEED TO BE CORRECTED"
bError=True
End If
End If
End If
'End begging check

'Check the rest of the questions to be sure they don't violate the reg exp
For X = 0 to uBound(Question,1)
If Question(X,5)<>"" Then
regEx.Pattern=Question(X,5)
If Not regEx.Test((Request.Form((Question(X,1))))) then
bError=True
sError(X)=Question(X,6)
sError0="THERE ARE ERRORS IN THE INFORMATION YOU HAVE ENTERED THAT NEED TO BE CORRECTED"
End If
End If
Next
If Not bError Then
sObj.NewString
sObj.Append request.Form((Question(0,1)))
sObj.Append ": "
sObj.Append Replace(ProperCase(request((Question(iSubjQ,1)))),"&"," and ")
' sObj.Append Replace(ProperCase(request((Question(iSubjQ,1)))),"&","%26;")
sObj.Append " ("
sObj.Append request((Question(4,1)))
sObj.Append ")"
sSubject = sObj
sSubject = ValidateSql(sSubject)
'sMessage = "New Parrot Available!" & CRLF & "A new parrot has been posted at " & sValidatedBaseURL & " (don't reply to this email)."
' Send out any appropriate e-mails
rsMaster.open "SELECT ThreadID from Threads where ThreadSubject='" & sSubject & "' and Owner='" & sUserName & "' and [datecreated]>=" & sDateDelimiter & DateAdd("d",-1,Now) & sDateDelimiter & " and [closed]=0", dbConnection, adOpenForwardOnly, adLockOptimistic
If rsMaster.EOF or sUserName = "Chad" then
rsMaster.Close
sObj.NewString
sObj2.NewString
sObj2.Append ""
For X = lBound(Question,1)+1 to uBound(Question,1)
If trim(request.Form((Question(x,1)))) <> "" Then
sObj.Append " .."
sObj.Append Question(x,1)
sObj.Append " - "
sObj.Append request((Question(x,1)))
sObj.Append " "
sObj.Append VBCRLF
sObj2.Append ""
End IF
Next
sMessage = sObj
sObj2.Append "
"
sObj2.Append Question(x,0)
sObj2.Append " "
sObj2.Append request((Question(x,1)))
sObj2.Append "
"
sPost = sObj2
Set sObj2 = Nothing
If not TESTING and bPostApplication Then
'Format sMessage for HTML output
' We first add the thread to the thread list
rsMaster.open "Threads", dbConnection, adOpenDynamic, adLockOptimistic
rsMaster.AddNew
rsMaster.Fields.Item("ForumID").Value = iForumID
rsMaster.Fields.Item("Closed").Value = 0
rsMaster.Fields.Item("DateCreated").Value = now
rsMaster.Fields.Item("LastActivity").Value = now
rsMaster.Fields.Item("Owner").Value = sUserName
rsMaster.Fields.Item("Anonymous").Value = 0
rsMaster.Fields.Item("ThreadSubject").Value = sSubject
rsMaster.Fields.Item("TimesViewed").Value = 0
rsMaster.Fields.Item("HasAttachment").Value = 0
rsMaster.Fields.Item("LastPoster").Value = sUserName
rsMaster.Fields.Item("HasPoll").Value = 0
rsMaster.Fields.Item("PollID").Value = 0
rsMaster.Fields.Item("TotalPosts").Value = 1
rsMaster.Fields.Item("Sticky").Value = 0
rsMaster.Fields.Item("ownerstatus").Value = 1
rsMaster.Fields.Item("lastposterstatus").Value = 1
rsMaster.Fields.Item("lastposteranonymous").Value = 0
rsMaster.Update
iThreadID = rsMaster.Fields.Item("ThreadID").Value
rsMaster.Close

' Now that we have an anchor thread, create the post.
rsMaster.open "Messages", dbConnection, adOpenDynamic, adLockOptimistic
rsMaster.AddNew
rsMaster.Fields.Item("ThreadID").Value = iThreadID
rsMaster.Fields.Item("Owner").Value = sUserName
rsMaster.Fields.Item("Subject").Value = sSubject
rsMaster.Fields.Item("body").Value = sPost
rsMaster.Fields.Item("datePosted").Value = now
rsMaster.Fields.Item("hostname").Value = request.servervariables("REMOTE_HOST")
rsMaster.Fields.Item("Anonymous").Value = 0
rsMaster.Fields.Item("InReplyTo").Value = -1
rsMaster.Fields.Item("MessageIcon").Value = ""
rsMaster.Fields.Item("ReplyOrder").Value = 0
rsMaster.Fields.Item("ReplyLevel").Value = 0
rsMaster.Fields.Item("ownerstatus").Value = 1
rsMaster.Fields.Item("hasattachment").Value = 0
rsMaster.Fields.Item("emoticons").Value = 0
rsMaster.Fields.Item("Signature").Value = 0
rsMaster.Fields.Item("filterhtml").Value = 0
rsMaster.Fields.Item("lasteditedname").Value = ""
rsMaster.Fields.Item("lastediteddate").Value = now
rsMaster.Fields.Item("edited").Value = 0
rsMaster.Update
iMessageID = rsMaster.Fields.Item("MessageID").Value
rsMaster.Close
SQL = "UPDATE [forums] set [threadcount]=[threadcount]+1, [postcount]=[postcount]+1, [lastposter]='" & ValidateSQL(sUserName) & "', [lastposterstatus]=1, [lastposteranonymous]=0, [lastactivity]=" & sDateDelimiter & GetSQLDateTime(Now) & sDateDelimiter & " where [forumid]=" & iForumID & ";"
dbConnection.execute SQL
OffsetThreadViewCount iThreadID, 1
UpdateUserTotals sUserName, 1
UpdateLastThreadPoster iThreadID
UpdateLastForumPoster iForumID
ReIndexThread iThreadID
sMessage = sMessage & vbcrlf & "-- Posted at: " & sValidatedBaseURL
End If
If Not TESTING and (bEmailApplicant = True) Then
Dim sEMessage
sEMessage="KEEP THIS EMAIL UNTIL YOU POST A NEW AD FOR THIS BIRD OR UNTIL THE AD IS NO LONGER VALID" & vbcrlf & vbcrlf & "Thanks for submitting your parrot for sale at " & sBBSName & "." & vbcrlf & vbcrlf & sMessage & vbcrlf & vbcrlf & "You may EDIT this ad at: http://aviary.info/parrot/thread-post.asp?Action=Edit&MessageID=" & iMessageID & "&forumid=" & iForumID & "&threadid=" & iThreadID & vbcrlf & "You may LOCK (disable) this ad at: http://aviary.info/parrot/freeze-thread.asp?threadid=" & iThreadID
SendMail sMailServerAddress, sEmailAddress, "website@aviary.info", "Aviary.info: " & sSubject, sEMessage, sBBSEmailComponent
End If
If Not TESTING And sMailingList <> "" Then
SendMail sMailServerAddress, sMailingList, "website@aviary.info", sSubject, "New Ad Posted at: " & sValidatedBaseURL & "/thread-view.asp?threadid=" & iThreadID & vbcrlf & "OR you may use the contact information listed in this email, though it really helps ensure the websites existance if you use the tools it offers to contact and communicate with other members." & vbcrlf & sMessage, sBBSEmailComponent
End If
If Not TESTING and Request.Form("EmailNotification")="Yes" then SetNotification sUsername, iThreadID, "email"

sRedirectURL = sValidatedBaseURL & "/t.asp?threadid=" & iThreadID
Dim sRefer
sRefer = sRedirectURL
CheckAdCopies
If Request("attachment") <> "0" Then sRedirectURL = sValidatedBaseURL & "/attach-file.asp?messageid=" & iMessageID
If Not TESTING then response.redirect sRedirectURL
Else
sError0="You've already posted this advertisement recently. If you wish to post a replacement you first need to close the previous advertisement by "
rsMaster.Close
End If
End If
End if
%>

<%
Dim sPos, sBR, sOutput
sObj.NewString
For X = 0 to uBound(Question,1)
If Response.IsClientConnected=false Then Response.End
If Question(X,4) = "----" Then
sObj.Append ""
sObj.Append vbcrlf
Next
sOutput = sObj
Response.Write sOutPut
%>

Post Parrot Classified Advertisements
Classified Ads posted on THIS SITE are FREE.
IF you select to have portions of your classified ad automatically posted onto other website's classified ad areas, there is a small charge for this to compensate the website programmers who've had to write some very extensive code to accomplish this feature. It's a very convenient way to get your advertisement out to many of the busiest classified ad pages in one simple form. Posting your ad on other sites automatically from our easy classified form is completely optional but we hope you'll take advantage of the feature!
This form is designed to list SINGLE BIRDS, not multiples. If you want to list more than one bird at once, you can, just know that this form wasn't designed for that purpose.
Most questions are OPTIONAL -- but please answer as many as possible
<%=sError0%>
User Info
Username
Password
Classified Ad Details
"
sObj.Append Question(x,0)
sObj.Append ""
Else
sObj.Append "
"
sObj.Append Question(x,0)
sObj.Append ""
If sError(X)<>"" Then
sObj.Append " ERROR:"
sObj.Append sError(X)
sObj.Append ""
End If
sObj.Append " "
sObj.Append Question(x,4)
sObj.Append " "
Select Case Question(X,2)
Case "text"
sObj.Append ""
Case "radio"
sPos = instr(1,Question(x,3),";")
sBR=""
Do until sPos = 0
sPos = sPos+1
sPosE = instr(sPos,Question(x,3),";")
If sPosE = 0 then sPosE = len(Question(x,3))+1
sPosE = sPosE-sPos
sOptionText = Mid(Question(x,3),sPos,sPosE)
If sOptionText = ";" then sOptionText = ""
sObj.Append sBR
sObj.Append " If instr(1,lcase(validateField(request((Question(X,1))))),lcase(sOptionText))>0 Then sObj.Append " checked "
sObj.Append " /> "
sObj.Append sOptionText
sObj.Append vbcrlf
sPos = instr(sPos,Question(x,3),";")
sBR = "
"
Loop
Case "combo"
sBR=""
sObj.Append ""
sObj.Append vbcrlf
Case "textarea"
sObj.Append " sObj.Append Right(Question(X,3),len(Question(X,3))-instr(1,Question(X,3),";"))<br> sObj.Append "' name='"<br> sObj.Append Question(X,1) & "'>"<br> sObj.Append validateField(request((Question(X,1))))<br> sObj.Append ""
Case "label"
sObj.Append Question(X,3)
Case "checkbox"
sPos = instr(1,Question(x,3),";")
Do until sPos = 0
sPos = sPos+1
sPosE = instr(sPos,Question(x,3),";")
If sPosE = 0 then sPosE = len(Question(x,3))+1
sPosE = sPosE-sPos
sOptionText = Mid(Question(x,3),sPos,sPosE)
If sOptionText = ";" then sOptionText = ""
sObj.Append " If instr(1,lcase(validateField(request((Question(X,1))))),lcase(sOptionText))>0 Then sObj.Append " checked "
sObj.Append " /> "
sObj.Append sOptionText
sObj.Append "
" & vbcrlf
sPos = instr(sPos,Question(x,3),";")
Loop
End Select
End If
sObj.Append "

Include Attachment(s) - Pictures?

Only applies to FOR SALE ads.
Both
/>Yes (<%=Charge_Attachment%>)
1 then response.write "checked" %> />No

Should we email you when you have replies?
Both
/>Yes
"Yes" then response.write "checked" %> />No

For <%=Charge_ExtSite%> each (except items marked FREE) you can automatically
Post your Classified Ad on:

You're paying for the service of
placing information regarding this ad
onto another site, not for
space on the other site.

You have <%=sngCredit%> site credit.

To Purchase $5.00 Credit Click Here:

If you do not have sufficient credit,
the additional sites will be skipped.

Note: Allow aprx 10 seconds additional
posting time for each additional
site you have selected.
- in other words,
be patient when you press submit.

<%
sObj.NewString
sObj.Append ""
For X = 1 to ubound(Site,2)
sObj.Append ""
If Prices(X)=0 Then
sObj.Append ""
sObj.Append ""
sObj.Append ""
Else
sObj.Append ""
sObj.Append ""
sObj.Append ""
End If
Next
sObj.Append "
sObj.Append Site(2,X)
sObj.Append """ target=""_blank"">"
sObj.Append Site(1,X)
sObj.Append " sObj.Append strPayPalLink
sObj.Append """ target=""_blank"">FREE sObj.Append Site(1,X)
sObj.Append """ value=""Yes"""
If Request.Form((Site(1,X)))<>"No" then sObj.Append " checked "
sObj.Append " />Yes sObj.Append Site(1,X)
sObj.Append """ value=""No"""
If Request.Form((Site(1,X)))="No" then sObj.Append " checked "
sObj.Append " />No
sObj.Append strPayPalLink
sObj.Append """ target=""_blank"">"
sObj.Append FormatCurrency(Prices(X))
sObj.Append " sObj.Append Site(1,X)
sObj.Append """ value=""Yes"""
If Request.Form((Site(1,X)))="Yes" then sObj.Append " checked "
sObj.Append " />Yes sObj.Append Site(1,X)
sObj.Append """ value=""No"""
If Request.Form((Site(1,X)))<>"Yes" then sObj.Append " checked "
sObj.Append " />No
"
sOutput = sObj
Response.Write sOutput
%>

Please note that your ad might not show up on these sites right away. Depending upon the site's design some ads take anywhere from several minutes to several days to update.

After you submit this request the following things will happen: <%=sActions%>

<%=sFormatKey%>
ONLY CLICK THIS ONCE!

ONLY CLICK THIS ONCE!

<%=sFooter%>

<%
set sObj = Nothing
%>

<%
Sub CheckAdCopies()
Dim HTMLE_Full, HTMLE_Subject, URLE_sRefer, strRealName
Dim BnW
Dim SM_Type
BnW=BirdsnWaysSetup
Select Case BnW(2)
Case "Finches"
SM_Type="finches"
Case "Budgies"
SM_Type="budgies"
Case Else
Select Case BnW(1)
Case "breeding"
SM_Type = "breeders"
Case Else
SM_Type = "babies"
End Select
End Select
sMessage = Replace(sMessage, "&", " and ")
sMessage = Replace(sMessage, " ", " ")
sFullMsg = sMessage
If Len(sMessage)>200 Then
sObj.NewString
sObj.Append Left(sMessage,180)
sObj.Append "..."
sObj.Append Right(sMessage,70)
sMessage = sObj
End IF
HTMLE_Full = server.HTMLEncode(sFullMsg)
HTMLE_Subject=server.HTMLEncode(sSubject)
URLE_sRefer=server.urlencode(sRefer)
strRealName=ApplicantUserInfo(UI_RealName)
sEmailAddress=Replace(sEmailAddress,"@","_nospam_@")

Site(3,1)=1
Site(4,1)="http://www.upatsix.com/cgi-bin/classifieds/fs.cgi"
sObj.NewString
sObj.Append "&email=" & sEmailAddress
sObj.Append "&state=X&desc=" & HTMLE_Full
sObj.Append "&myusername=iaparrot&mypasswd=ferihojoo"
Site(5,1)="type=FOR SALE" & sObj
Site(6,1)="http://www.upatsix.com/cgi-bin/classifieds/fs.cgi"
Site(7,1)="type=WANTED TO BUY" & sObj

Dim TLEmail
Const tlPRE = "ClassifiedsDir=/usr/local/etc/httpd/htdocs/toolady/classifieds/&ViewDir=http://www.toolady.com/classifieds/&ErrorReturn=http://www.toolady.com/classifieds/index.html&ReturnURL=http://www.toolady.com/classifieds/thanks.html&return=toolady@toolady.com&mailprog=/bin/sendmail%20-t%20&Department="
Dim tlPOST
'TLEmail = Replace(sEmailAddress,"aviary.info", int(rnd()*100000) & ".com")
TLEmail = sEmailAddress
sObj.NewString
sObj.Append "&RealName=" & strRealName
sObj.Append "&E-MailAddress=" & TLEmail
sObj.Append "&AdSubject=" & HTMLE_Subject
sObj.Append "&DesiredDerpartment=&Description=" & HTMLE_Full
sObj.Append "&Linkurl=" & URLE_sRefer
sObj.Append "&Linktitle=Posted at Aviary.Info"
sObj.Append "&Selection=PostAd"
tlPOST=sObj
Site(3,2)=1
Site(4,2)="http://toolady.com/cgi-bin/classifieds.cgi"
Site(5,2)=tlPRE & "birdsforsale" & tlPOST
Site(6,2)="http://toolady.com/cgi-bin/classifieds.cgi"
site(7,2) = tlPRE & "birdstobuy" & tlPOST

'Site(3,3)=3
'Site(4,3)="http://www.birdmart.com/cgi-bin/birdmart/classifieds/forsale/chatboard.pl"
'sObj.NewString
''name="post" value="yes">
''name="subject" size=50 maxlength=60>
''name="name" size=50>
''name="email" size=50>
''name="link_url" size=50 value="http://">
''name="link_title" size=50>
''name="image_url" size=50 value="http://">
''name="body" wrap=hard>
''type=submit value="Post Message">
'sObj.Append "post=yes&subject=" & Left(Replace(HTMLE_Subject,"For Sale: ",""),60)
'sObj.Append "&name=" & strRealName
'sObj.Append "&email=" & sEmailAddress
'sObj.Append "&link_url=" & URLE_sRefer
'sObj.Append "&link_title=" & Left(Replace(HTMLE_Subject,"For Sale: ",""),50)
''sObj.Append "&image_url=http://aviary.info/parrot/custom/images/banner3.jpg&body="
'sObj.Append "&image_url=&body=" & HTMLE_Full
'sObj.Append "&submit=Post Message"
'Site(5,3)=sObj
'Site(6,3)="http://www.birdmart.com/cgi-bin/birdmart/classifieds/wanted/chatboard.pl"
'Site(7,3)=Site(5,3)

Site(3,3)=1
Site(4,3)="http://www.babybirds.com/forsale.html"
'

'Name

'Email Address

'Aviary

'Homepage URL

'City, State

'Phone

'

'
sObj.NewString
sObj.Append "name=" & Left(strRealName,25)
sObj.Append "&e-mail=" & Left(sEmailAddress,25)
sObj.Append "&aviary_name=" & Left(strRealName,25)
sObj.Append "&url=" & sValidatedBaseURL
sObj.Append "&phone=" & Left(request.Form((Question(iPhoneQ,1))),25)
sObj.Append "&submit=Request Listing"
sObj.Append "&location=" & Left(request.Form((Question(iLocationQ,1))),25)
sObj.Append "&forsale=" & Replace(HTMLE_Full, vbcr, "#")
Site(5,3)=sObj
Site(6,3)="http://www.babybirds.com/wanted.html"
Site(7,3)=Replace(Replace(Site(5,3),"location=","from="),"forsale=","&adv=")

Site(3,5)=3
Site(4,5)="http://www.birdsnways.com/cgi-bin/cadform.cgi"
sObj.NewString
sObj.Append "&caption=" & Left(sSubject,50)
sObj.Append "&desc=" & Left(sMessage,70)
sObj.Append "&desc2=See the full ad at http://aviary.info&desc3=&desc4=&comments="
sObj.Append "&birdtype=" & BnW(1)
sObj.Append "&miscship=&species=" & BnW(2)
sObj.Append "&speciesoth=" & BnW(3)
sObj.Append "&realname=" & strRealName
sObj.Append "&city=" & request((Question(iLocationQ,1)))
sObj.Append "&state=Other&dayphone=" & request((Question(iPhoneQ,1)))
sObj.Append "&email=" & sEmailAddress
sObj.Append "&button=Post This Ad"
Site(5,5)="type=Birds 4 sale" & sObj
Site(6,5)="http://www.birdsnways.com/cgi-bin/cadform.cgi"
Site(7,5)="type=Birds Wanted" & sObj

Site(3,4)=1
Site(4,4)="http://www.spraymillet.com/classifieds/classifieds.cgi"
sObj.NewString
sObj.Append "ClassifiedsDir=/home/spraymi/public_html/classifieds/&ViewDir=http://www.spraymillet.com/classifieds/thanks.html&ErrorReturn=http://www.spraymillet.com/classifieds/index.html&ReturnURL=http://www.spraymillet.com/classifieds/thanks.html&return=webmaster@spraymillet.com&mailprog=/usr/bin/sendmail"
sObj.Append "&Department=" & SM_Type
sObj.Append "&RealName=" & Left(strRealName,30)
sObj.Append "&E-MailAddress=" & Left(sEmailAddress,30)
sObj.Append "&Address1=z&Address2=x&City=x&State=x&ZipCode=x"
sObj.Append "&Phone=" & request((Question(2,1)))
sObj.Append "&AdSubject=" & HTMLE_Subject
sObj.Append "&DesiredDepartment=" & BnW(2) & "-" & BnW(1)
sObj.Append "&Description=" & Replace(HTMLE_Full, VBCRLF, " | ")
sObj.Append "&Linkurl=" & URLE_sRefer
sObj.Append "&Linktitle=" & HTMLE_Subject
sObj.Append "&Selection=PostAd"
Site(5,4)=sObj
Site(6,4)=Site(4,4)
Site(7,4)=Site(5,4)

'Not working 12/20/03
'sObj.NewString
'sObj.Append "L+scstore+arrk0037"
'sObj.Append "&category=Birds"
'sObj.Append "&adtext=" & Left(sMessage & " - - http://aviary.info",148)
'sObj.Append "&email=" & sEmailAddress
'sObj.Append "&location=XX"
'sObj.Append "&b1=Submit Ad"
'Site(3,8)=3
'Site(4,8)="http://www.globalpets.com/cgi-local/SoftCart.exe/cgi-local/postafreead.cgi"
'Site(5,8)=sObj
'Site(6,8)="http://www.globalpets.com/cgi-local/SoftCart.exe/cgi-local/postafreead.cgi"
'Site(7,8)=Site(5,8)

'Not working 12/20/03
'sObj.NewString
'sObj.Append "username=ParrotConserve"
'sObj.Append "&name=" & Left(strRealName,30)
'sObj.Append "&email=" & Left(sEmailAddress,50)
'sObj.Append "&subject=" & Left(HTMLE_Subject,100)
'sObj.Append "&body=" & HTMLE_Full
'sObj.Append "&url_title=" & Left(HTMLE_Subject,70)
'sObj.Append "&url=" & sValidatedBaseURL
''sObj.Append "&img=" & server.htmlencode("http://aviary.info/parrot/custom/images/banner4.jpg")
'sObj.Append "&img="
'If Request.Form("EmailNotification")="Yes" Then
' sObj.Append "¬ifyme=1"
'Else
' sObj.Append "¬ifyme=0"
'End If
'sObj.Append "&post_message=Post"
'Site(3,7)=3
'Site(4,7)="http://members.boardhost.com/post/message.post"
'Site(5,7)=sObj
'Site(6,7)=Site(4,7)
'Site(7,7)=Site(5,7)

'Doesn't work pulls up blank results page 12/21/03
'Site(3,7)=3
'Site(4,7)="http://www.parrotpages.com/cgi-bin/classad.pl"
'sObj.NewString
'sObj.Append "act=verify&member=Yes&comments=Thanks http://www.Aviary.Info"
'sObj.Append "&name=" & Left(strRealName,40)
'sObj.Append "&a_contact=" & Left(strRealName,40)
'sObj.Append "&a_heading=" & Left(sSubject,50)
'sObj.Append "&a_ad_1=" & sMessage
'sObj.Append "&a_city=" & request((Question(iLocationQ, 1))) & "&a_state=Other"
'sObj.Append "&a_phone=" & Left(request.Form((Question(iPhoneQ,1))),13)
'sObj.Append "&a_email=" & sEmailAddress
'sObj.Append "&a_submit=Submit Your Ad"
'Site(5,7)=sObj & "&a_type=For Sale"
'Site(6,7)=Site(4,7)
'Site(7,7)=sObj & "&a_type=Wanted"

Site(3,7)=3
Site(4,7)="http://www.plannedparrothood.com/Classifieds/cgi-bin/class_add.pl"
sObj.NewString
sObj.Append "password=123123&submit=Post This Ad!"
sObj.Append "&name=" & Left(strRealName,50)
sObj.Append "&phone=" & Left(request.Form((Question(iPhoneQ,1))),13)
sObj.Append "&email=" & replace(sEmailAddress,".info",".info_removethedotcom.com")
If Request.Form("attachment")=1 then
sObj.Append "ℑ=Yes"
else
sObj.Append "ℑ=No"
End If
sObj.Append "&url=http://aviary.info"
sObj.Append "&description=" & sMessage
sObj.Append "&title=" & Left(sSubject,28)
sObj.Append "&price=" & iPrice
If BnW(2)="breeders" then
Site(5,7)=sObj & "&cat=Breeder Birds"
Else
Site(5,7)=sObj & "&cat=Baby Birds"
End If
Site(6,7)=Site(4,7)
Site(7,7)=sObj & "&cat=Wanted"

'Doesn't work pulls up blank results page 12/21/03
'Site(3,9)=3
'Site(4,9)="http://www.boaf.com/cgi-bin/classad.pl"
'sObj.NewString
'sObj.Append "act=add&B1=Accept&member=No&comments=Thanks http://Aviary.Info&a_state="
'sObj.Append "&name=" & Left(strRealName,40)
'sObj.Append "&a_heading=" & Left(sSubject,50)
'sObj.Append "&a_contact=" & Left(strRealName,40)
'sObj.Append "&a_ad_1=" & Replace(sMessage,vbcrlf," | ")
'sObj.Append "&a_city=" & request(Question(iLocationQ, 1)) & "&a_state=Other"
'sObj.Append "&a_phone=" & Left(request.Form(Question(iPhoneQ,1)),13)
'sObj.Append "&a_email=" & sEmailAddress
'Site(5,9)=sObj & "&a_type=For Sale"
'Site(6,9)=Site(4,9)
'Site(7,9)=sObj & "&a_type=Wanted"

Site(3,8)=3
Site(4,8)="http://www.featherfantasy.com/classifieds/addad.asp"
sObj.NewString
sObj.Append "add= Submit "
sObj.Append "&name=" & Left(strRealName,40)
sObj.Append "&headline=" & Left(sSubject,20)
sObj.Append "&price=" & iPrice
sObj.Append "&location=" & request(Question(iLocationQ, 1))
sObj.Append "&phone_number=" & Left(request.Form(Question(iPhoneQ,1)),20)
sObj.Append "&www_URL=http://aviary.info"
sObj.Append "&description=" & sMessage
sObj.Append "&email_address=" & sEmailAddress
Site(5,8)=sObj & "&category=1"
Site(6,8)=Site(4,8)
Site(7,8)=sObj & "&category=28"

'Doesn't work pulls up blank results page 12/21/03
'reports that comments are blank?
'Site(3,9)=3
'Site(4,9)="http://www.birdfarm.com/gbook/gb.cgi"
'Site(6,9)="http://www.birdfarm.com/gbook/gba.cgi"
'sObj.NewString
'sObj.Append "realname=" & Left(sSubject,30)
'sObj.Append "&username=" & sEmailAddress
'sObj.Append "&url=http://www.Aviary.Info"
'sObj.Append "&city=" & Left(request(Question(iLocationQ, 1)),20)
'sObj.Append "&state=xx&country=USA"
'sObj.Append "&comments=" & sMessage
'Site(5,9)=sObj
'Site(7,9)=sObj

Site(3,6)=3
Site(4,6)="http://www.bird-net.com/ca-sale.cgi"
Site(6,6)="http://www.bird-net.com/ca-want.cgi"
sObj.NewString
sObj.Append "send=Send"
sObj.Append "&realname=" & Left(sSubject,30)
sObj.Append "&name=" & strRealName
sObj.Append "&email=" & sEmailAddress
sObj.Append "&state=xx"
sObj.Append "&phone=" & request.Form((Question(iPhoneQ,1)))
sObj.Append "&message=" & "Thanks http://www.aviary.info -- " & sFullMsg
Site(5,6)=sObj
Site(7,6)=Site(5,6)

'
'
'
'
'
'
'
'TYPE="SUBMIT" VALUE=" Post Ad ">
'
'

'
'
'

'

'name="webpage-title" size="20">

'type="text" size="20" name="url" value="http://">

'name="location" size="20">

'TYPE="radio" NAME="shipping" value="yes">Yes No
'HTML Tags Stripped
'
'

'
'

'

'

'Message:
* Please submit your ad in the following format :
'
Species/Breed of Bird - Male/Female - Age - Price - All other comments
'

'

For X = 1 to ubound(Site,2)
If Response.IsClientConnected=false Then Response.End
If Request.Form((Site(1,X)))="Yes" Then
If request.Form((Question(0,1)))="For Sale" Then
'If TESTING then
'Call OpenAdResults(Prices(X),Site(4,X),Site(5,X), X)

'Else
Select Case Site(3,X)
Case 1
Call PostAd(Prices(X),Site(4,X),Site(5,X))
Case 2
Call PostAdMulti(Prices(X),Site(8,X),Site(9,X),Site(4,X),Site(5,X))
Case 3
Call OpenAdResults(Prices(X),Site(4,X),Site(5,X),X)
Case Else
Call GetAd(Prices(X),Site(4,X),Site(5,X))
End Select
'End If
Else
Select Case Site(3,X)
Case 1
Call PostAd(Prices(X),Site(6,X),Site(7,X))
Case 2
Call PostAdMulti(Prices(X),Site(8,X),Site(9,X),Site(6,X),Site(7,X))
Case 3
Call OpenAdResults(Prices(X),Site(6,X),Site(7,X),X)
Case Else
Call GetAd(Prices(X),Site(6,X),Site(7,X))
End Select
End If
End If
Next
End Sub

Sub OpenAdResults(iPrice, sURL, sFormData, X)
On Error Resume Next
If sngCredit>=iPrice Then
sFormData=Replace(Replace(sFormData,vbcr,""),vblf,"")
%>

<%
sngCredit=sngCredit-iPrice
Err.Clear
dbConnection.Execute "UPDATE MEMBERS SET CREDIT=" & sngCredit & " WHERE MEMBERID=" & iMEMBERID
If Err.number <> 0 then
Response.Write "ERROR-" & err.description & "-
" & "
Admin has been notified.
"
SendMail sMailServerAddress, "chad@aviary.info", sEmailAddress, "Classifieds.asp: Update Members Set Credit ERROR", "Automated email:" & vbcrlf & Err.Description, sBBSEmailComponent
If Testing Then Response.End
End If
End If
sngCredit = FormatCurrency(sngCredit)
End Sub

Sub PostAdMulti(iPrice, sPreURL, sPreForm, sURL, sFormData)
On Error Resume Next
lResolve = 10 * 1000
lConnect = 10 * 1000
lSend = 30 * 1000
lReceive = 30 * 1000
Dim xxx
Set xxx = Server.CreateObject("MSXML2.ServerXMLHTTP")
xxx.setTimeouts lResolve, lConnect, lSend, lReceive
xxx.Open "POST", sPreURL, False
xxx.Send sPreForm
Set xxx=Nothing
Call PostAd(iPrice,sURL,sFormData)
End Sub

Sub PostAd(iPrice, sURL, sFormData)
On Error Resume Next
If Response.IsClientConnected=false Then Response.End
Dim lResolve, lConnect, lSend, lReceive
If sngCredit>=iPrice Then
' If TESTING then sURL = "http://yahoo.com"
' If Not TESTING then
lResolve = 10 * 1000
lConnect = 10 * 1000
lSend = 30 * 1000
lReceive = 30 * 1000
Dim xxx
Set xxx = Server.CreateObject("MSXML2.ServerXMLHTTP")
xxx.setTimeouts lResolve, lConnect, lSend, lReceive
xxx.Open "POST", sURL, False
xxx.Send sFormData
If TESTING then
Response.Write sURL & "
"
Response.Write sFormData & "
"
Response.Write xxx.ResponseText
Response.End
Else
If instr(1,xxx.statusText,"OK")>0 Then
sngCredit=sngCredit-iPrice
Err.Clear
dbConnection.Execute "UPDATE MEMBERS SET CREDIT=" & sngCredit & " WHERE MEMBERID=" & iMEMBERID
If TESTING and Err.number <> 0 then
Response.Write "ERROR-" & err.description & "-
" & "
Admin has been notified.
"
SendMail sMailServerAddress, "chad@aviary.info", sEmailAddress, "Classifieds.asp: Update Members Set Credit ERROR", "Automated email:" & vbcrlf & Err.Description, sBBSEmailComponent
If Testing Then Response.End
End If
Else
Response.Write "Failed: " & sURL & " : " & xxx.statustext
SendMail sMailServerAddress, "chad@aviary.info", sEmailAddress, "Classifieds.asp: StatusText<>OK", "Automated email:" & sURL & " : " & xxx.statustext & vbcrlf & xxx.ResponseText, sBBSEmailComponent
If Testing Then Response.End
End If
Set xxx = Nothing
End If
End If
sngCredit = FormatCurrency(sngCredit)
End Sub

Sub GetAd(iPrice, sURL, sFormData)
On Error Resume Next
If Response.IsClientConnected=false Then Response.End
Dim lResolve, lConnect, lSend, lReceive
lResolve = 10 * 1000
lConnect = 10 * 1000
lSend = 30 * 1000
lReceive = 30 * 1000
If sngCredit>=iPrice Then
Dim xxx
Set xxx = Server.CreateObject("MSXML2.ServerXMLHTTP")
xxx.setTimeouts lResolve, lConnect, lSend, lReceive
xxx.Open "GET", sURL & "?" & sFormData, False
xxx.Send

If TESTING then
Response.Write xxx.ResponseText
Response.End
End If

If instr(1,xxx.statusText,"OK")>0 Then
sngCredit=sngCredit-iPrice
Err.Clear
dbConnection.Execute "UPDATE MEMBERS SET CREDIT=" & sngCredit & " WHERE MEMBERID=" & iMEMBERID
If TESTING and Err.number <> 0 then
Response.Write "ERROR-" & err.description & "-
"
Response.End
End If
Else
Response.Write "Failed: " & sURL & " : " & xxx.statustext
End If
Set xxx = Nothing
End If
sngCredit = FormatCurrency(sngCredit)
End Sub

Function ReplaceCrLfInQuotes(ByVal sValue) ' As String
' Replaces any linefeeds / carriage returns / CrLfs inside quoted text
' Does not alter the original string
Dim regEx ' As VBScript.RegExp
Dim sMatch ' As String
Dim oMatch ' As Match
Set regEx = Server.CreateObject("VBScript.RegExp")
regEx.Global = True
regEx.Pattern = """([\s\S]*?)""" ' get content within any quotes
For Each oMatch In regEx.Execute(sValue)
regEx.Pattern="[\f\n\r]+" ' set pattern to remove linefeeds etc
sMatch = regEx.Replace(oMatch.SubMatches("0"), " ")
regEx.Pattern = "\s{2,}" ' replace any excess spaces that may have appeared
sMatch = regEx.Replace(sMatch, " ")
sValue = Replace(sValue, oMatch.SubMatches("0"), sMatch)
Next
Set regEx = Nothing
ReplaceCrLfInQuotes = sValue
End Function

Function BirdsnWaysSetup
Dim s_birdtype, s_species, sSpeciesSubmitted
Dim BnW(3)
sSpeciesSubmitted=lcase(request((Question(iSubjQ,1))))
If instr(1,lcase(request((Question(13,1)))),"breeder")>0 Then
BnW(1)="breeding"
ElseIf instr(1,lcase(request((Question(13,1)))),"adult")>0 Then
BnW(1)="adults"
Else
BnW(1)="babies"
End If
If instr(1,sSpeciesSubmitted,"african grey")>0 Then
BnW(2)="African Greys"
ElseIf instr(1,sSpeciesSubmitted,"african gray")>0 Then
BnW(2)="African Greys"
ElseIf instr(1,sSpeciesSubmitted,"amazon")>0 Then
BnW(2)="Amazons"
ElseIf instr(1,sSpeciesSubmitted,"budgie")>0 Then
BnW(2)="Budgies"
ElseIf instr(1,sSpeciesSubmitted,"caique")>0 Then
BnW(2)="Caiques"
ElseIf instr(1,sSpeciesSubmitted,"canar")>0 Then
BnW(2)="Canary"
ElseIf instr(1,sSpeciesSubmitted,"cockati")>0 Then
BnW(2)="Cockatiels"
ElseIf instr(1,sSpeciesSubmitted,"cockato")>0 Then
BnW(2)="Cockatoo"
ElseIf instr(1,sSpeciesSubmitted,"conur")>0 Then
BnW(2)="Conures"
ElseIf instr(1,sSpeciesSubmitted,"eclect")>0 Then
BnW(2)="Eclectus"
ElseIf instr(1,sSpeciesSubmitted,"finch")>0 Then
BnW(2)="Finches"
ElseIf instr(1,sSpeciesSubmitted,"hawk")>0 Then
BnW(2)="Hawkheadeds"
ElseIf instr(1,sSpeciesSubmitted,"jardine")>0 Then
BnW(2)="Jardines"
ElseIf instr(1,sSpeciesSubmitted,"kakarikis")>0 Then
BnW(2)="Kakarikis"
ElseIf instr(1,sSpeciesSubmitted,"lor")>0 Then
BnW(2)="Lories"
ElseIf instr(1,sSpeciesSubmitted,"lovebird")>0 Then
BnW(2)="Lovebirds"
ElseIf instr(1,sSpeciesSubmitted,"macaw")>0 Then
BnW(2)="Macaws"
ElseIf instr(1,sSpeciesSubmitted,"meyer")>0 Then
BnW(2)="Meyers"
ElseIf instr(1,sSpeciesSubmitted,"keet")>0 Then
BnW(2)="Parakeets"
ElseIf instr(1,sSpeciesSubmitted,"parrotlet")>0 Then
BnW(2)="Parrotlets"
ElseIf instr(1,sSpeciesSubmitted,"pionus")>0 Then
BnW(2)="Pionus"
ElseIf instr(1,sSpeciesSubmitted,"poicephalus")>0 Then
BnW(2)="Poicephalus"
ElseIf instr(1,sSpeciesSubmitted,"quaker")>0 Then
BnW(2)="Quakers"
ElseIf instr(1,sSpeciesSubmitted,"ringneck")>0 Then
BnW(2)="Ringnecks"
ElseIf instr(1,sSpeciesSubmitted,"rosella")>0 Then
BnW(2)="Rosellas"
ElseIf instr(1,sSpeciesSubmitted,"senegal")>0 Then
BnW(2)="Senegals"
ElseIf instr(1,sSpeciesSubmitted,"vasas")>0 Then
BnW(2)="Vasas"
Else
BnW(2)="Other Species"
BnW(3)=ucase(sSpeciesSubmitted)
End If
BirdsnWaysSetup=BnW
End Function

Function ProperCase(sPropercase)
' Purpose: Convert the case of var so that the first letter of each word capitalized.
Dim strV, intChar , i
Dim fWasSpace

If IsNull(sPropercase) Then Exit Function
strV = sPropercase
fWasSpace = True
For i = 1 To Len(strV)
intChar = Asc(Mid(strV, i, 1))
If IntChar>=65 and IntChar<=90 Then
If Not fWasSpace Then strV = Left(strv,i-1) & Chr(intChar Or &H20) & Right(strv,(len(strv)-i))
Else
If IntChar>=97 and IntChar<=122 Then
If fWasSpace Then strV = Left(strv,i-1) & Chr(intChar And &HDF) & Right(strv,(len(strv)-i))
End If
End If
fWasSpace = (intChar = 32)
Next
ProperCase = strV
End Function
%>

Stats
Goal:	$100.00
Due Date:	Nov 30
Gross Amount:	$0.00
Net Balance:	$0.00
Left to go:	$100.00

Remote Host Information Posting (advanced)

Re: Remote Host Information Posting (advanced)

Login

Search

Recent Posts

XOOPS MyMenus 1.54.0 Beta 10

Re: XOOPS MyMenus 1.54.0 Beta 7

Re: XOOPS MyMenus 1.54.0 Beta 7

Re: XOOPS MyMenus 1.54.0 Beta 7

Re: XOOPS MyMenus 1.54.0 Beta 7

Re: XOOPS MyMenus 1.54.0 Beta 7

Re: XOOPS MyMenus 1.54.0 Beta 7

Re: XOOPS MyMenus 1.54.0 Beta 7

Re: XOOPS MyMenus 1.54.0 Beta 7

Re: XOOPS MyMenus 1.54.0 Beta 7

Who's Online

Donat-O-Meter

Latest GitHub Commits

{{ record.sha.slice(0, 7) }} - {{ record.commit.message | truncate }}