Well, analyzing your problem from 10000' isn't that easy... can you provide
more details (code, error messages, ...)?
Okay. I'm getting "The remote server returned an error: (500)
internal server error".
I've got a form with two text boxes in the upper left corner,
txtHalfID and txtHalfPassword. There are three text boxes in the
upper right corner, txtISBN, txtDescription and txtPrice. There's
also a drop down combo in the upper right, cmbCondition.
The bottom portion of the screen has a read only multi line text
box called txtResponse, where the raw HTML from the server is
displayed.
Below the left text boxes is a button, btnSignOn. If you click
that button, it will sign you onto Half.com using the ID and
password in the textboxes above it. This part works fine for me.
I can see the "Welcome to eBay" page in txtResponse.
Below the right boxes is a button called btnListBook. When I
click on it it should call four web pages on half.com in order.
First it calls
http://half.ebay.com/help/sell_books.cfm. It fills
in the field in the form there with txtISBN.
Next it calls
http://half.ebay.com/cat/sell/pmsearch.cgi. It
fills out the form there with txtDescription and cmbCondition.
This form allows file uploads, so it's a multipart form. Although
my program's output looks good to me, I get that server error
when I submit this form.
Here's the code:
- Start Code ---------------------------------------------------
Imports System.Net
Public Class SBM
Inherits System.Windows.Forms.Form
Dim cc As New CookieCollection
Const encURL As Integer = 0
Const encMulti As Integer = 1
Private Sub SBM_Load(ByVal sender As System.Object, ByVal e
As System.EventArgs) Handles MyBase.Load
txtHalfID.Text = ""
txtHalfPassword.Text = ""
txtISBN.Text = "0764560255"
txtDescription.Text = "good good"
txtPrice.Text = "99.99"
With cmbCondition
.Items.Add(New Conditions("Brand New", "830"))
.Items.Add(New Conditions("Like New", "840"))
.Items.Add(New Conditions("Very Good", "849"))
.Items.Add(New Conditions("Good", "859"))
.Items.Add(New Conditions("Acceptable", "864"))
.SelectedIndex = 0
End With
cmbCondition.SelectedIndex = 0
End Sub
Private Sub btnSignOn_Click(ByVal sender As System.Object,
ByVal e As System.EventArgs) Handles btnSignOn.Click
Dim HWRequest As HttpWebRequest
Dim strURL As String
Dim HWParameters As Parameters
Dim intFound As Integer
HWRequest = GetRequest
("
https://signin.ebay.com/ws/eBayISAPI.dll?SignIn&UsingSSL=1
&co_partnerid=2&siteid=20")
strURL = "
https://signin.half.ebay.com/ws/eBayISAPI.dll"
HWParameters = ReadResponse(HWRequest, strURL)
intFound = 0
For Each p As Parameter In HWParameters
Select Case p.Name
Case "userid"
p.Value = txtHalfID.Text
intFound += 1
Case "pass"
p.Value = txtHalfPassword.Text
intFound += 1
End Select
If intFound = 2 Then
Exit For
End If
Next
HWRequest = PostRequest(strURL, HWParameters, encURL)
GetResponse(HWRequest)
End Sub
Private Sub btnListBook_Click(ByVal sender As System.Object,
ByVal e As System.EventArgs) Handles btnListBook.Click
Dim strPostData As String
Dim HWRequest As HttpWebRequest
Dim strURL As String
Dim HWParameters As Parameters
Dim intFound As Integer
Dim pr As Parameter
Try
HWRequest = GetRequest
("
http://half.ebay.com/help/sell_books.cfm")
strURL = "
http://half.ebay.com/cat/sell/pmsearch.cgi"
HWParameters = ReadResponse(HWRequest, strURL)
intFound = 0
For Each p As Parameter In HWParameters
Select Case p.Name
Case "p_code"
p.Value = txtISBN.Text
intFound += 1
End Select
If intFound = 1 Then
Exit For
End If
Next
HWRequest = PostRequest(strURL, HWParameters, encURL)
strURL = "/cat/sell/save_new_listing.cgi"
HWParameters = ReadResponse(HWRequest, strURL)
pr = New Parameter
pr.Name = "x"
pr.Value = 20
pr.Type = Parameter.Input
HWParameters.Add(pr)
pr = New Parameter
pr.Name = "y"
pr.Value = 20
pr.Type = Parameter.Input
HWParameters.Add(pr)
intFound = 0
For Each p As Parameter In HWParameters
Select Case p.Name
Case "notes"
p.Value = txtDescription.Text
intFound += 1
Case "condition"
p.Value = cmbCondition.Items
(cmbCondition.SelectedIndex).ItemData
intFound += 1
End Select
If intFound = 2 Then
Exit For
End If
Next
strURL =
"
http://half.ebay.com/cat/sell/save_new_listing.cgi"
HWRequest = PostRequest(strURL, HWParameters,
encMulti)
strURL = "sell.jsp"
HWRequest.Referer =
"
http://half.ebay.com/cat/sell/pmsearch.cgi"
'the internal server error is generated in this call
'to ReadResponse
HWParameters = ReadResponse(HWRequest, strURL)
intFound = 0
For Each p As Parameter In HWParameters
Select Case p.Name
Case "itemPrice"
p.Value = txtPrice.Text
intFound += 1
End Select
If intFound = 1 Then
Exit For
End If
Next
strURL = "
http://half.ebay.com/cat/sell/sell.jsp"
HWRequest = PostRequest(strURL, HWParameters, encURL)
GetResponse(HWRequest)
MessageBox.Show("Success!", MsgBoxStyle.OKOnly, "Book
Posted")
Catch ex As Exception
MessageBox.Show("Error: " & ex.Message, "Error!!!",
MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
MsgBox("Half.com appears to have changed its posting
procedures. As a result, this version of SBM cannot list books on
it.", MsgBoxStyle.Exclamation, "Half.com Listing Problem")
End Try
End Sub
Private Function GetRequest(ByVal strURL As String) As
HttpWebRequest
GetRequest = CreateRequest(strURL)
GetRequest.Method = "GET"
End Function
Private Function PostRequest(ByVal strURL As String, ByVal
PostParameters As Parameters, ByVal intType As Integer) As
HttpWebRequest
Dim encoding As New System.Text.ASCIIEncoding
Dim byte1 As Byte()
Dim newStream As System.IO.Stream
Dim strData As String
Const strBoundary As String =
"---------------------------7d4285126106b0"
PostRequest = CreateRequest(strURL)
PostRequest.Method = "POST"
If intType = encURL Then
PostRequest.ContentType = "application/x-www-form-
urlencoded"
Else
PostRequest.ContentType = "multipart/form-data,
boundary=" & strBoundary
End If
strData = BuildRequestString(PostParameters, intType,
strBoundary)
PostRequest.ContentLength = strData.Length
byte1 = encoding.GetBytes(strData)
newStream = PostRequest.GetRequestStream
newStream.Write(byte1, 0, byte1.Length)
newStream.Close()
End Function
Private Function BuildRequestString(ByVal RequestParameters
As Parameters, ByVal intType As Integer, ByVal strBoundary As
String)
BuildRequestString = ""
Select Case intType
Case encURL
For Each p As Parameter In RequestParameters
BuildRequestString &= p.Name.Trim & "=" &
p.Value.Trim & "&"
Next
BuildRequestString = Mid(BuildRequestString, 1,
Len(BuildRequestString) - 1)
Case encMulti
'the requeststring generated for the multipart form is
'shown below
For Each p As Parameter In RequestParameters
BuildRequestString &= "--" & strBoundary &
vbCrLf & "Content-Disposition: form-data; name=""" & p.Name.Trim
& """"
Select Case p.Type
Case Parameter.File
BuildRequestString &= ";
filename=""""" & vbCrLf & "Content-Type: application/octet-
stream" & vbCrLf & vbCrLf & vbCrLf
Case Parameter.Input
BuildRequestString &= vbCrLf & vbCrLf
& p.Value & vbCrLf
End Select
Next
BuildRequestString &= "--" & strBoundary & "--"
End Select
End Function
Private Function CreateRequest(ByVal strURL As String) As
HttpWebRequest
Dim Uri As Uri
Uri = New Uri(strURL)
CreateRequest = HttpWebRequest.Create(Uri)
CreateRequest.AllowAutoRedirect = True
CreateRequest.CookieContainer = New CookieContainer
If cc.Count > 0 Then
CreateRequest.CookieContainer.Add(cc)
End If
End Function
Private Sub GetResponse(ByVal ReadRequest As HttpWebRequest)
Dim HWResponse As HttpWebResponse
Dim cookie As Cookie
HWResponse = ReadRequest.GetResponse()
If HWResponse.Cookies.Count > 0 Then
For Each cookie In HWResponse.Cookies
cc.Add(cookie)
Next
End If
'debugging
Dim sr As System.IO.StreamReader
Dim strResult As String
sr = New System.IO.StreamReader
(HWResponse.GetResponseStream())
txtResponse.Text = sr.ReadToEnd
sr.Close()
'debugging
End Sub
Private Function ReadResponse(ByVal ReadRequest As
HttpWebRequest, ByVal ReadURL As String) As Parameters
Dim HWResponse As HttpWebResponse
Dim cookie As Cookie
Dim sr As System.IO.StreamReader
Dim strResult As String
Dim intTagPos As Integer
Dim intLength As Integer
Dim intURLPos As Integer
Dim strTag As String
Dim blnFormFound As Boolean
Dim blnMoreForms As Boolean
Dim intPos As Integer
Dim strName As String
Dim strValue As String
Dim ReadParameter As Parameter
Dim intType As Integer
Dim intInputPos As Integer
Dim intTextPos As Integer
Dim intSelectPos As Integer
Dim blnTagFound As Boolean
ReadResponse = New Parameters
'the next line generates the internal server error
HWResponse = ReadRequest.GetResponse()
If HWResponse.Cookies.Count > 0 Then
For Each cookie In HWResponse.Cookies
cc.Add(cookie)
Next
End If
sr = New System.IO.StreamReader
(HWResponse.GetResponseStream())
strResult = sr.ReadToEnd
'debugging
txtResponse.Text = strResult
'debugging
blnFormFound = False
blnMoreForms = True
intTagPos = 1
While Not blnFormFound And blnMoreForms
intTagPos = InStr(intTagPos, strResult.ToUpper,
"<FORM", CompareMethod.Text)
If intTagPos <> 0 Then
intLength = InStr(intTagPos, strResult, ">",
CompareMethod.Text) - intTagPos
strTag = strResult.Substring(intTagPos,
intLength)
intURLPos = InStr(1, strTag.ToUpper,
ReadURL.ToUpper, CompareMethod.Text)
If intURLPos <> 0 Then
intLength = InStr(intTagPos,
strResult.ToUpper, "</FORM>", CompareMethod.Text) - intTagPos
strResult = strResult.Substring(intTagPos,
intLength)
blnFormFound = True
Else
intTagPos += 1
End If
Else
blnMoreForms = False
End If
End While
If blnFormFound Then
intTagPos = 1
While intTagPos <> 0
intInputPos = InStr(intTagPos, strResult.ToUpper,
"<INPUT", CompareMethod.Text)
intTextPos = InStr(intTagPos, strResult.ToUpper,
"<TEXTAREA", CompareMethod.Text)
intSelectPos = InStr(intTagPos,
strResult.ToUpper, "<SELECT", CompareMethod.Text)
intTagPos = IIf(intTextPos <> 0 And intTextPos <
intInputPos, intTextPos, intInputPos)
intTagPos = IIf(intSelectPos <> 0 And
intSelectPos < intTagPos, intSelectPos, intTagPos)
intType = Parameter.Input
If intTagPos <> 0 Then
intLength = InStr(intTagPos, strResult, ">",
CompareMethod.Text) - intTagPos
strTag = strResult.Substring(intTagPos,
intLength)
intPos = InStr(1, strTag.ToUpper,
"TYPE=SUBMIT", CompareMethod.Text)
If intPos = 0 Then
intPos = InStr(1, strTag.ToUpper,
"TYPE=""SUBMIT""", CompareMethod.Text)
End If
If intPos = 0 Then
intPos = InStr(1, strTag.ToUpper,
"NAME=""", CompareMethod.Text)
If intPos = 0 Then
intPos = InStr(1, strTag.ToUpper,
"NAME=", CompareMethod.Text)
intLength = InStr(intPos + 5, strTag,
" ", CompareMethod.Text) - intPos - 5
strName = strTag.Substring(intPos +
4, intLength)
Else
intLength = InStr(intPos + 6, strTag,
"""", CompareMethod.Text) - intPos - 6
strName = strTag.Substring(intPos +
5, intLength)
End If
If intPos <> 0 Then
intPos = InStr(1, strTag.ToUpper,
"VALUE=""", CompareMethod.Text)
If intPos = 0 Then
strValue = ""
Else
intLength = InStr(intPos + 7,
strTag, """", CompareMethod.Text) - intPos - 7
strValue = strTag.Substring
(intPos + 6, intLength)
End If
intPos = InStr(1, strTag.ToUpper,
"TYPE=""FILE""", CompareMethod.Text)
If intPos = 0 Then
intPos = InStr(1, strTag.ToUpper,
"TYPE=FILE", CompareMethod.Text)
End If
intType = IIf(intPos = 0, intType,
Parameter.File)
ReadParameter = New Parameter
ReadParameter.Name = strName
ReadParameter.Value = strValue
ReadParameter.Type = intType
ReadResponse.Add(ReadParameter)
End If
End If
intTagPos += 1
End If
End While
Else
Throw New System.Exception("Form not found.")
End If
End Function
End Class
Public Class Parameters
Inherits System.Collections.CollectionBase
Public Sub Add(ByVal sFld As Parameter)
List.Add(sFld)
End Sub
Public ReadOnly Property Item(ByVal index As Integer) As
Parameter
Get
Return CType(List.Item(index), Parameter)
End Get
End Property
End Class
Public Class Parameter
Public Const Input As Integer = 0
Public Const File As Integer = 1
Dim strName As String
Dim strValue As String
Dim intType As Integer
Public Property Name() As String
Get
Return strName
End Get
Set(ByVal vName As String)
strName = vName
End Set
End Property
Public Property Value() As String
Get
Return strValue
End Get
Set(ByVal vName As String)
strValue = vName
End Set
End Property
Public Property Type() As Integer
Get
Return intType
End Get
Set(ByVal vType As Integer)
intType = vType
End Set
End Property
End Class
Public Class Conditions
Private strName As String
Private strID As String
Public Sub New()
strName = ""
strID = ""
End Sub
Public Sub New(ByVal Name As String, ByVal ID As String)
strName = Name
strID = ID
End Sub
Public Property Name() As String
Get
Return strName
End Get
Set(ByVal sValue As String)
strName = sValue
End Set
End Property
Public Property ItemData() As String
Get
Return strID
End Get
Set(ByVal iValue As String)
strID = iValue
End Set
End Property
Public Overrides Function ToString() As String
Return strName
End Function
End Class
- End Code -----------------------------------------------------
Here's the requeststring generated for the multipart form:
- Start requeststring ------------------------------------------
-----------------------------7d4285126106b0
Content-Disposition: form-data; name="condition"
830
-----------------------------7d4285126106b0
Content-Disposition: form-data; name="notes"
good good
-----------------------------7d4285126106b0
Content-Disposition: form-data; name="image_file"; filename=""
Content-Type: application/octet-stream
-----------------------------7d4285126106b0
Content-Disposition: form-data; name="image_url"
-----------------------------7d4285126106b0
Content-Disposition: form-data; name="version"
729
-----------------------------7d4285126106b0
Content-Disposition: form-data; name="domain_id"
1856
-----------------------------7d4285126106b0
Content-Disposition: form-data; name="meta_id"
1
-----------------------------7d4285126106b0
Content-Disposition: form-data; name="context_name"
w13.1097912464.0000318444
-----------------------------7d4285126106b0
Content-Disposition: form-data; name="x"
20
-----------------------------7d4285126106b0
Content-Disposition: form-data; name="y"
20
-----------------------------7d4285126106b0--
- End requeststring --------------------------------------------
The requeststring looks right to me. I'm wondering if there's a
header I should set that I'm missing.
Thanks for the help.
