unit1.pas

本目录内所有代码仅作指导用户编程之用,用户如果要作为 商业用途,建议使用正版软件进行编译. 开发环境说明： delphi demo : delphi 6.0 vc de

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ToolWin, ComCtrls, ImgList, StdCtrls, ExtCtrls, Buttons, Unit_dll, Menus;
    
const RECVMESS=WM_USER+$08;

type
  TForm1 = class(TForm)
    ToolBar1: TToolBar;
    tbStartService: TToolButton;
    tbStopService: TToolButton;
    tbOffLine: TToolButton;
    ImageList1: TImageList;
    ImageList2: TImageList;
    tbSendData: TToolButton;
    tbClear: TToolButton;
    ToolButton6: TToolButton;
    tbQuit: TToolButton;
    Panel1: TPanel;
    lvUserTable: TListView;
    mmDataWnd: TMemo;
    Splitter1: TSplitter;
    Panel2: TPanel;
    ToolButton8: TToolButton;
    Edit1: TEdit;
    Edit2: TEdit;
    sbSendData: TSpeedButton;
    PopupMenu1: TPopupMenu;
    miOffLineAll: TMenuItem;
    Panel3: TPanel;
    ckAnswer: TCheckBox;
    procedure tbQuitClick(Sender: TObject);
    procedure tbStartServiceClick(Sender: TObject);
    procedure tbStopServiceClick(Sender: TObject);
    procedure tbSendDataClick(Sender: TObject);
    procedure tbClearClick(Sender: TObject);
    procedure tbOffLineClick(Sender: TObject);
    procedure lvUserTableClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormResize(Sender: TObject);
    procedure miOffLineAllClick(Sender: TObject);
  private
    procedure ProcessMessage(var Msg:TMessage);message RECVMESS;
    { Private declarations }
  public
    block: integer;   //选择读取数据的方式：2消息触发，1非阻塞方式，0阻塞方式
    procedure AddText(p:PChar);
    procedure PollUserTable;
    procedure ProcessData(dr:data_record);
    procedure AddListItem(ui:gprs_user_info);
    function  IntToIp(ip:Cardinal):String;
    function  _DateTimeToUnix(const aValue:TDateTime):Int64;
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses hsx_dialogs, unit2, unit3;
   
{$R *.DFM}

procedure TForm1.ProcessMessage(var Msg:TMessage);
var dr:data_record;
    p:PChar;
    bAnswer:Boolean;
begin
    GetMem(p,512);

    if ckAnswer.Checked then
        bAnswer:=true
    else
        bAnswer:=false;

    if (do_read_proc(dr,p,bAnswer)>=0) then
      begin
        if dr.m_data_len=0 then
            PollUserTable
        else
            ProcessData(dr);
      end;
    FreeMem(p,512);
end;

procedure TForm1.tbQuitClick(Sender: TObject);
begin
    Close;
end;

procedure TForm1.tbStartServiceClick(Sender: TObject);
var p:PChar;
begin
    block := 0; //可以通过这个来选择读取数据的方式
    if block = 0 then begin
      //阻塞方式
      SetWorkMode(0);

      GetMem(p,512);
      //start_gprs_server(Form1.Handle,RECVMESS,5002,p);
      start_net_service(Form1.Handle,RECVMESS,5002,p);
      AddText(p);
      FreeMem(p,512);

      brth := TBlockReadth.Create(false);
    end
    else if block = 1 then begin
      //非阻塞方式
      SetWorkMode(1);

      GetMem(p,512);
      //start_gprs_server(Form1.Handle,RECVMESS,5002,p);
      start_net_service(Form1.Handle,RECVMESS,5002,p);
      AddText(p);
      FreeMem(p,512);

      nbrth := TNoblockReadth.Create(false);
    end
    else begin
      //消息方式
      GetMem(p,512);
      //start_gprs_server(Form1.Handle,RECVMESS,5002,p);
      start_net_service(Form1.Handle,RECVMESS,5002,p);
      AddText(p);
      FreeMem(p,512);
    end;

    tbStartService.Enabled:=false;
    tbStopService.Enabled:=true;
    tbOffLine.Enabled:=true;
    tbSendData.Enabled:=true;
    sbSendData.Enabled:=true;
end;

