Delphi Indy Control for network verification and ASP Communication

Interface

Uses
Windows, messages, sysutils, variants, classes, graphics, controls, forms,
Dialogs, olectrls, shdocvw, stdctrls, comctrls, idbasecomponent,
Idcomponent, idtcpconnection, idtcpclient, idhttp;

Type
Tform1 = Class (tform)
Edit1: tedit;
Button1: tbutton;
Label1: tlabel;
State: tstatusbar;
Idhttp1: tidhttp;
Memo1: tmemo;
Label2: tlabel;
Edit2: tedit;
Button2: tbutton;
Label3: tlabel;
Memo2: tmemo;
Procedure button1click (Sender: tobject );
Procedure button2click (Sender: tobject );
Private
{Private Declarations}
Public
{Public declarations}
End;

VaR
Form1: tform1;

Implementation

{$ R *. DFM}

Procedure tform1.button1click (Sender: tobject );
VaR
Name: string;
Password: string;

Geturl: string;
Posturl: string;
Gethtml: string;
Sparams: string;
Aparams: tstrings;
Astream: tstringstream;
Begin

Idhttp1: = tidhttp. Create (NiL );
Aparams: = tstringlist. Create;
Astream: = tstringstream. Create ('');
Memo1.lines. Clear;
Name: = edit1.text;
Password: = edit2.text;
Geturl: = 'HTTP: // localhost/getinfo. asp '; {logon page url}
Posturl: = 'HTTP: // localhost/getinfo. asp? Password = '+ password; {submit URL}
Sparams: = 'name = '+ name; {submit parameter}
Try
Aparams. Clear;
Aparams. Add (sparams );
Gethtml: = idhttp1.get (geturl); {retrieve logon page}
Idhttp1.request. contenttype: = 'application/X-WWW-form-urlencoded ';
Idhttp1.post (posturl, aparams, astream); {submit}
Memo1.lines. Add (astream. datastring );
Memo1.selectall;
Finally
Idhttp1.free;
Aparams. Free;
Astream. Free;
End;

End;

Procedure tform1.button2click (Sender: tobject );
Begin
Close ();
End;

End.

----------------------------------------------------- Getinfo. asp ----------------------------------------

<% @ Language = VBScript. encode %>
<! -- # Include file = "conn. asp" -->
<%
Dim RS, SQL, username, regcode, active, password, founderr, MSG
Username = trim (Request ("name "))
Password = trim (Request ("password "))
If username = "" then
Founderr = true
MSG = "invalid username parameter! "
Else
Founderr = false
End if
If Password = "" then
Founderr = true
MSG = "the password parameter is invalid! "
Else
Founderr = false
End if

If founderr = true then
Response. Write msg
Else
Set rs = server. Createobject ("ADODB. recordset ")
SQL = "select * From reguser where username = '" & username & "' and Password = '" & password &"'"
Rs. Open SQL, Conn, 1, 1
If Rs. recordcount> 0 then
If trim (RS ("regcode") <> "then
Response. Write RS ("regcode ")
Else
The user registration code returned by response. Write is invalid! "
End if
Else
Response. write "the user name entered does not exist or the password is invalid! "
End if
Rs. Close
Set rs = nothing
End if

Call closeconn ()
%>