• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 265
  • Last Modified:

website login

Hello,
I am trying to get this app done. what im trying to do is to login to a website
and say logged in, or say couldn't login. I have upload the project so that
anyone can tell me why is not working and what is it that I have wrong..
the link is here http://rapidshare.de/files/17158869/Login_example.zip.html
thanks
0
aplelois
Asked:
aplelois
  • 3
  • 2
1 Solution
 
inthedarkCommented:
Hi you have a way to go......

But I changed the code that creates you post message and got the following response from the server:

HTTP/1.1 200 OK
Date: Tue, 04 Apr 2006 15:05:54 GMT
Server: Microsoft-IIS/6.0
X-Server: BD0700
X-AspNet-Version: 2.0.50727
Pragma: no-cache
Transfer-Encoding: chunked
Set-Cookie: MYUSERINFO=; domain=.myspace.com; expires=Tue, 04-Apr-2006 15:05:54 GMT; path=/
Set-Cookie: MYSPACE=myspace; domain=.myspace.com; expires=Wed, 04-Apr-2007 15:05:54 GMT; path=/
Set-Cookie: ME=; domain=.myspace.com; expires=Tue, 04-Apr-2006 15:05:54 GMT; path=/
Cache-Control: private
Expires: Thu, 30 Sep 1999 01:29:07 GMT
Content-Type: text/html; charset=UTF-8

Plus a whole bunch of other stuff which was incomplete because you need to be able to handle chunks.

Here is the HTTP Post code:

Public Function Login(Username As String, Password As String, Winsck As Winsock)                                                                'Create the public function (any form can use it)

Dim LOGINPACKET As String, FINALLEN As String                                                                                                       'Set some variables


Dim sDocument As String

sDocument = "/index.cfm?fuseaction=login.process&mytoken=1234"

Dim sPostContent As String

sPostContent = "fuseaction=login.process&email=" & Username & "&password=" & Password
FINALLEN = Len(sPostContent)

LOGINPACKET = "POST " + sDocument + " HTTP/1.1" & vbCrLf                                                                                                'You may need to change this if the website isnt stored in the root dir on the server. So if in the root dir there was a sub folder on the server names 'SITE', you would change this to 'LOGINPACKET = "POST SITE/news.php HTTP/1.1" & vbCrLf'
LOGINPACKET = LOGINPACKET + "Host: " & Winsck.RemoteHost & vbCrLf                                                                                   'This is the website host                                                                                                                                                               ^ this is the sub folder in the root dir.
LOGINPACKET = LOGINPACKET + "User-Agent: Mozilla/5.0 (Windows; U; Windows NT 5.1; en-GB; rv:1.7.8) Gecko/20050511 Firefox/1.0.4" & vbCrLf           'Constructing the data to be sent to the website.
LOGINPACKET = LOGINPACKET + "Accept: text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5" & vbCrLf  '^
LOGINPACKET = LOGINPACKET + "Accept-Language: en-gb,en;q=0.5" & vbCrLf                                                                              '^
'LOGINPACKET = LOGINPACKET + "Accept-Encoding: gzip , deflate" & vbCrLf                                                                             '^
LOGINPACKET = LOGINPACKET + "Accept-Charset: ISO-8859-1,utf-8;q=0.7,*;q=0.7" & vbCrLf                                                               '^
LOGINPACKET = LOGINPACKET + "Keep-Alive: 300" & vbCrLf                                                                                              '^
LOGINPACKET = LOGINPACKET + "Connection: keep-alive" & vbCrLf                                                                                      '^
LOGINPACKET = LOGINPACKET + "Referer: http://www.google.com" & vbCrLf                                                                               'Blah, used anything for a Referer.
LOGINPACKET = LOGINPACKET + "Content-Type: application/x-www-form-urlencoded" & vbCrLf                                                              'Constructing the data to be sent to the website.
LOGINPACKET = LOGINPACKET + "Content-Length: " & FINALLEN & vbCrLf & vbCrLf                                                                         'This is where we input the FINALLEN of the packet

LOGINPACKET = LOGINPACKET + sPostContent

Winsck.SendData LOGINPACKET                                                                                                                         'Send the packet to the server.

End Function

So now we need to implement chunks.




0
 
apleloisAuthor Commented:
how do you get that response from the server? I would like to see it so maybe i can know whats wrong
0
 
inthedarkCommented:
Just paste the code for the Login sub above and that is all I did. Except in the data arrival sub I added:

rivate Sub Socket_DataArrival(ByVal bytesTotal As Long)

Dim THEDATA As String                         'Create a variable called THEDATA and make the max chars 18

Socket.GetData THEDATA                          'telling winsock 'when data arrives store it in a variable called THEDATA

' need this only fro debug
Clipboard.clear
Clipboard.SetText THEDATA

MsgBox THEDATA

If THEDATA = "HTTP/1.1 302 Found" Then          ' if THEDATA is 'HTTP/1.1 302 Found' then.
    MsgBox "Correct Password!", vbInformation   ' display this msgbox saying it was correct.
Else                                            ' What ever else THEDATA is
    MsgBox "Wrong Password!", vbCritical        ' Display a msgbox saying it was incorrect, becasue if the first 18 chars aint 'HTTP/1.1 302 Found' then the password was wrong!
End If

Socket.Close                                    'Close the socket regardless if the password is correct or incorrect.
End Sub


But becuase a web server will fire chunks at you I would suggest that you change your data arrival sub but it is going to need a lot of change.  It is far better to create a function which will Fire a request at a server then wait for a response. Becuase you can re-use this whenever you need.

So in simple terms you create some code which combines you Login function, which sends to request and your data arrivale event, which  does a poor job of handle the response.

Here is an extract of a class module that I created zRemote which uses a version of sockets to do this job.  Here is a sample of just one of the many functions.  The problem with doing it you way is that once you have looed in what are you goimg tp do next, so you data arrival gets clogged with code.

Public Function SendWaitResponse(psStringData As String, _
    rsMessage As String, Optional DecodeType As DecodeTypes, _
    Optional psngTimeOut As Single = 600) As Long

' Returns the -1 for failed attempt
' or the HTTP response value eg 100 = Continue

Dim dtStarted As Date
Dim ok
Dim dtTimeOut As Date

' prepare module level variables for the sending of a request
' and the waiting for a response

zClearResponseValues

rsMessage = ""

If Len(psStringData) > 0 Then
    dtStarted = Now
    mbSendComplete = False
    ok = SendOK(psStringData)
    If Not ok Then
        SendWaitResponse = -1
        Exit Function
    End If
Else
    mbSendComplete = True
End If



'123456789
'HTTP/1.1 100 Continue
'Server: Microsoft -IIS / 5#
'Date: Fri, 14 Jan 2005 15:32:59 GMT
'X -Powered - By: ASP.NET
'P3P: CP = "IDC DSP COR ADM DEV TAI PSA IVA IVD CONo TELo OUR DEL IND UNI"


' wait until the data is sent
' allow 1 minute plus 10 minutes per MB
dtTimeOut = GF.GetNow + GF.cSeconds(120) '
Do Until GF.GetNow > dtTimeOut Or Not mbConnected
    If mbSendComplete Then
        Exit Do
    End If
    DoEvents
Loop

If Not mbSendComplete Then
    ErrN = -9
    ErrD = "Timeout sending data"
    SendWaitResponse = -1
    Exit Function
End If

' now wait for the response
dtTimeOut = GF.GetNow + GF.cSeconds(psngTimeOut)
msngLastPercent = -1

Do
    If GF.GetNow > dtTimeOut Then
        ErrN = -9
        ErrD = "Timeout while waiting for data"
        SendWaitResponse = -1
        Exit Function
    End If

    ' each time there has been a response check for
    ' data complete
   
    If mbResponse Then
        mbResponse = False
        ' extend timeout
        dtTimeOut = GF.GetNow + GF.cSeconds(psngTimeOut)

        ' decode an HTTP response
        ' expect the continue response
       
        If DecodeType = dtHTTP11WaitContinue Then
            If mlHeaderLength = 0 Then
                zGetHeaderLength
            End If
            If mlHeaderLength > 0 Then
                Dim sLine As String
                Dim sLeft As String
                Dim sRight As String

                sLine = GF.LeftPart(msResponse, vbCrLf)
                If Left(sLine, 9) = "HTTP/1.1 " Then

                    GF.Chop Mid(sLine, 10), " ", sLeft, sRight
                    SendWaitResponse = CLng(sLeft)
                    rsMessage = sRight
                    Exit Function

                End If
           
                Exit Function
            End If
        ElseIf DecodeType = dtHTTP11WaitContent Then
            If mlHeaderLength = 0 Then
                zGetHeaderLength
            End If
            If mlHeaderLength > 0 Then
                If mlContentLength > 0 _
                    And mlContentLength - (Len(msResponse) - mlHeaderLength) <= 0 Then
                   
                    sLine = GF.LeftPart(msResponse, vbCrLf)

                    ' response is here
                    If Left(sLine, 9) = "HTTP/1.1 " Then

                        GF.Chop Mid(sLine, 10), " ", sLeft, sRight
                        SendWaitResponse = CLng(sLeft)
                        rsMessage = sRight
                        RaiseEvent ProgressComplete(mlContentLength)
                        Exit Function

                    End If
                   
                ElseIf mlContentLength = 0 Then
               
                    ' Suspect that if the content length is zero the response will not be chunked.
                   
                    ' look at the first line of the response
                    sLine = GF.LeftPart(msResponse, vbCrLf)

                    ' response is here
                    If Left(sLine, 9) = "HTTP/1.1 " Then

                        GF.Chop Mid(sLine, 10), " ", sLeft, sRight
                        SendWaitResponse = CLng(sLeft)
                        rsMessage = sRight
                        RaiseEvent ProgressComplete(mlContentLength)
                       
                        Exit Function

                    End If
                   
                Else
                    Dim sngPercent As Single
                    If mlContentLength > 0 Then
                   
                        sngPercent = GF.Divide((CSng(100) * CSng(Len(msResponse))), CSng(mlContentLength), 0)
                        If sngPercent > msngLastPercent Then
                            msngLastPercent = sngPercent
                            RaiseEvent Progress(sngPercent, CLng(Len(msResponse)), mlContentLength)
                        End If
                    End If
                End If
            End If

        End If
    End If
   
   
    DoEvents
   
Loop
RaiseEvent ProgressComplete(mlContentLength)
End Function








0
 
apleloisAuthor Commented:
thanks a lot for helping me!!!
0
 
apleloisAuthor Commented:
well the reason why I want to do this is because I want to make an app that can request friends for me.
random friends or friends by zip code, age, state etc.. well I have uploaded the source
http://rapidshare.de/files/17312244/req_source.zip.html
as you can see I haven't done anything but If you want to start helping me making it Ill be very grateful.
the only reason why I want to do this is because I want to learn more about VB and because
I am tired of this program www.eekrecords.com/?page_id=13 that doesnt work
0

Featured Post

Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

  • 3
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now