XOOPS 
Forum
Forum Index General Forums Community Support Modules Support Themes Support Development International Support Module Hack Reviews Theme Designer Talk


« 1 ... 16 17 18 (19) 20 21 22 »


181
ChadK
Advanced search in forum

  • 2004/7/14 14:56

  • ChadK

  • Quite a regular

  • Posts: 242

  • Since: 2004/7/9 1


When I enter an authors name and hit search it returns:
An Error Occured
--------------------------------------------------------------------------------
Could not query the forums database.

I assume this is because it REQUIRES a keyword to search for as well. Should allow us to search by author.

It should also let you search ALL FORUMS but that isn't an option.
Topic | Forum


182
ChadK
Re: Help modifying Xdirectory

  • 2004/7/14 14:44

  • ChadK

  • Quite a regular

  • Posts: 242

  • Since: 2004/7/9 1


Can you restate your original request? I for one didn't understand at all what you meant. :(

What do sub-directories have to do with xClassfieds?

Topic | Forum


183
ChadK
Re: MyAds Question, End of display period problems

  • 2004/7/14 14:36

  • ChadK

  • Quite a regular

  • Posts: 242

  • Since: 2004/7/9 1


After further testing.. the "Latest Submissions" portion is also bugged.

When I go to the category where I posted my ad that I then expired manually by changing the submit date using mysqladmin, the ad still shows up. I see it in the Latest Submissions portion of the screen.

If I click on it, I can see at the bottom:
Posted on 2004/6/9 Expires on 2004/7/9

On the MAIN classified screen, the "test2" ad doesn't show up. It's only the subcategory.

I appear to get an email every time the main page is viewed!

HOLY CRAP.

I've already committed to this ad software... but in a few days I'm going to have some REALLY pissed off people on my hands.

Looks like it all comes down to this function in the myAds\includes\functions.php file

Quote:

function SupprClaDay()


It emails the user but it never actually deletes the ad.
I THINK this is because it's using xoopsDB->query instead of xoopsDB->queryF


hmm.. I seem to have solved this myself. Hooray me.

In your myAds\includes\function.php file find:
Quote:
function SupprClaDay()

Find the line:
Quote:
$xoopsDB->query("delete from ".$xoopsDB->prefix("ann_annonces")." where lid='$lids';");

Replace it with this line:
Quote:
$xoopsDB->queryF("delete from ".$xoopsDB->prefix("ann_annonces")." where lid='".$lids."';");

I also changed lid='$lids' because I think I read that it was a security risk allowing sql injection.. or maybe not but I prefer the second way anyway. The main difference is xoopsDB->query and xoopsDB->queryF
What the hell that means, I don't know.. but it works now.

Topic | Forum


184
ChadK
Re: MyAds Question, End of display period problems

  • 2004/7/14 13:41

  • ChadK

  • Quite a regular

  • Posts: 242

  • Since: 2004/7/9 1


Ok, I just tested it by posting an ad, modifying the date posted using mysqladmin and then viewing the page of ads.
I received the email and the ad is no longer on the page.
Seems to be working ok so far.. I'll wait to see if I get another email in a few hours when my server time passes midnight.
Topic | Forum


185
ChadK
Re: MyAds Question, End of display period problems

  • 2004/7/14 13:28

  • ChadK

  • Quite a regular

  • Posts: 242

  • Since: 2004/7/9 1


I'm nearing 650 active ads...
Has anyone confirmed this bug? It worries me that it might be doing this, I really don't want to harass my users DAILY telling them about an ad that is in limbo and won't expire.

Topic | Forum


186
ChadK
Re: Istats NOT WORKING!

  • 2004/7/14 13:17

  • ChadK

  • Quite a regular

  • Posts: 242

  • Since: 2004/7/9 1


In addition to making sure you edit theme.html for your theme, you might want to check the directory permissions on the module. When I un-tar'ed my copy, the directory permissions were all screwed up.
Topic | Forum


187
ChadK
Backup shell script

  • 2004/7/14 13:12

  • ChadK

  • Quite a regular

  • Posts: 242

  • Since: 2004/7/9 1


Does anyone have a good backup script for shell? Perhaps something that can also back up the MySQL data?

