Deadman666
Grünschnabel
Guten Abend ich versuche zurzeit mich über die Funktion .Execute (POST-Methode) automatisch auf einer Internetseite einzuloggen. Die Seite hat jedoch noch einen kleinen "Schutz" eingebaut, dass sind die versteckten Felder "encryption_1" bis "encryption_11". Ohne diese Felder funktioniert das LogIn ohne Probleme (früher waren diese versteckten Felder nicht vorhanden), doch seither bekomm ichs nicht hin, dass es mich automatisch einloggt. Hab die Header auch schon mit dem LiveHTTPHeaders Plugin für Firefox überprüft und konnte keine Abweichungen erkennen, die das Login irgentwie verhindern könnten. Einzig und alleine konnte ich feststellen (mit Hilfe der Wiederholungs Funktion von LiveHTTPHeaders), dass wenn ich die gleichen Daten von Hand an den Server sende, er mir einen Error 413 zurückgibt:
Weiss jemand wo das Problem liegt? Ich kann den POST-Inhalt ja schlecht kürzen, da die versteckten Felder benötigt werden. Schonmal vielen Dank für jegliche Hilfe.
Login Username: Test
Login Passwort: 1q2w3e4
Übergebene Daten zu groß!
Die bei der Anfrage übermittelten Daten sind für die POST-Methode nicht erlaubt oder die Datenmenge hat das Maximum überschritten.
Sofern Sie dies für eine Fehlfunktion des Servers halten, informieren Sie bitte den Webmaster hierüber.
Error 413
hablogmotel.no-ip.org
09/06/08 00:59:36
Apache/2.2.9 (Win32) DAV/2 mod_ssl/2.2.9 OpenSSL/0.9.8h mod_autoindex_color PHP/5.2.6
Weiss jemand wo das Problem liegt? Ich kann den POST-Inhalt ja schlecht kürzen, da die versteckten Felder benötigt werden. Schonmal vielen Dank für jegliche Hilfe.
Login Username: Test
Login Passwort: 1q2w3e4
Code:
Private Sub Command1_Click()
'Set Username & Password
Dim Username As String
Dim Password As String
Username = "Test"
Password = "1q2w3e4"
'Gets the Html source
Dim Source As String
Source = GetUrlSource("http://hablogmotel.no-ip.org")
'Gets the Submitpage
Dim Submitpage
Submitpage = Split(Source, "id=" & Chr(34) & "login-habblet" & Chr(34) & ">")(1)
Submitpage = Split(Submitpage, "<form action=" & Chr(34))(1)
Submitpage = Split(Submitpage, Chr(34))(0)
' Username & Password Field
Dim UsernameField As String
UsernameField = Split(Split(Source, "login-field" & Chr(34) & " name=" & Chr(34))(1), Chr(34) & " id=" & Chr(34) & "login-username")(0)
Dim PasswordField As String
PasswordField = Split(Split(Source, "login-field" & Chr(34) & " name=" & Chr(34))(2), Chr(34) & " id=" & Chr(34) & "login-password")(0)
' Hidden Fields
Dim HiddenFieldsSource As String
Dim HiddenFieldSource As String
Dim HiddenFields As String
Dim HiddenField As String
Dim HiddenFieldsQuest As String
HiddenFieldsSource = Split(Split(Source, "id=" & Chr(34) & "login-habblet")(1), "</form>")(0)
Dim i_hiddenfields As Long
For i_hiddenfields = 1 To StrCount(HiddenFieldsSource, "<input type=" & Chr(34) & "hidden" & Chr(34))
HiddenFieldsQuest = MsgBox("Found hidden Field: " & Split(Split(HiddenFieldsSource, "<input type=" & Chr(34) & "hidden" & Chr(34) & " name=" & Chr(34))(i_hiddenfields), Chr(34))(0) & vbNewLine & vbNewLine & "Is this hidden Field needed for the login process?", vbYesNo, "Hidden Field found")
If HiddenFieldsQuest = vbYes Then
HiddenFieldSource = Split(Split(HiddenFieldsSource, "<input type=" & Chr(34) & "hidden" & Chr(34))(i_hiddenfields), ">")(0)
HiddenFields = HiddenFields & "&" & Split(Split(HiddenFieldSource, "name=" & Chr(34))(1), Chr(34))(0) & "=" & Split(Split(HiddenFieldSource, "value=" & Chr(34))(1), Chr(34))(0)
End If
Next i_hiddenfields
' Log In
Dim LoginData As String
LoginData = UsernameField & "=" & Username & "&" & PasswordField & "=" & Password & HiddenFields
Dim Headers As String
Headers = "Host: hablogmotel.no-ip.org" & vbCrLf & _
"User-Agent: Mozilla/5.0 (Windows; U; Windows NT 6.0; de; rv:1.8.1.16) Gecko/20080702 Firefox/2.0.0.16" & vbCrLf & _
"Accept: text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5" & vbCrLf & _
"Accept-Language: de-de,de;q=0.8,en-us;q=0.5,en;q=0.3" & vbCrLf & _
"Accept-Encoding: gzip,deflate" & vbCrLf & _
"Accept-Charset: ISO-8859-1,utf-8;q=0.7,*;q=0.7" & vbCrLf & _
"Keep-Alive: 300" & vbCrLf & _
"Connection: keep-alive" & vbCrLf & _
"Referer: http://hablogmotel.no-ip.org/index.php" & vbCrLf & _
"Content-Type: application/x-www-form-urlencoded" & vbCrLf & _
"Content-Length: 538" & vbCrLf
Inet1.Execute "http://hablogmotel.no-ip.org/index.php" & Submitpage, "POST", LoginData, Headers
Do
DoEvents
Loop Until Inet1.StillExecuting = False
' Check if logged in
Dim LoaderSource
LoaderSource = GetUrlSource("http://hablogmotel.no-ip.org")
If InStr(LoaderSource, "login-submit") Or InStr(LoaderSource, "centered-client-error") Then
MsgBox "Login failed. Check your Username and Password."
Exit Sub
End If
End Sub
Code:
Option Explicit
Public Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Public Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" (ByVal hInternetSession As Long, ByVal sURL As String, ByVal sHeaders As String, ByVal lHeadersLength As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Public Declare Function InternetReadFile Lib "wininet.dll" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
Public Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer
Public Const IF_FROM_CACHE = &H1000000
Public Const IF_MAKE_PERSISTENT = &H2000000
Public Const IF_NO_CACHE_WRITE = &H4000000
Private Const BUFFER_LEN = 256
Public Function GetUrlSource(sURL As String) As String
Dim sBuffer As String * BUFFER_LEN, iResult As Integer, sData As String
Dim hInternet As Long, hSession As Long, lReturn As Long
'get the handle of the current internet connection
hSession = InternetOpen("vb wininet", 1, vbNullString, vbNullString, 0)
'get the handle of the url
If hSession Then hInternet = InternetOpenUrl(hSession, sURL, vbNullString, 0, IF_NO_CACHE_WRITE, 0)
'if we have the handle, then start reading the web page
If hInternet Then
'get the first chunk & buffer it.
iResult = InternetReadFile(hInternet, sBuffer, BUFFER_LEN, lReturn)
sData = sBuffer
'if there's more data then keep reading it into the buffer
Do While lReturn <> 0
iResult = InternetReadFile(hInternet, sBuffer, BUFFER_LEN, lReturn)
sData = sData + Mid(sBuffer, 1, lReturn)
Loop
End If
'close the URL
iResult = InternetCloseHandle(hInternet)
GetUrlSource = sData
End Function
Zuletzt bearbeitet: