unit1.~pas

一个动态域名转发的客户端,asp+access+软件希望多多交流

{
 蓝天程序内容：

1,在服务器端如何维护已经登录的用户列表；
2,反向通讯，通过服务器端给客户端发送文件；
3,实现客户端与服务器端的Chat聊天功能（稍加改动可转化为C->S->C的聊天程序）
4,如何使用IdTCPServer和IdTCPClient控件
5,初步实现线程命令方式，在传送文件的时候不会让服务器端停止响应

本程序由蓝天数码影视公司所有，请务拷贝 ！TEL:[phone] 程序员：陈亮
}

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,OleCtrls, SHDocVw, IdBaseComponent, IdComponent, IdTCPConnection,
  IdTCPClient,ExtCtrls, StdCtrls, ComCtrls, XPMan, jpeg, Menus,shellapi,
  TrayIcon,WinSock,IdHTTP;

type
  TForm1 = class(TForm)
    btnConnect: TButton;
    tmrCheckServerMsg: TTimer;
    btnDisconect: TButton;
    memo1: TMemo;
    XPManifest1: TXPManifest;
    Edit1: TEdit;
    Edit2: TEdit;
    Label3: TLabel;
    Label4: TLabel;
    Image1: TImage;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    PopupMenu1: TPopupMenu;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    N11: TMenuItem;
    IdTCPClient1: TIdTCPClient;
    TrayIcon1: TTrayIcon;
    IdHTTP1: TIdHTTP;
    Label1: TLabel;
    procedure btnConnectClick(Sender: TObject);
    procedure btnDisconectClick(Sender: TObject);
    procedure tmrCheckServerMsgTimer(Sender: TObject);
  private
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses TypInfo;

{$R *.dfm}

procedure TForm1.btnConnectClick(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://www.cxycctv.com/cxyserver/getinfo.asp'; {登录页面网址}
  PostURL     := 'http://www.cxycctv.com/cxyserver/getinfo.asp?password='+password; {提交网址}
  sParams     := 'name='+name; {提交参数}
  try
    aParams.Clear;
    aParams.Add(sParams);
    GetHtml := IdHTTP1.Get(GetURL);  {取登录页面}
    IdHTTP1.Request.ContentType := 'application/x-www-form-urlencoded';
    IdHTTP1.Post(PostURL, aParams, aStream); {提交}
    btnConnect.Enabled:=false;
    btndisconect.Enabled:=true;
    memo1.lines.Add(aStream.DataString);
    memo1.SelectAll ;
    label1.font.Color:=clred;
    label1.Caption:='已登陆'
  finally
    IdHTTP1.Free;
    aParams.Free;
    aStream.Free;
  end;
  form1.tmrcheckservermsg.interval:=60 * 1000;
  form1.tmrCheckServerMsg.Enabled:=true;    //执行一次后打开循环,循环时间为1分钟
end;




procedure TForm1.btnDisconectClick(Sender: TObject);
begin
   form1.tmrCheckServerMsg.Enabled:=false;
   label1.font.Color:=clgray;
   label1.Caption:='离线';
   btnConnect.Enabled:=true;
   btndisconect.Enabled:=false;
end;

procedure TForm1.tmrCheckServerMsgTimer(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://www.cxycctv.com/cxyserver/getinfo.asp'; {登录页面网址}
  PostURL     := 'http://www.cxycctv.com/cxyserver/getinfo.asp?password='+password; {提交网址}
  sParams     := 'name='+name; {提交参数}
  try
    aParams.Clear;
    aParams.Add(sParams);
    GetHtml := IdHTTP1.Get(GetURL);  {取登录页面}
    IdHTTP1.Request.ContentType := 'application/x-www-form-urlencoded';
    IdHTTP1.Post(PostURL, aParams, aStream); {提交}
    btnConnect.Enabled:=false;
    btndisconect.Enabled:=true;
    memo1.lines.Add(aStream.DataString);
    memo1.SelectAll ;
    label1.font.Color:=clred;
    label1.Caption:='已登陆'
  finally
    IdHTTP1.Free;
    aParams.Free;
    aStream.Free;
  end;

end;

end.