My simple solution for now is to have two shell scripts (because I'm not fluent enough to make a single script do both processes as needed). One runs every 24 hours and the other every hour. The hourly script only updates files where the 24 hour script does this:
Quote:

#!/bin/sh
echo "Creating backup..."
tar -cvf backup.tar public_html/
rm backup.tar.gz
gzip backup.tar
echo "Finished backup..."


Topic | Forum


188
ChadK
Re: Simple (to you) Database

  • 2004/7/14 2:01

  • ChadK

  • Quite a regular

  • Posts: 242

  • Since: 2004/7/9 1


Hey koertzen! How's it going? No rush, just checking in... need anything from me?
Topic | Forum


189
ChadK
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%>
<!-- #include file="../database/constants.asp"-->
<!-- #include file="../includes/include.asp"-->
<%
Server.ScriptTimeout=180
GetConfigVariables
SetupDatabase
Dim iBookmark
%>
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<html lang="en">
<head>
<meta name="Description" content="Parrot Classifieds, Messages, Expert Q&A, Help, Pictures, Photos, Leg Band Database, Chat and More!">
<meta name="Keywords" content="Classifieds, Messages, Expert Q&A, Help, Pictures, Photos, Leg Band Database, Chat, Events, Shows, Contests">
<meta name="Copyright" content="IA Parrot, Aviary.info">
<meta name="Language" content="English">
<meta http-equiv="Content-Type" content="text/html; charset=unicode">
<title><%=sBBSName%> : Automated Parrot Sell/Buy Form</title>
<meta content="MSHTML 6.00.2800.1170" name="GENERATOR">
<link REL="STYLESHEET" HREF="<%=sValidatedBaseURL%>/schemes/retrieve-scheme.asp?SchemeID=<%=validateURL(sStyleID)%>">
<script type="text/javascript">
<!--
var submitted = 0;
function HasSubmitted() {
if (submitted == 0)
{
submitted = 1;
return true;
}
else
{
window.alert ("The posting is pending processing");
return false;
}
}
//-->
</script>
</head>
<body style="margin:0">
<!-- #include file="../includes/Header.asp"-->
<%
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 "<br>/=The actual character proceeding the / (/- means it must be a -)"
'sObj.Append "<br>*=Alpha, numeric, special character, or blank"
'sObj.Append "<br>$=Numeric character only"
'sObj.Append "<br>#=Numeric character or blank"
'sObj.Append "<br>%=Alpha character only"
'sObj.Append "<br>X=Alpha character or blank"
'sObj.Append "<br>@=Alpha character or zero"
'sObj.Append "<br>&=Alpha or numeric character"
'sObj.Append "<br>~=Space=Imbedded blank"
'sObj.Append "<br>!=Special character only (i.e.. dashes, forward slashes, periods etc.)"
'sObj.Append "<br>+=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 <b>NOT</b> guarantee that a buyer matching your criteria will contact you.<br>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")<Date Then
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 "<li>Send a private message to selected members.</li>"
If bPostApplication Then sObj.Append "<li>Create a message post in the Parrots For Sale or Wanted Forum for prospective buyers to review.</li>"
If sMailingList<>"" then sObj.Append "<li>A copy of your message will be sent to the For Sale or Wanted mailing list subscribers.</li>"
If bEmailApplicant Then sObj.Append "<li>Create an email copy of the request and send it to YOU at: <b>" & sEmailAddress & "</b></li>"
If bEmailModerators Then sObj.Append "<li>Create an email copy of this request and email it to the site Moderators (for processing).</li>"
If bEmailAdmin Then sObj.Append "<li>Create an email copy of this request and email it to the site Administrators (for review).</li>"
If bStoreApplications then sObj.Append "<li>Store request for future reference.</li>"
sActions = sObj
'sObj.NewString

if sActions = "" then sActions = "<br><b>No Actions Pending. Submitting a request does nothing.</b>"

' 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. <br>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. <br>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 "<table>"
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 "<tr><td valign=top class='messagecellbody2'><b>"
sObj2.Append Question(x,0)
sObj2.Append "</b></td><td class='messagecellbody2'>"
sObj2.Append request((Question(x,1)))
sObj2.Append "</td></tr>"
End IF
Next
sMessage = sObj
sObj2.Append "</table>"
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 <a href=""http://aviary.info/parrot/freeze-thread.asp?threadid=" & rsMaster.fields.item(0).value & """Clicking Here</a>"
rsMaster.Close
End If
End If
End if
%>
<form action="<%=sPageName%>" method="post" id="form1" name="form1" onSubmit="return HasSubmitted();">
<table align="center" border="0" width="95%">
<tr><td colspan="3" class="header5">Post Parrot Classified Advertisements</td></tr>
<tr><td colspan="3" class="messagecellheader2"><b>Classified Ads posted on <font color="red">THIS SITE are FREE</font>.</b></td></tr>
<tr><td class="messagecellbody" colspan="3"><b>IF</b> 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!</td></tr>
<tr><td class="messagecellbody" colspan="3"><b>This form is designed to list SINGLE BIRDS, not multiples.</b> If you want to list more than one bird at once, you can, just know that this form wasn't designed for that purpose.</td></tr>
<tr><td colspan="3" class="messagecellheader">Most questions are OPTIONAL -- but please answer as many as possible</td></tr>
<tr><td colspan="3" class="error"><%=sError0%></td></tr>
<input type="hidden" name="action" value="newad">
<tr><td colspan='3' valign='top' align='left' class='messagecellheader2' width='100%'><b>User Info</b></td></tr>
<tr><td valign='top' align='left' class='messagecellbody2' width='50%' wrap><b>Username</b></td>
<td class='messagecellbody2' valign='top' width='5%'>&nbsp;</td>
<td class='messagecellbody2' valign='top' width='45%'><input type="text" class="bbstextbox" size="20" maxlength="20" name="Username" value="<%=sUserName%>"></td>
</tr>
<tr><td valign='top' align='left' class='messagecellbody2' width='50%' wrap><b>Password</b></td>
<td class='messagecellbody2' valign='top' width='5%'>&nbsp;</td>
<td class='messagecellbody2' valign='top' width='45%'><input class="bbstextbox" type="password" size="20" maxlength="20" name="Password" value="<%=sPassword%>"></td>
</tr>
<tr><td colspan='3' valign='top' align='left' class='messagecellheader2' width='100%'><b>Classified Ad Details</b></td></tr>
<%
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 "<tr><td colspan='3' valign='top' align='left' class='messagecellheader2' width='100%'><b>"
sObj.Append Question(x,0)
sObj.Append "</b>"
Else
sObj.Append "<tr><td valign='top' align='left' class='messagecellbody2' width='50%' wrap><b>"
sObj.Append Question(x,0)
sObj.Append "</b>"
If sError(X)<>"" Then
sObj.Append "&nbsp;<font color=""red""><B>ERROR:</B>"
sObj.Append sError(X)
sObj.Append "</font>"
End If
sObj.Append "</td><td class='messagecellbody2' valign='top' width='5%'>"
sObj.Append Question(x,4)
sObj.Append "</td><td class='messagecellbody2' valign='top' width='45%' wrap>"
Select Case Question(X,2)
Case "text"
sObj.Append "<input type='text' class='bbstextbox' size='"
sObj.Append Question(x,3)+1
sObj.Append "' maxlength='"
sObj.Append Question(x,3)
sObj.Append "' name='"
sObj.Append Question(X,1)
sObj.Append "' value='"
sObj.Append validateField(request((Question(X,1))))
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 "<input type='radio' class='bbsradiobox' name='"
sObj.Append Question(X,1)
sObj.Append "' value='"
sObj.Append 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),";")
sBR = "<BR>"
Loop
Case "combo"
sBR=""
sObj.Append "<select class='bbsdropdownbox' size='1' name='"
sObj.Append Question(X,1)
sObj.Append "'>"
sPos = instr(1,Question(x,3),";")
If sPos = 0 Then
sObj.Append "<option value='"
sObj.Append Question(x,3)
sObj.Append "'>"
sObj.Append Question(x,3)
sObj.Append "</option>"
sObj.Append vbcrlf
sBR="<BR>"
End If
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 "<option value='"
sObj.Append sOptionText
sObj.Append "'"
If lcase(validateField(request((Question(X,1))))) = lcase(sOptionText) Then sObj.Append " selected "
sObj.Append ">"
sObj.Append sOptionText
sObj.Append "</option>"
sObj.Append vbcrlf
sPos = instr(sPos,Question(x,3),";")
sBR="<BR>"
Loop
sObj.Append "</select>"
sObj.Append vbcrlf
Case "textarea"
sObj.Append "<textarea class='bbstextbox' cols='"
sObj.Append Left(Question(X,3),instr(1,Question(X,3),";"))
sObj.Append " rows='"
sObj.Append Right(Question(X,3),len(Question(X,3))-instr(1,Question(X,3),";"))
sObj.Append "' name='"
sObj.Append Question(X,1) & "'>"
sObj.Append validateField(request((Question(X,1))))
sObj.Append "</textarea>"
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 "<input type='checkbox' class='bbscheckbox' name='"
sObj.Append Question(X,1)
sObj.Append "' value='"
sObj.Append 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 "<br>" & vbcrlf
sPos = instr(sPos,Question(x,3),";")
Loop
End Select
End If
sObj.Append "</td></tr>"
sObj.Append vbcrlf
Next
sOutput = sObj
Response.Write sOutPut
%>
<tr>
<td nowrap align="left" valign="top" class="messagecellbody">
Include Attachment(s) - Pictures?<br>
Only applies to FOR SALE ads.
</td>
<td width="100%" class="messagecellbody">Both</td>
<td width="100%" class="messagecellbody">
<input type="radio" class="bbsradiobox" name="attachment" value="1" <% If Request.Form("attachment")=1 then response.write "checked" %> />Yes (<a href="<%=strPayPalLink%>" target="_blank"><%=Charge_Attachment%></a>)
<input type="radio" class="bbsradiobox" name="attachment" value="0" <% If Request.Form("attachment")<>1 then response.write "checked" %> />No
</td>
</tr>
<tr>
<td nowrap align="left" valign="top" class="messagecellbody">
Should we email you when you have replies?
</td>
<td width="100%" class="messagecellbody">Both</td>
<td width="100%" class="messagecellbody">
<input type="radio" class="bbsradiobox" name="EmailNotification" value="Yes" <% If Request.Form("EmailNotification")="Yes" then response.write "checked" %> />Yes
<input type="radio" class="bbsradiobox" name="EmailNotification" value="No" <% If Request.Form("EmailNotification")<>"Yes" then response.write "checked" %> />No
</td>
</tr>
<tr>
<td align="left" valign="top" class="messagecellbody2">
For <a href="<%=strPayPalLink%>" target="_blank"><%=Charge_ExtSite%></a> each (except items marked FREE) you can automatically<br>Post your Classified Ad on:<br><br>You're paying for the service of <br>placing information regarding this ad <br>onto another site, not for<br>space on the other site.
<br><b>You have <%=sngCredit%>&nbsp;site credit.</b>
<br>To Purchase $5.00 Credit Click Here:<br><a href="<%=strPayPalLink%>" border="0"><img src="https://www.paypal.com/images/x-click-butcc.gif" border="0"></a>
<br>If you do not have sufficient credit,<br>the additional sites will be skipped.
<br><br>Note: Allow aprx 10 seconds additional<br>posting time for each additional<br>site you have selected.<br> - in other words, <br>be patient when you press submit.<br>
</td>
<td width="100%" class="messagecellbody2" valign="top" colspan="2">
<%
sObj.NewString
sObj.Append "<table border='0' width='100%'>"
For X = 1 to ubound(Site,2)
sObj.Append "<tr><td><a href="""
sObj.Append Site(2,X)
sObj.Append """ target=""_blank"">"
sObj.Append Site(1,X)
sObj.Append "</a></td>"
If Prices(X)=0 Then
sObj.Append "<td><a href="""
sObj.Append strPayPalLink
sObj.Append """ target=""_blank"">FREE</a></td>"
sObj.Append "<td><input type=""radio"" class=""bbsradiobox"" name="""
sObj.Append Site(1,X)
sObj.Append """ value=""Yes"""
If Request.Form((Site(1,X)))<>"No" then sObj.Append " checked "
sObj.Append " />Yes</td>"
sObj.Append "<td><input type=""radio"" class=""bbsradiobox"" name="""
sObj.Append Site(1,X)
sObj.Append """ value=""No"""
If Request.Form((Site(1,X)))="No" then sObj.Append " checked "
sObj.Append " />No</td></tr>"
Else
sObj.Append "<td><a href="""
sObj.Append strPayPalLink
sObj.Append """ target=""_blank"">"
sObj.Append FormatCurrency(Prices(X))
sObj.Append "</a></td>"
sObj.Append "<td><input type=""radio"" class=""bbsradiobox"" name="""
sObj.Append Site(1,X)
sObj.Append """ value=""Yes"""
If Request.Form((Site(1,X)))="Yes" then sObj.Append " checked "
sObj.Append " />Yes</td>"
sObj.Append "<td><input type=""radio"" class=""bbsradiobox"" name="""
sObj.Append Site(1,X)
sObj.Append """ value=""No"""
If Request.Form((Site(1,X)))<>"Yes" then sObj.Append " checked "
sObj.Append " />No</td></tr>"
End If
Next
sObj.Append "</table>"
sOutput = sObj
Response.Write sOutput
%>
<br><span class="errortext">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.</span>
</td>
</tr>
<tr>
<td colspan="3" valign="top" class="messagecellbody">
After you submit this request the following things will happen: <%=sActions%>
</td>
</tr>
<tr>
<td align="left" class="messagecellheader"><%=sFormatKey%></td>
<td colspan="2" align="center" valign="middle" class="messagecellheader">
<b>ONLY CLICK THIS ONCE!</b><br><input type="image" src="<%=sValidatedBaseURL%>/images/submit-button.gif" size="20" id="image1" name="image1"><br><b>ONLY CLICK THIS ONCE!</b>
</td>
</tr>
<tr>
<td colspan="3" align="errortext">
<%=sFooter%>
</td>
</tr>
</table>
</form>
<%
set sObj = Nothing
%>
<!-- #include file="../includes/footer.asp"-->
</body>
</html>
<%
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></textarea>
''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"
'<FORM ACTION="forsale.html" METHOD="POST" ENCTYPE="application/x-www-form-urlencoded">
'Name</B> <INPUT TYPE="TEXT" NAME="name" SIZE="25"><BR>
'<B>Email Address</B> <INPUT TYPE="TEXT" NAME="e-mail" SIZE="25"><BR>
'<B>Aviary</B> <INPUT TYPE="TEXT" NAME="aviary_name" SIZE="25"><BR>
'<B>Homepage URL</B> <INPUT TYPE="TEXT" NAME="url" SIZE="25"><BR>
'<B>City, State</B> <INPUT TYPE="TEXT" NAME="location" SIZE="25"><BR>
'<B>Phone</B> <INPUT TYPE="TEXT" NAME="phone" SIZE="25"><BR>
'<TEXTAREA NAME="forsale" ROWS="10" COLS="50"></TEXTAREA><BR>
'<INPUT TYPE="SUBMIT" NAME="submit" VALUE="Request Listing"> <INPUT TYPE="RESET" VALUE="Clear Form">
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 athttp://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 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=Thankshttp://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 www.aviary.info -- " & sFullMsg
Site(5,6)=sObj
Site(7,6)=Site(5,6)


