It doesnt seem to work.
strhtml = wrapper.WebPageData
strhtml = wrapper.PostWrapper("www.neopets.com/login.phtml", "destination=%2Findex.phtml&username=&password=&x=&y=", "http://www.neopets.com/hi.phtml")
If InStr(1, strhtml, "logout") Then
MessageBox.Show("Logged in!!")
Else
MessageBox.Show("Login Failed")
End IfThats the code for the login that doesnt work.
This is the wrapper :
Imports System.Web
Imports System.Net
Imports System.IO
Imports System.Security.Cryptography
Public Class HTTPWrapper
'HTTPWrapper Class by Blazer
'Version 0.2, 2010 - 04/02/10
Public LastPage As String
Public WebPageData As String
Public RequestHeader As HttpWebRequest
Public HeaderResponse As HttpWebResponse
Public CC As CookieContainer = New CookieContainer()
Public ContentType As String = "application/x-www-form-urlencoded"
Public UserAgent As String = "Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.9.2.3) Gecko/20100401 Firefox/3.6.3 ( .NET CLR 3.5.30729; .NET CLR 4.0.20506)"
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Function GetWrapper(ByVal Uri$, Optional ByVal Referer$ = vbNullString)
On Error Resume Next
LastPage = Uri
If (Len(Referer) = 0) Then
RequestHeader = CType(WebRequest.Create(Uri), HttpWebRequest)
With RequestHeader
.Method = WebRequestMethods.Http.Get
.Referer = LastPage
.KeepAlive = True
.UserAgent = UserAgent
.CookieContainer = CC
HeaderResponse = .GetResponse()
Dim Stream As New StreamReader(HeaderResponse.GetResponseStream())
WebPageData = Stream.ReadToEnd()
HeaderResponse.Close()
End With
Else
RequestHeader = CType(WebRequest.Create(Uri), HttpWebRequest)
With RequestHeader
.Method = WebRequestMethods.Http.Get
.Referer = Referer
.KeepAlive = True
.UserAgent = UserAgent
.CookieContainer = CC
HeaderResponse = .GetResponse()
Dim Stream As New StreamReader(HeaderResponse.GetResponseStream())
WebPageData = Stream.ReadToEnd()
HeaderResponse.Close()
End With
End If
End Function
Function PostWrapper(ByVal Uri$, ByVal Post$, Optional ByVal Referer$ = vbNullString)
On Error Resume Next
LastPage = Uri
If (Len(Referer) = 0) Then
With RequestHeader
RequestHeader = CType(WebRequest.Create(Uri), HttpWebRequest)
.Referer = LastPage
.KeepAlive = True
.UserAgent = UserAgent
.CookieContainer = CC
.Method = WebRequestMethods.Http.Post
.ContentType = ContentType
.ContentLength = Post.Length
Dim writer As New StreamWriter(.GetRequestStream)
writer.Write(Post)
writer.Close()
HeaderResponse = .GetResponse()
Dim reader As New StreamReader(HeaderResponse.GetResponseStream())
WebPageData = reader.ReadToEnd()
HeaderResponse.Close()
End With
Else
With RequestHeader
RequestHeader = CType(WebRequest.Create(Uri), HttpWebRequest)
.Referer = Referer
.KeepAlive = True
.UserAgent = UserAgent
.CookieContainer = CC
.Method = WebRequestMethods.Http.Post
.ContentType = ContentType
.ContentLength = Post.Length
Dim writer As New StreamWriter(.GetRequestStream)
writer.Write(Post)
writer.Close()
HeaderResponse = .GetResponse()
Dim reader As New StreamReader(HeaderResponse.GetResponseStream())
WebPageData = reader.ReadToEnd()
HeaderResponse.Close()
End With
End If
End Function
Function ClearCookies()
On Error Resume Next
CC = New Net.CookieContainer()
End Function
Function URLEncode(ByVal Encode$) As String
URLEncode = Encode
System.Web.HttpUtility.UrlEncode(URLEncode)
End Function
Function URLDecode(ByVal Decode$) As String
URLDecode = Decode
System.Web.HttpUtility.UrlDecode(URLDecode)
End Function
Function TimeStamp() As String
Dim date1970 As Date = "#1/1/1970 12:00:00 AM#"
Dim datenow As Date = Date.Now
TimeStamp = DateDiff(DateInterval.Second, date1970, datenow)
End Function
Public Function ConvertTimeStamp(ByVal _UnixTimeStamp As Long) As DateTime
Return (New DateTime(1970, 1, 1, 0, 0, 0)).AddSeconds(_UnixTimeStamp)
End Function
Public Function Rand(ByVal low As Long, _
ByVal high As Long) As Long
Rand = Int((high - low + 1) * Rnd) + low
End Function
Public Sub Wait(ByVal milliseconds As Long)
'Wait the specified number of milliseconds without hanging the program
Dim StartTime As Long, StopTime As Long
StartTime = timeGetTime
StopTime = StartTime + milliseconds
Application.DoEvents()
Do Until timeGetTime > StopTime
Application.DoEvents()
Loop
End Sub
Function DownloadImage(ByVal URL$, ByVal Name$)
On Error Resume Next
If (Dir(Application.StartupPath + "\" + Name + ".jpg") <> vbNullString) Then
My.Computer.Network.DownloadFile(URL, Application.StartupPath + "\" + Name + ".jpg")
Else
System.IO.File.Delete(Application.StartupPath + "\" + Name + ".jpg")
My.Computer.Network.DownloadFile(URL, Application.StartupPath + "\" + Name + ".jpg")
End If
End Function
Function DownloadFile(ByVal Uri$)
On Error Resume Next
Dim SFD As New SaveFileDialog, i As Long 'Set our variables
With SFD
.AddExtension = True
.CheckFileExists = False
.CheckPathExists = True
.CreatePrompt = False
SFD.Filter = "All Files (*.*)|*.*" 'Set out filters
SFD.ShowDialog() 'Show File Dialog
If (Len(SFD.FileName) = 0) Then 'To Skip the nasty error of "Empty File Path." So if there's no file destination chosen, then it will automatically exit.
Exit Function 'Exit Our Function
End If 'End Statement
My.Computer.Network.DownloadFile(Uri, SFD.FileName)
End With
End Function
Function RDLE(ByRef ListBox As ListBox)
On Error Resume Next
'RDE = Remove Duplicate List Entries
For x% = 0 To ListBox.Items.Count - 1
For y% = 0 To ListBox.Items.Count - 1
If (x% <> y%) Then
Application.DoEvents()
If (ListBox.Items.Item(x%).ToString = ListBox.Items.Item(y%).ToString) Then
ListBox.Items.RemoveAt(y%)
End If
End If
Application.DoEvents()
Next y%
Application.DoEvents()
Next x%
End Function
Private Function Array(ByRef strArray() As String, ByVal strTemp As String) As Long
For y% = LBound(strArray) To UBound(strArray)
If (Len(strArray(y)) = 0) Then Exit For
If (InStr(1, strArray(y), strTemp)) Then
Array = y + 1
Exit Function
End If
Application.DoEvents()
Next
Array = 0
End Function
Function RDSE(ByRef strArray$()) As String()
'Remove Duplicate String Entries
On Error Resume Next
Dim strTemp() As String, y As Long
For x% = 0 To UBound(strArray)
If (Array(strTemp, strArray(x%)) = 0) Then
strTemp(y) = strArray(x%)
y += 1
ReDim Preserve strTemp(y)
End If
Application.DoEvents()
Next x%
RDSE = strTemp
End Function
Function Hash(ByVal Temp$, Optional ByVal Content$ = vbNullString) As String
On Error Resume Next
Hash = LCase(MD5Hash(LCase(MD5Hash(Temp)) + Content))
End Function
Private Function MD5Hash(ByVal Content$) As String
Dim M5 As New MD5CryptoServiceProvider
Dim ByteString() As Byte = System.Text.Encoding.ASCII.GetBytes(Content)
ByteString = M5.ComputeHash(ByteString)
Dim FinalString As String = Nothing
For Each bt As Byte In ByteString
FinalString &= bt.ToString("x2")
Next
Return FinalString
End Function
Public Function GetStringBetween(ByVal InputText As String, ByVal StartText As String, ByVal EndText As String, Optional ByVal StartPosition As Object = 1) As String
Dim lnTextStart As Integer, lnTextEnd As Integer
lnTextStart = InStr(StartPosition, InputText, StartText, CompareMethod.Text) + Len(StartText)
lnTextEnd = InStr(lnTextStart, InputText, EndText, CompareMethod.Text)
If lnTextStart >= (StartPosition + Len(StartText)) And lnTextEnd > lnTextStart Then
GetStringBetween = Mid(InputText, lnTextStart, lnTextEnd - lnTextStart)
Else
GetStringBetween = vbNullString
End If
End Function
Public Function GBA(ByRef strSource As String, ByRef strStart As String, ByRef strEnd As String, ByVal lstAdd As ListBox, Optional ByRef startPos As Integer = 0) As String
Dim iPos As Integer, iEnd As Integer, strResult As String, lenStart As Integer = strStart.Length
Do Until iPos = -1
strResult = String.Empty
iPos = strSource.IndexOf(strStart, startPos)
iEnd = strSource.IndexOf(strEnd, iPos + lenStart)
If iPos <> -1 AndAlso iEnd <> -1 Then
strResult = strSource.Substring(iPos + lenStart, iEnd - (iPos + lenStart))
lstAdd.Items.Add(strResult)
startPos = iPos + lenStart
End If
Loop
GBA = vbNullString
End Function
Function LoadListBox(ByRef ListBox As ListBox)
Dim OFD As New OpenFileDialog 'Set out chosen variables
With OFD
.CheckFileExists = True
.CheckPathExists = True
.Multiselect = False
.RestoreDirectory = True
.Title = "Please select an Input file" 'Set the "Title" of the Open File Dialog
.Filter = "All Files (*.*)|*.*" 'Set out filters.
.ShowDialog() 'Show Out Open File Dialog
If (Len(OFD.FileName) = 0) Then 'Checks to see if their's any file chosen. If therer isn't, then it will exit the nasty error of "Empty File Path."
Exit Function 'Exit Our Function
End If 'End of Statement
Dim Stream As IO.StreamReader 'Read the lines from the file.
Stream = New IO.StreamReader(OFD.FileName) 'Set our Variable Stream to read the file selected in Open File Dialog
While (Stream.Peek() > -1) 'Start counting down the number of lines in the file.
ListBox.Items.Add(Stream.ReadLine) 'Begin adding the files content into the specified listbox
End While 'Once done, Exit.
Stream.Dispose()
Stream.Close() 'Once done reading, exit.
End With
End Function
Function SaveListBox(ByRef ListBox As ListBox)
Dim SFD As New SaveFileDialog, i As Long 'Set our variables
With SFD
.AddExtension = True
.CheckFileExists = False
.CheckPathExists = True
.CreatePrompt = False
SFD.Filter = "All Files (*.*)|*.*" 'Set out filters
SFD.ShowDialog() 'Show File Dialog
If (Len(SFD.FileName) = 0) Then 'To Skip the nasty error of "Empty File Path." So if there's no file destination chosen, then it will automatically exit.
Exit Function 'Exit Our Function
End If 'End Statement
Dim W As New IO.StreamWriter(SFD.FileName) 'Read the number of lines
For i = 0 To ListBox.Items.Count - 1 'Count how many items are in the specified listbox
W.WriteLine(ListBox.Items.Item(i)) 'start writing the items from the specified listbox to file
Next
W.Close() 'once the writer known as "w" is done with writing the items to file. It will close.
End With 'Done with Save File Dialog
End Function
Function SaveTextBox(ByRef TextBox$)
Dim SFD As New SaveFileDialog
With SFD
.AddExtension = True
.CheckFileExists = False
.CheckPathExists = True
.CreatePrompt = False
SFD.Filter = "All Files (*.*)|*.*" 'Set out filters
SFD.ShowDialog() 'Show File Dialog
If (Len(SFD.FileName) = 0) Then 'To Skip the nasty error of "Empty File Path." So if there's no file destination chosen, then it will automatically exit.
Exit Function 'Exit Our Function
End If 'End Statement
System.IO.File.WriteAllText(SFD.FileName, TextBox)
End With
End Function
Function LoadTextBox(ByRef TextBox As TextBox)
Dim OFD As New OpenFileDialog
With OFD
.CheckFileExists = True
.CheckPathExists = True
.Multiselect = False
.RestoreDirectory = True
.Title = "Please select an Input file" 'Set the "Title" of the Open File Dialog
.Filter = "All Files (*.*)|*.*" 'Set out filters.
.ShowDialog() 'Show Out Open File Dialog
If (Len(OFD.FileName) = 0) Then 'Checks to see if their's any file chosen. If therer isn't, then it will exit the nasty error of "Empty File Path."
Exit Function 'Exit Our Function
End If 'End of Statement
Dim sr As New IO.StreamReader(OFD.FileName)
TextBox.Text = sr.ReadToEnd()
sr.Close()
End With
End Function
End Class
Credits to Blazer for the wrapper, Im just using it.
Someone please help me
Edited by Bman, 06 May 2010 - 01:58 PM.