procedure TForm1.tbStopServiceClick(Sender: TObject);
var p:PChar;
begin
    if block = 0 then begin
      brth.Terminate;  //设置线程结束标志
      cancel_read_block();  //取消阻塞，让线程顺利结束
    end
    else if block = 1 then
      nbrth.Terminate;   //非阻塞方式下，设置了线程结束标志就可以了，其线程会很快结束
    GetMem(p,512);
    do_close_all_user(p);
    //stop_gprs_server(p);
    stop_net_service(p);
    AddText(p);
    FreeMem(p,512);
    tbStartService.Enabled:=true;
    tbStopService.Enabled:=false;
    tbOffLine.Enabled:=false;
    tbSendData.Enabled:=false;
    sbSendData.Enabled:=false;
end;

procedure TForm1.tbSendDataClick(Sender: TObject);
begin
    do_send_user_data(PChar(Edit1.Text),PChar(Edit2.Text),Length(Edit2.Text),nil);
end;

procedure TForm1.AddText(p:PChar);
begin
    if mmDataWnd.Lines.Count>100 then
        mmDataWnd.Lines.Clear;

    mmDataWnd.Lines.Add(p);
end;

procedure TForm1.tbClearClick(Sender: TObject);
begin
    mmDataWnd.Lines.Clear;
end;

procedure TForm1.PollUserTable;
var ui:gprs_user_info;
    i:Integer;
    iDtuAmount:Integer;
    t_update:Cardinal;
    p:PChar;
begin
    lvUserTable.Items.Clear;

    GetMem(p,512);
    iDtuAmount:=get_max_user_amount;
    for i:=0 to iDtuAmount-1 do
      begin
        get_user_at(i,ui);
        if ui.m_status=1 then
          begin
            t_update:=(Cardinal(ui.m_update_time[1]))
                      +(Cardinal(ui.m_update_time[2]))*256
                      +(Cardinal(ui.m_update_time[3]))*256*256
                      +(Cardinal(ui.m_update_time[4]))*256*256*256
                      +3600*8;

           if (Form1._DateTimeToUnix(Now)-t_update>=120) then
             begin
               do_close_one_user(@ui.m_userid[1],p);
               continue;
             end;

           AddListItem(ui);
          end;
      end;
    FreeMem(p,512);
end;

procedure TForm1.ProcessData(dr:data_record);
var i:Integer;
    str:String;
begin
    str:=dr.m_userid+'---'+dr.m_recv_date+'---'+IntToStr(dr.m_data_len);
    for i:=1 to Length(str) do
      if str[i]=#0 then
        str[i]:=' ';
    mmDataWnd.Lines.Add(str);
    mmDataWnd.Lines.Add(dr.m_data_buf);
end;

procedure TForm1.AddListItem(ui:gprs_user_info);
var list:TListItem;
begin
    list:=lvUserTable.Items.Add;
    list.Caption:=ui.m_userid;
    list.SubItems.Add(ui.m_logon_date);
    list.SubItems.Add(IntToIp(ui.m_local_addr));
    list.SubItems.Add(IntToStr(ui.m_local_port));
    list.SubItems.Add(IntToIp(ui.m_sin_addr));
    list.SubItems.Add(IntToStr(ui.m_sin_port));
end;

function TForm1.IntToIp(ip:Cardinal):String;
var s:String;
begin
    s:='';
    s:=s+IntToStr(ip div (256*256*256));
    s:=s+'.';
    s:=s+IntToStr((ip div (256*256)) mod 256);
    s:=s+'.';
    s:=s+IntToStr((ip div 256) mod 256);
    s:=s+'.';
    s:=s+IntToStr(ip mod 256);
    IntToIp:=s;
end;

function TForm1._DateTimeToUnix(const AValue:TDateTime):Int64;
begin
  Result := Round((AValue - 25569) * 3600*24);
end;

procedure TForm1.tbOffLineClick(Sender: TObject);
begin
    if Length(Edit1.Text)=11 then
      do_close_one_user(PChar(Edit1.Text),nil);
end;

procedure TForm1.lvUserTableClick(Sender: TObject);
begin
    if lvUserTable.Selected<>nil then
      begin
        Edit1.Text:=lvUserTable.Selected.Caption;
      end;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
    if MessageDlg('确定要退出吗？',mtConfirmation,[mbYes,mbNo],0)=mrNo then
      CanClose:=false;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
    sbSendData.Left:=Form1.Width-79;
    Edit2.Width:=Form1.Width-182; 
end;

procedure TForm1.miOffLineAllClick(Sender: TObject);
begin
    do_close_all_user(nil);
    lvUserTable.Items.Clear;
end;

end.