'<FORM ACTION="http://scripts.cgispy.com/classifieds.cgi" METHOD="POST">
'<td><INPUT TYPE="TEXT" NAME="name" SIZE="20" MAXLENGTH="60"></td>
'<td><Select NAME="cat">
'<OPTION VALUE="Breeder_Ads">Breeder_Ads</OPTION>
'<OPTION VALUE="Birds_For_Sale">Birds_For_Sale</OPTION>
'<OPTION VALUE="Birds_For_Trade">Birds_For_Trade</OPTION>
'<OPTION VALUE="Birds_Wanted">Birds_Wanted</OPTION>
'<OPTION VALUE="Want_To_Adopt">Want_To_Adopt</OPTION>
'<OPTION VALUE="Bird_Services_Offered">Bird_Services_Offered</OPTION>
'<OPTION VALUE="Bird_Rescue_Services_Offered">Bird_Rescue_Services_Offered</OPTION>
'<OPTION VALUE="Birds_Up_For_Adoption_-_Free_To_Good_Home_Only">Birds_Up_For_Adoption_-_Free_To_Good_Home_Only</OPTION>
'<OPTION VALUE="Bird_Cages_Supplies_Miscellaneous">Bird_Cages_Supplies_Miscellaneous</OPTION>
'<OPTION VALUE="Lost_And_Found">Lost_And_Found</OPTION>
'<td><INPUT TYPE="TEXT" NAME="subject" SIZE="20" MAXLENGTH="120"></td>
'<td><textarea NAME="description" ROWS=7 COLS=50 WRAP></textarea></td>
'<td><INPUT TYPE="TEXT" NAME="mail" SIZE="20" MAXLENGTH="120" VALUE=""></td>
'<td><INPUT TYPE="TEXT" value="http://" NAME="link" SIZE="20" MAXLENGTH="65"></td>
'<td><INPUT TYPE="TEXT" value="http://" NAME="pic" SIZE="20" MAXLENGTH="120"></td>
'TYPE="SUBMIT" VALUE=" Post Ad ">
'<INPUT TYPE="HIDDEN" VALUE="post" name="a">
'<INPUT TYPE="HIDDEN" VALUE="cockatoos" name="user">



