Ich möchte einen Bot für MyFreeFarm schreiben, bleibe aber immer beim Login kleben.
Ich benutze den HTTP Client von idb, da mir der empfohlen wurde, dass man sich da nicht um die Cookies kümmern brauch.
Immer wenn ich auf Myfreefarm connecte, lese ich den Createtoken aus, um die nächste URL zu bekommen.
Derjenige, der mir sagen / helfen kann, wie ich es schaffe den Login zu meistern, der bekommt 1 e*gold & 1 Minecraft Premium Account
Code:
With New Utility.Http
'auf die start seite conencten um sicherheitscode auszulesen
Dim Hauptpage_mff As Utility.Http.HttpResponse = .GetResponse("http://myfreefarm.de/", "")
Dim _createtoken As String = _stringbetween(Hauptpage_mff.Html, "land=DE¶ms=0,0,", ",up_mf_st&cou") 'sicherheitscode aulesen
'Login um URL zu bekommen
Dim mff_code_get As Utility.Http.HttpResponse = .GetResponse("http://myfreefarm.de/ajax/createtoken.php?n=" & _createtoken, "server=" & server & "&username=" & username & "&password=" & password & "******&retid=")
MsgBox("URL", mff_code_get.Html)
'URL auseinander
Dim _login_URL_vorgang1 As String = _stringbetween(mff_code_get.Html, "[1," & Chr(34) & "http:\/\/", Chr(34) & "]")
Dim _login_URL_vorgang2 As String = Replace(_login_URL_vorgang1, "\/", "/")
MsgBox(_login_URL_vorgang2)
'Auf die auseinander genommende URL connecten
Dim _login_entgültig As Utility.Http.HttpResponse = .GetResponse(_login_URL_vorgang2, "")
MsgBox(_login_entgültig.Html)
End With
Aber bei Vb.net klappts nichts :/
Code:
Code:
Imports System.Net
Imports System.Text
Imports System.IO
Imports System.Threading
Imports System.Text.RegularExpressions
Imports System.Collections.Specialized
Imports System.IO.Compression
Imports System.Security.Cryptography.X509Certificates
Imports System.Net.WebUtility
Namespace Utility
Public Class Http
#Region "Structures"
Public Structure HttpProxy
Dim Server As String
Dim Port As Integer
Dim UserName As String
Dim Password As String
Public Sub New(ByVal pServer As String, ByVal pPort As Integer, Optional ByVal pUserName As String = "", Optional ByVal pPassword As String = "")
Server = pServer
Port = pPort
UserName = pUserName
Password = pPassword
End Sub
End Structure
Structure UploadData
Dim Contents As Byte()
Dim FileName As String
Dim FieldName As String
Public Sub New(ByVal uContents As Byte(), ByVal uFileName As String, ByVal uFieldName As String)
Contents = uContents
FileName = uFileName
FieldName = uFieldName
End Sub
End Structure
#End Region
#Region "Properties"
Private _TimeOut As Integer = 10000
Public Property TimeOut() As Integer
Get
Return _TimeOut
End Get
Set(ByVal value As Integer)
_TimeOut = value
End Set
End Property
Private _Proxy As HttpProxy = New HttpProxy
Public Property Proxy() As HttpProxy
Get
Return _Proxy
End Get
Set(ByVal value As HttpProxy)
_Proxy = value
End Set
End Property
Private _UserAgent As String = "Mozilla/5.0 (Windows NT 6.1; WOW64; rv:5.0) Gecko/20100101 Firefox/5.0"
Public Property Useragent() As String
Get
Return _UserAgent
End Get
Set(ByVal value As String)
_UserAgent = value
End Set
End Property
Private _Referer As String = String.Empty
Public Property Referer() As String
Get
Return _Referer
End Get
Set(ByVal value As String)
_Referer = value
End Set
End Property
Private _AutoRedirect As Boolean = True
Public Property AutoRedirect As Boolean
Get
Return _AutoRedirect
End Get
Set(ByVal value As Boolean)
_AutoRedirect = value
End Set
End Property
Private _StoreCookies As Boolean = True
Public Property StoreCookies() As Boolean
Get
Return _StoreCookies
End Get
Set(ByVal value As Boolean)
_StoreCookies = value
End Set
End Property
Private _SendCookies As Boolean = True
Public Property SendCookies() As Boolean
Get
Return _SendCookies
End Get
Set(ByVal value As Boolean)
_SendCookies = value
End Set
End Property
Private _GetImage As Boolean = False
Public Property GetImage As Boolean
Get
Return _GetImage
End Get
Set(ByVal value As Boolean)
_GetImage = value
End Set
End Property
#End Region
Public MetaRedirectBlacklist As New List(Of String)
Private Const LineFeed = vbCrLf
Private Request As HttpWebRequest = Nothing
Private Cookies As List(Of HttpCookie)
Private fCookie As String = String.Empty
Public Sub New()
System.Net.ServicePointManager.DefaultConnectionLimit = 500
System.Net.ServicePointManager.Expect100Continue = False
System.Net.ServicePointManager.ServerCertificateValidationCallback = AddressOf AcceptAllCertifications
System.Net.ServicePointManager.UseNagleAlgorithm = False
ServicePointManager.SecurityProtocol = SecurityProtocolType.Ssl3
Cookies = New List(Of HttpCookie)
End Sub
Public Sub CancelRequest()
Try
If Request Is Nothing Then Exit Try
If Request.HaveResponse = False Then Request.Abort()
Catch ex As Exception
Debug.Print(ex.ToString)
End Try
End Sub
Public Function GetResponse(ByVal Uri As String, Optional ByVal PostData As String = "") As HttpResponse
Dim hr As New HttpResponse
request:
Try
If String.IsNullOrEmpty(Uri) Then
hr = New HttpResponse()
hr.Exception = New Exception("Uri was empty.")
Return hr
End If
Request = DirectCast(WebRequest.Create(Uri), HttpWebRequest)
With Request
.Method = IIf(String.IsNullOrEmpty(PostData), "GET", "POST")
Debug.Print(String.Format("[{0}] {1} >> {2}", Now.ToString("hh:mm:ss tt").ToLower, .Method, Uri))
.AllowWriteStreamBuffering = False
.AllowAutoRedirect = False
.KeepAlive = True
.UserAgent = Me.Useragent
.ContentType = IIf(.Method = "POST", "application/x-www-form-urlencoded; charset=UTF-8", String.Empty)
.AutomaticDecompression = DecompressionMethods.GZip And DecompressionMethods.Deflate
.Accept = "text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8"
.Timeout = Me.TimeOut
If Not String.IsNullOrEmpty(Me.Referer) Then .Referer = Me.Referer
If Me.SendCookies Then .Headers.Add("Cookie", GetCookies)
If Not String.IsNullOrEmpty(Me.Proxy.Server) Then
.Proxy = New WebProxy(Me.Proxy.Server, Me.Proxy.Port)
If Not String.IsNullOrEmpty(Me.Proxy.UserName) Then .Proxy.Credentials = New NetworkCredential(Me.Proxy.UserName, Me.Proxy.Password)
End If
.Headers.Add(HttpRequestHeader.AcceptEncoding, "gzip, deflate")
.Headers.Add(HttpRequestHeader.AcceptLanguage, "en-us,en;q=0.5")
.Headers.Add(HttpRequestHeader.AcceptCharset, "ISO-8859-1,utf-8;q=0.7,*;q=0.7")
If Not String.IsNullOrEmpty(PostData) Then
Dim byteArray As Byte() = Encoding.GetEncoding(1252).GetBytes(PostData)
.ContentLength = byteArray.Length
Dim dataStream As Stream = .GetRequestStream()
dataStream.Write(byteArray, 0, byteArray.Length)
dataStream.Close()
End If
Dim Response As HttpWebResponse = CType(.GetResponse(), HttpWebResponse)
If Me.StoreCookies Then ParseCookies(Response)
hr.WebResponse = Response
If Me.AutoRedirect Then
Select Case hr.WebResponse.StatusCode
Case HttpStatusCode.Found, HttpStatusCode.Redirect, HttpStatusCode.Moved, HttpStatusCode.MovedPermanently, HttpStatusCode.RedirectMethod
Uri = hr.WebResponse.Headers("Location")
Try
Dim u As New Uri(Uri)
Catch ex As Exception
End Try
PostData = String.Empty
GoTo request
End Select
End If
If Not hr.WebResponse Is Nothing Then hr.Headers = hr.WebResponse.Headers.ToString
If Not hr.WebResponse.Headers(HttpResponseHeader.ContentType) Is Nothing Then
If hr.WebResponse.Headers(HttpResponseHeader.ContentType).Contains("text/") Or _
hr.WebResponse.Headers(HttpResponseHeader.ContentType).Contains("/xml") Or _
hr.WebResponse.Headers(HttpResponseHeader.ContentType).Contains("/json") Then
GoTo getHtml
ElseIf hr.WebResponse.Headers(HttpResponseHeader.ContentType).Contains("image/") Then
If GetImage Then hr.Image = System.Drawing.Image.FromStream(Response.GetResponseStream)
Else
Debug.Print("Unknown content type: " & hr.WebResponse.Headers(HttpResponseHeader.ContentType))
End If
Else
getHtml:
If Not hr.WebResponse Is Nothing Then hr.Html = HtmlDecode(ProcessResponse(hr.WebResponse))
If Me.AutoRedirect Then
If hr.Html.ToLower.Contains("<meta http-equiv=""refresh") Then
Uri = ParseMetaRefreshUrl(hr.Html)
Dim b As Boolean = True
For Each r As String In MetaRedirectBlacklist
If Uri.ToLower.Contains(r.ToLower) Then
b = False
Exit For
End If
Next
PostData = String.Empty
If b Then GoTo request
End If
End If
End If
End With
Catch ex As Exception
hr.Exception = ex
Finally
Request = Nothing
Me.Referer = String.Empty
End Try
Return hr
End Function
Public Function GetResponse(ByVal Uri As String, ByVal PostData As String, ByVal Headers As NameValueCollection) As HttpResponse
Dim hr As New HttpResponse
request:
Try
If String.IsNullOrEmpty(Uri) Then
hr = New HttpResponse()
hr.Exception = New Exception("Uri was empty.")
Return hr
End If
Debug.Print(PostData)
Request = DirectCast(WebRequest.Create(Uri), HttpWebRequest)
With Request
.Method = IIf(String.IsNullOrEmpty(PostData), "GET", "POST")
Debug.Print(String.Format("[{0}] {1} >> {2}", Now.ToString("hh:mm:ss tt").ToLower, .Method, Uri))
.AllowWriteStreamBuffering = False
.AllowAutoRedirect = False
.KeepAlive = True
.UserAgent = Me.Useragent
.ContentType = IIf(.Method = "POST", "application/x-www-form-urlencoded; charset=UTF-8", String.Empty)
.AutomaticDecompression = DecompressionMethods.GZip And DecompressionMethods.Deflate
.Accept = "text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8"
.Timeout = Me.TimeOut
If Not String.IsNullOrEmpty(Me.Referer) Then .Referer = Me.Referer
If Me.SendCookies Then .Headers.Add("Cookie", GetCookies)
If Not String.IsNullOrEmpty(Me.Proxy.Server) Then
.Proxy = New WebProxy(Me.Proxy.Server, Me.Proxy.Port)
If Not String.IsNullOrEmpty(Me.Proxy.UserName) Then .Proxy.Credentials = New NetworkCredential(Me.Proxy.UserName, Me.Proxy.Password)
End If
.Headers.Add(HttpRequestHeader.AcceptEncoding, "gzip, deflate")
.Headers.Add(HttpRequestHeader.AcceptLanguage, "en-us,en;q=0.5")
.Headers.Add(HttpRequestHeader.AcceptCharset, "ISO-8859-1,utf-8;q=0.7,*;q=0.7")
For Index As Integer = 0 To (Headers.Count - 1)
If Headers.Keys(Index) = "Content-type" Then
.ContentType = Headers(Index)
Else
.Headers.Add(Headers.Keys(Index), Headers(Index))
End If
Next
If Not String.IsNullOrEmpty(PostData) Then
Dim byteArray As Byte() = Encoding.GetEncoding(1252).GetBytes(PostData)
.ContentLength = byteArray.Length
Dim dataStream As Stream = .GetRequestStream()
dataStream.Write(byteArray, 0, byteArray.Length)
dataStream.Close()
End If
Dim Response As HttpWebResponse = CType(.GetResponse(), HttpWebResponse)
If Me.StoreCookies Then ParseCookies(Response)
hr.WebResponse = Response
If Me.AutoRedirect Then
Select Case hr.WebResponse.StatusCode
Case HttpStatusCode.Found, HttpStatusCode.Redirect, HttpStatusCode.Moved, HttpStatusCode.MovedPermanently, HttpStatusCode.RedirectMethod
Uri = hr.WebResponse.Headers("Location")
Try
Dim u As New Uri(Uri)
Catch ex As Exception
End Try
PostData = String.Empty
GoTo request
End Select
End If
If Not hr.WebResponse Is Nothing Then hr.Headers = hr.WebResponse.Headers.ToString
If Not hr.WebResponse.Headers(HttpResponseHeader.ContentType) Is Nothing Then
If hr.WebResponse.Headers(HttpResponseHeader.ContentType).Contains("text/") Or _
hr.WebResponse.Headers(HttpResponseHeader.ContentType).Contains("/xml") Or _
hr.WebResponse.Headers(HttpResponseHeader.ContentType).Contains("/json") Then
GoTo getHtml
ElseIf hr.WebResponse.Headers(HttpResponseHeader.ContentType).Contains("image/") Then
If GetImage Then hr.Image = System.Drawing.Image.FromStream(Response.GetResponseStream)
Else
Debug.Print("Unknown content type: " & hr.WebResponse.Headers(HttpResponseHeader.ContentType))
End If
Else
getHtml:
If Not hr.WebResponse Is Nothing Then hr.Html = HtmlDecode(ProcessResponse(hr.WebResponse))
If Me.AutoRedirect Then
If hr.Html.ToLower.Contains("<meta http-equiv=""refresh") Then
Uri = ParseMetaRefreshUrl(hr.Html)
Dim b As Boolean = True
For Each r As String In MetaRedirectBlacklist
If Uri.ToLower.Contains(r.ToLower) Then
b = False
Exit For
End If
Next
PostData = String.Empty
If b Then GoTo request
End If
End If
End If
End With
Catch ex As Exception
hr.Exception = ex
Finally
Request = Nothing
Me.Referer = String.Empty
End Try
Return hr
End Function
Public Function GetUploadResponse(ByVal Uri As String, ByVal Fields As List(Of DictionaryEntry), ByVal ParamArray Upload As UploadData()) As HttpResponse
Dim hr As New HttpResponse
Dim Boundary As String = Guid.NewGuid().ToString().Replace("-", "")
request:
Try
If String.IsNullOrEmpty(Uri) Then
hr = New HttpResponse()
hr.Exception = New Exception("Uri was empty.")
Return hr
End If
If Fields Is Nothing AndAlso Upload Is Nothing Then
hr = GetResponse(Uri)
Exit Try
End If
Request = DirectCast(WebRequest.Create(Uri), HttpWebRequest)
With Request
.Method = "POST"
Debug.Print(String.Format("[{0}] POST (Multi-Part) >> {1}", Now.ToString("hh:mm:ss tt").ToLower, Uri))
.AllowWriteStreamBuffering = False
.AllowAutoRedirect = False
.KeepAlive = True
.UserAgent = Me.Useragent
.ContentType = IIf(.Method = "POST", "application/x-www-form-urlencoded; charset=UTF-8", String.Empty)
.ContentType = "multipart/form-data; boundary=" & Boundary
.AutomaticDecompression = DecompressionMethods.GZip And DecompressionMethods.Deflate
.Accept = "text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8"
.Timeout = Me.TimeOut
If Not String.IsNullOrEmpty(Me.Referer) Then .Referer = Me.Referer
If Me.SendCookies Then .Headers.Add("Cookie", GetCookies)
If Not String.IsNullOrEmpty(Me.Proxy.Server) Then
.Proxy = New WebProxy(Me.Proxy.Server, Me.Proxy.Port)
If Not String.IsNullOrEmpty(Me.Proxy.UserName) Then .Proxy.Credentials = New NetworkCredential(Me.Proxy.UserName, Me.Proxy.Password)
End If
.Headers.Add(HttpRequestHeader.AcceptEncoding, "gzip, deflate")
.Headers.Add(HttpRequestHeader.AcceptLanguage, "en-us,en;q=0.5")
.Headers.Add(HttpRequestHeader.AcceptCharset, "ISO-8859-1,utf-8;q=0.7,*;q=0.7")
Dim PostData As New MemoryStream()
Dim Writer As New StreamWriter(PostData)
With Writer
If Fields IsNot Nothing Then
For Each f As DictionaryEntry In Fields
.Write(("--" & Boundary) + LineFeed)
.Write("Content-Disposition: form-data; name=""{0}""{1}{1}{2}{1}", f.Key, LineFeed, f.Value)
Next
End If
If Not (Upload Is Nothing) Then
For Each u As UploadData In Upload
.Write(("--" & Boundary) + LineFeed)
.Write("Content-Disposition: form-data; name=""{0}""; filename=""{1}""{2}", u.FieldName, u.FileName, LineFeed)
.Write(("Content-Type: " & GetContentType(u.FileName) & LineFeed) & LineFeed)
.Flush()
If Not (u.Contents Is Nothing) Then PostData.Write(u.Contents, 0, u.Contents.Length)
.Write(LineFeed)
Next
End If
.Write("--{0}--{1}", Boundary, LineFeed)
.Flush()
End With
.ContentLength = PostData.Length
Using s As Stream = .GetRequestStream()
PostData.WriteTo(s)
End Using
PostData.Close()
Dim Response As HttpWebResponse = CType(.GetResponse(), HttpWebResponse)
If Me.StoreCookies Then ParseCookies(Response)
hr.WebResponse = Response
If Me.AutoRedirect Then
Select Case hr.WebResponse.StatusCode
Case HttpStatusCode.Found, HttpStatusCode.Redirect, HttpStatusCode.Moved, HttpStatusCode.MovedPermanently, HttpStatusCode.RedirectMethod
Uri = hr.WebResponse.Headers("Location")
Try
Dim u As New Uri(Uri)
Catch ex As Exception
End Try
Fields = Nothing
Upload = Nothing
GoTo request
End Select
End If
If Not hr.WebResponse Is Nothing Then hr.Headers = hr.WebResponse.Headers.ToString
If Not hr.WebResponse.Headers(HttpResponseHeader.ContentType) Is Nothing Then
If hr.WebResponse.Headers(HttpResponseHeader.ContentType).Contains("text/") Or _
hr.WebResponse.Headers(HttpResponseHeader.ContentType).Contains("/xml") Or _
hr.WebResponse.Headers(HttpResponseHeader.ContentType).Contains("/json") Then
GoTo getHtml
ElseIf hr.WebResponse.Headers(HttpResponseHeader.ContentType).Contains("image/") Then
If GetImage Then hr.Image = System.Drawing.Image.FromStream(Response.GetResponseStream)
Else
Debug.Print("Unknown content type: " & hr.WebResponse.Headers(HttpResponseHeader.ContentType))
End If
Else
getHtml:
If Not hr.WebResponse Is Nothing Then hr.Html = HtmlDecode(ProcessResponse(hr.WebResponse))
If Me.AutoRedirect Then
If hr.Html.ToLower.Contains("<meta http-equiv=""refresh") Then
Uri = ParseMetaRefreshUrl(hr.Html)
Dim b As Boolean = True
For Each r As String In MetaRedirectBlacklist
If Uri.ToLower.Contains(r.ToLower) Then
b = False
Exit For
End If
Next
If b Then GoTo request
End If
End If
End If
End With
Catch ex As Exception
hr.Exception = ex
Finally
Request = Nothing
Me.Referer = String.Empty
End Try
Return hr
End Function
Public Function GetUploadResponse(ByVal Uri As String, ByVal Picture As String) As HttpResponse
Dim hr As New HttpResponse
request:
Try
If String.IsNullOrEmpty(Uri) Then
hr = New HttpResponse()
hr.Exception = New Exception("Uri was empty.")
Return hr
End If
Request = DirectCast(WebRequest.Create(Uri), HttpWebRequest)
With Request
.Method = "POST"
'Debug.Print(String.Format("[{0}] {1} >> {2}", Now.ToString("hh:mm:ss tt").ToLower, .Method, Uri))
.AllowWriteStreamBuffering = False
.AllowAutoRedirect = False
.KeepAlive = True
.UserAgent = Me.Useragent
.ContentType = GetContentType(Picture)
.AutomaticDecompression = DecompressionMethods.GZip And DecompressionMethods.Deflate
.Accept = "text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8"
.Timeout = Me.TimeOut
If Not String.IsNullOrEmpty(Me.Referer) Then .Referer = Me.Referer
If Me.SendCookies Then .Headers.Add("Cookie", GetCookies)
If Not String.IsNullOrEmpty(Me.Proxy.Server) Then
.Proxy = New WebProxy(Me.Proxy.Server, Me.Proxy.Port)
If Not String.IsNullOrEmpty(Me.Proxy.UserName) Then .Proxy.Credentials = New NetworkCredential(Me.Proxy.UserName, Me.Proxy.Password)
End If
.Headers.Add(HttpRequestHeader.AcceptEncoding, "gzip, deflate")
.Headers.Add(HttpRequestHeader.AcceptLanguage, "en-us,en;q=0.5")
.Headers.Add(HttpRequestHeader.AcceptCharset, "ISO-8859-1,utf-8;q=0.7,*;q=0.7")
.Headers.Add(HttpRequestHeader.CacheControl, "no-cache")
Dim PostData As New MemoryStream()
Dim Writer As New StreamWriter(PostData)
With Writer
Dim pInfo() As Byte = System.IO.File.ReadAllBytes(Picture)
PostData.Write(pInfo, 0, pInfo.Length)
.Flush()
End With
.ContentLength = PostData.Length
Using s As Stream = .GetRequestStream()
PostData.WriteTo(s)
End Using
PostData.Close()
Dim Response As HttpWebResponse = CType(.GetResponse(), HttpWebResponse)
If Me.StoreCookies Then ParseCookies(Response)
Writer.Close() : Writer.Dispose()
PostData.Close() : PostData.Dispose()
hr.WebResponse = Response
If Me.AutoRedirect Then
Select Case hr.WebResponse.StatusCode
Case HttpStatusCode.Found, HttpStatusCode.Redirect, HttpStatusCode.Moved, HttpStatusCode.MovedPermanently, HttpStatusCode.RedirectMethod
Uri = hr.WebResponse.Headers("Location")
Try
Dim u As New Uri(Uri)
Catch ex As Exception
End Try
Picture = String.Empty
GoTo request
End Select
End If
If Not hr.WebResponse Is Nothing Then hr.Headers = hr.WebResponse.Headers.ToString
If Not hr.WebResponse.Headers(HttpResponseHeader.ContentType) Is Nothing Then
If hr.WebResponse.Headers(HttpResponseHeader.ContentType).Contains("text/") Or _
hr.WebResponse.Headers(HttpResponseHeader.ContentType).Contains("/xml") Or _
hr.WebResponse.Headers(HttpResponseHeader.ContentType).Contains("/json") Then
GoTo getHtml
ElseIf hr.WebResponse.Headers(HttpResponseHeader.ContentType).Contains("image/") Then
If GetImage Then hr.Image = System.Drawing.Image.FromStream(Response.GetResponseStream)
Else
Debug.Print("Unknown content type: " & hr.WebResponse.Headers(HttpResponseHeader.ContentType))
End If
Else
getHtml:
If Not hr.WebResponse Is Nothing Then hr.Html = HtmlDecode(ProcessResponse(hr.WebResponse))
If Me.AutoRedirect Then
If hr.Html.ToLower.Contains("<meta http-equiv=""refresh") Then
Uri = ParseMetaRefreshUrl(hr.Html)
Dim b As Boolean = True
For Each r As String In MetaRedirectBlacklist
If Uri.ToLower.Contains(r.ToLower) Then
b = False
Exit For
End If
Next
Picture = String.Empty
If b Then GoTo request
End If
End If
End If
End With
Catch ex As Exception
hr.Exception = ex
Finally
Request = Nothing
Me.Referer = String.Empty
End Try
Return hr
End Function
Private Function ProcessResponse(ByVal Response As System.Net.HttpWebResponse) As String
Dim sb As New StringBuilder
With Response
Dim Stream As System.IO.Stream = .GetResponseStream
If (Response.ContentEncoding.ToLower().Contains("gzip")) Then
Stream = New GZipStream(Stream, CompressionMode.Decompress)
ElseIf (Response.ContentEncoding.ToLower().Contains("deflate")) Then
Stream = New DeflateStream(Stream, CompressionMode.Decompress)
End If
Dim Reader As New StreamReader(Stream)
Dim Buffer(1024) As [Char]
Dim Read As Integer = Reader.Read(Buffer, 0, 1024)
While Read > 0
Dim outputData As New [String](Buffer, 0, Read)
outputData = Replace(outputData, vbNullChar, String.Empty)
sb.Append(outputData)
Read = Reader.Read(Buffer, 0, 1024)
End While
Reader.Close() : Stream.Close()
End With
Response.Close() : Response = Nothing
Return sb.ToString
End Function
Public Function FixData(ByVal Data As String) As String
Return HtmlDecode(Data.Replace("\/\/", "//").Replace("\/", "/").Replace("\""", """").Replace("\u003e", ">").Replace("\u003c", "<").Replace("\u003a", ":").Replace("\u003b", ";").Replace("\u003f", "?").Replace("\u003d", "=").Replace("\u002f", "/").Replace("\u0026", "&").Replace("\u002b", "+").Replace("\u0025", "%").Replace("\u0027", "'").Replace("\u007b", "{").Replace("\u007d", "}").Replace("\u007c", "|").Replace("\u0022", """").Replace("\u0023", "#").Replace("\u0021", "!").Replace("\u0024", "$").Replace("\u0040", "@").Replace("\002f", "/").Replace("\r\n", vbCrLf & vbCrLf).Replace("\n", vbCrLf)).Replace("\x3a", ":").Replace("\x2f", "/").Replace("\x3f", "?").Replace("\x3d", "=").Replace("\x26", "&")
End Function
Public Sub ClearCookies()
Me.Cookies.Clear()
End Sub
Public Sub AddCookie(ByVal c As HttpCookie)
Cookies.Add(c)
End Sub
Public Sub AddCookie(ByVal c() As HttpCookie)
Cookies.AddRange(c)
End Sub
Public Sub RemoveCookie(ByVal c As HttpCookie)
Me.Cookies.Remove(c)
End Sub
Public Sub RemoveCookie(ByVal Name As String)
Dim c As HttpCookie = FindCookie(Name)
If Not c Is Nothing Then RemoveCookie(c)
End Sub
Public Function FindCookie(ByVal Name As String) As HttpCookie
Dim Result As HttpCookie = Nothing
For Each c As HttpCookie In Cookies
If c.Name = Name Then
Result = c
Exit For
End If
Next
Return Result
End Function
Public Function GetAllCookies() As List(Of HttpCookie)
Return Me.Cookies
End Function
Public Sub RemoveDuplicateCookies()
Dim c As List(Of HttpCookie) = Me.Cookies.Distinct.ToList
ClearCookies()
AddCookie(c.ToArray)
End Sub
Private Function FindCookie(ByVal c As Utility.Http.HttpCookie) As Boolean ' Search predicate
Return IIf(c.Name.ToLower.Replace(" ", "").Trim = fCookie.ToLower.Replace(" ", "").Trim, True, False)
End Function
Private Function GetCookies() As String
Dim Result As String = String.Empty
With Cookies
If .Count = 0 Then Return Result
For Each item As HttpCookie In Cookies
Result &= item.Name & "=" & item.Value & "; "
Next
If Result.EndsWith("; ") Then Result = Result.Substring(0, Result.Length - 2)
End With
Return Result
End Function
Private Sub ParseCookies(ByVal Response As HttpWebResponse)
' This just goes to show that Microsoft fucking sucks. I should NOT have had to do this.
Try
Dim Data As String = Response.Headers("Set-Cookie")
If Data = Nothing Then Exit Sub
If String.IsNullOrEmpty(Data) Then Exit Sub
Data = Data.Replace("Mon,", "Mon").Replace("Tue,", "Tue").Replace("Wed,", "Wed").Replace("Thu,", "Thu").Replace("Fri,", "Fri").Replace("Sat,", "Sat").Replace("Sun,", "Sun")
For Each c As String In Data.Split(",")
If c.Contains(";") Then c = c.Substring(0, c.IndexOf(";"))
Dim cName As String = c.Split("=")(0).Trim
Dim cValue As String = c.Substring(c.IndexOf("=") + 1).Trim
fCookie = cName : Dim Index As Integer = Cookies.FindIndex(AddressOf FindCookie)
If Not String.IsNullOrEmpty(cValue) Then
If Index = -1 Then
Cookies.Add(New HttpCookie(c.Split("=")(0), c.Substring(c.IndexOf("=") + 1)))
Else
Cookies.Item(Index).Value = cValue
End If
Else
If Not Index = -1 Then
Cookies.RemoveAt(Index)
Else
Cookies.Add(New HttpCookie(c.Split("=")(0), c.Substring(c.IndexOf("=") + 1)))
End If
End If
Next
RemoveDuplicateCookies()
Catch ex As Exception
Debug.Print(ex.ToString)
End Try
End Sub
Public Function EscapeUnicode(ByVal Data As String) As String
Return Regex.Unescape(Data)
End Function
Public Function ParseMetaRefreshUrl(ByVal Html As String) As String
If String.IsNullOrEmpty(Html) Then Return String.Empty
Dim Result As String = Html.Substring(Html.ToLower.IndexOf("<meta http-equiv=""refresh""") + "<meta http-equiv=""refresh""".Length)
Return ParseBetween(Result.ToLower, "url=", """", "url=".Length).Trim
End Function
Public Function ParseBetween(ByVal Html As String, ByVal Before As String, ByVal After As String, ByVal Offset As Integer) As String
If String.IsNullOrEmpty(Html) Then Return String.Empty
If Html.Contains(Before) Then
Dim Result As String = Html.Substring(Html.IndexOf(Before) + Offset)
If Result.Contains(After) Then
If Not String.IsNullOrEmpty(After) Then Result = Result.Substring(0, Result.IndexOf(After))
End If
Return Result
Else
Return String.Empty
End If
End Function
Public Function ParseFormIdText(ByVal Html As String, ByVal Id As String) As String
If String.IsNullOrEmpty(Html) Then Return String.Empty
Dim value As String = String.Empty
Try
Html = Html.Substring(Html.IndexOf("id=""" & Id & """") + 5)
value = ParseBetween(Html, "value=""", """", 7)
Catch
End Try
Return value
End Function
Public Function ParseFormNameText(ByVal Html As String, ByVal Name As String) As String
If String.IsNullOrEmpty(Html) Then Return String.Empty
Dim value As String = String.Empty
Try
Html = Html.Substring(Html.IndexOf("name=""" & Name & """") + 5)
value = ParseBetween(Html, "value=""", """", 7)
Catch
End Try
Return value
End Function
Public Function TimeStamp() As String
Return CInt(Now.Subtract(CDate("1.1.1970 00:00:00")).TotalSeconds).ToString
End Function
Public Function GetContentType(ByVal Path As String) As String
Dim Result As String = "application/octet-stream"
Select Case New FileInfo(Path).Extension.ToLower
Case ".atom", ".xml"
Result = "application/atom+xml"
Case ".json"
Result = "application/json"
Case ".js"
Result = "application/javascript"
Case ".ogg"
Result = "application/ogg"
Case ".pdf"
Result = "application/pdf"
Case ".ps"
Result = "application/postscript"
Case ".woff"
Result = "application/x-woff"
Case ".xhtml", ".xht", ".xml", ".html", ".htm"
Result = "application/xhtml+xml"
Case ".dtd"
Result = "application/xml-dtd"
Case ".zip"
Result = "application/zip"
Case ".gz"
Result = "application/x-gzip"
Case ".au", ".snd"
Result = "audio/basic"
Case ".rmi", ".mid"
Result = "audio/mid"
Case ".mp3"
Result = "audio/mpeg"
Case ".aiff", ".aifc", ".aif"
Result = "audio/x-aiff"
Case ".m3u"
Result = "audio/x-mpegurl"
Case ".ra"
Result = "audio/x-pn-realaudio"
Case ".ram"
Result = "audio/x-pn-realaudio"
Case ".wav"
Result = "audio/x-wav"
Case ".bmp"
Result = "image/bmp"
Case ".cod"
Result = "image/cis-cod"
Case ".gif"
Result = "image/gif"
Case ".ief"
Result = "image/ief"
Case ".jpe", ".jpeg", ".jpg"
Result = "image/jpeg"
Case ".jfif"
Result = "image/pipeg"
Case ".jpeg"
Result = "image/pjpeg"
Case ".png"
Result = "image/png"
Case ".svg"
Result = "image/svg+xml"
Case ".tif", ".tiff"
Result = "image/tiff"
Case ".ras"
Result = "image/x-cmu-raster"
Case ".cmx"
Result = "image/x-cmx"
Case ".ico"
Result = "image/x-icon"
Case ".png"
Result = "image/x-png"
Case ".pnm"
Result = "image/x-portable-anymap"
Case ".pbm"
Result = "image/x-portable-bitmap"
Case ".pgm"
Result = "image/x-portable-graymap"
Case ".ppm"
Result = "image/x-portable-pixmap"
Case ".rgb"
Result = "image/x-rgb"
Case ".xbm"
Result = "image/x-xbitmap"
Case ".xpm"
Result = "image/x-xpixmap"
Case ".xwd"
Result = "image/x-xwindowdump"
Case ".mp2"
Result = "video/mpeg"
Case ".mpa"
Result = "video/mpeg"
Case ".mpe"
Result = "video/mpeg"
Case ".mpeg"
Result = "video/mpeg"
Case ".mpg"
Result = "video/mpeg"
Case ".mpv2"
Result = "video/mpeg"
Case ".mov", ".qt"
Result = "video/quicktime"
Case ".lsf", ".lsx"
Result = "video/x-la-asf"
Case ".asf", ".asr", ".asx"
Result = "video/x-ms-asf"
Case ".avi"
Result = "video/x-msvideo"
Case ".movie"
Result = "video/x-sgi-movie"
Case Else
Result = "application/octet-stream"
End Select
Return Result
End Function
Private Function AcceptAllCertifications(ByVal sender As Object, ByVal certification As System.Security.Cryptography.X509Certificates.X509Certificate, ByVal chain As System.Security.Cryptography.X509Certificates.X509Chain, ByVal sslPolicyErrors As System.Net.Security.SslPolicyErrors) As Boolean
Return True
End Function
Public Class HttpCookie
Public Name As String = String.Empty
Public Value As String = String.Empty
Public Sub New(ByVal cName As String, ByVal cValue As String)
Name = cName
Value = cValue
End Sub
End Class
Public Class HttpResponse
Public WebResponse As HttpWebResponse = Nothing
Public Exception As Object = Nothing
Public Html As String = String.Empty
Public Headers As String = String.Empty
Public Image As Image = Nothing
End Class
End Class
End Namespace
Public Class Form1
Dim username As String = "codebot"
Dim password As String = "123456789"
Dim server As Integer = "25"
Dim logincookie As CookieContainer
Dim cookieContainer As CookieContainer = New CookieContainer()
Dim tempCookies As New CookieContainer
Private _cookieContainerToString As String
Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
_login_mff()
End Sub
Private Sub _login_mff()
'Login daten deklarieren
Dim username As String = "boehme"
Dim password As String = "4755ge"
Dim server As Integer = "18"
'HTTP CLien
With New Utility.Http
'auf die start seite conencten um sicherheitscode auszulesen
Dim Hauptpage_mff As Utility.Http.HttpResponse = .GetResponse("http://myfreefarm.de/", "")
Dim _createtoken As String = _stringbetween(Hauptpage_mff.Html, "land=DE¶ms=0,0,", ",up_mf_st&cou") 'sicherheitscode aulesen
'Login um URL zu bekommen
Dim mff_code_get As Utility.Http.HttpResponse = .GetResponse("http://myfreefarm.de/ajax/createtoken.php?n=" & _createtoken, "server=" & server & "&username=" & username & "&password=" & password & "******&retid=")
MsgBox("URL", mff_code_get.Html)
'URL auseinander
Dim _login_URL_vorgang1 As String = _stringbetween(mff_code_get.Html, "[1," & Chr(34) & "http:\/\/", Chr(34) & "]")
Dim _login_URL_vorgang2 As String = Replace(_login_URL_vorgang1, "\/", "/")
MsgBox(_login_URL_vorgang2)
'Auf die auseinander genommende URL connecten
Dim _login_entgültig As Utility.Http.HttpResponse = .GetResponse(_login_URL_vorgang2, "")
MsgBox(_login_entgültig.Html)
End With
End Sub
Public Function _stringbetween(ByRef strSource As String, ByRef strStart As String, ByRef strEnd As String, Optional ByRef startPos As Integer = 0) As String
Try
Dim iPos As Integer, iEnd As Integer, lenStart As Integer = strStart.Length
Dim strResult As String
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))
End If
Return strResult
Catch
Return False
End Try
End Function
End Class
Mfg,
xCyancali