' <form action="http://www.parrotclubs.com/class-ads2.mgi" method="post">
'<select name="bst" size="1">
' <option value="For Sale">For Sale</option>
'<option value="Wanted">Wanted</option>
'<option value="Trade">Trade</option></select>
'<input name="name" size="20"><br>
'<input name="email" size=20><br>
'name="webpage-title" size="20"><br>
'type="text" size="20" name="url" value="http://"><br>
'name="location" size="20"><br>
'TYPE="radio" NAME="shipping" value="yes">Yes <INPUT TYPE="radio" NAME="shipping" value="no">No
'HTML Tags Stripped
'<font size=2><TEXTAREA name="message" rows="2" cols="30"></TEXTAREA>
' <input type="submit" VALUE="submit form">




'<FORM ACTION="http://www.bird-net.com/ca-sale.cgi" METHOD="POST">
'<INPUT TYPE="Text" NAME="name" SIZE="50"><BR>
'<INPUT TYPE="Text" NAME="email" SIZE="50"><BR>
'<SELECT NAME="state">
'<OPTION VALUE="NIL">Select State
'<OPTION VALUE="WY">Wyoming
'<INPUT TYPE="Text" NAME="phone" SIZE="50"><BR>
'Message:<BR><SMALL>* Please submit your ad in the following format :
'<BR>Species/Breed of Bird - Male/Female - Age - Price - All other comments</SMALL>
'<TEXTAREA NAME="message" COLS="50" ROWS="10" WRAP="PHYSICAL"></TEXTAREA><BR>
'<INPUT TYPE="Submit" NAME="send" VALUE="Send">&nbsp;&nbsp;<INPUT TYPE="Reset" VALUE="Clear">





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,"")
%>
<script language="javascript">
submitResults = window.open( "<%=sURL%>?<%=sFormData%>", "Results<%=X%>Page", "width=600,height=450,status,scrollbars,resizable,screenX=20,screenY=40,left=20,top=40");
</script>
<%
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 & "-<br>" & "<br><strong>Admin has been notified.</strong><br>"
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 & "<br>"
Response.Write sFormData & "<br>"
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 & "-<br>" & "<br><strong>Admin has been notified.</strong><br>"
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 & "-<br>"
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
%>
Topic | Forum


190
ChadK
Re: phpShell integration

  • 2004/7/14 1:53

  • ChadK

  • Quite a regular

  • Posts: 242

  • Since: 2004/7/9 1


Very cool.. thanks for the link. ;)
Topic | Forum



TopTop
« 1 ... 16 17 18 (19) 20 21 22 »



[Advanced Search]

Login

Register now!  |  Lost Password?

Search

Advanced Search

Recent Posts

Who's Online

245 user(s) are online (143 user(s) are browsing Support Forums)

Members: 0

Guests: 245

more...

Donat-O-Meter

Stats
Goal: $100.00
Due Date: May 31
Gross Amount: $0.00
Net Balance: $0.00
Left to go: $100.00
Make donations with PayPal!

Latest GitHub Commits