fm_main.pas

< Delphi网络通信协议分析与应用实现>>一书的源代码。

unit fm_main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  OleCtrls, SPComm, ExtCtrls, Menus, StdCtrls,my_fun;
type mTmycommStat=record
    server:boolean;

end;
type
  Tfm_main1 = class(TForm)
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    Memo1: TMemo;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    Button1: TButton;
    Memo2: TMemo;
    Comm1: TComm;
    Edit2: TEdit;
    Label3: TLabel;
    Button2: TButton;
    Button3: TButton;
    Label2: TLabel;
    CobBox1: TComboBox;
    procedure N5Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure Memo2KeyPress(Sender: TObject; var Key: Char);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
      BufferLength: Word);
    procedure Button2Click(Sender: TObject);
    procedure Comm1ModemStateChange(Sender: TObject; ModemEvent: Cardinal);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
    function InitMyComm():boolean;
    function MyCommListen():boolean;
    function MyDial(dialstr:string):boolean;
    procedure HandserverData(strData:string);
    procedure HandClientData(strData:string);
    function MySendData(dataStr:string):boolean;
    procedure CloseMycomm();
  public
    { Public declarations }
  end;

var
  fm_main1: Tfm_main1;

implementation

{$R *.DFM}
var
mycommstat1:mTmycommStat;
//初始化
function Tfm_main1.InitMyComm():boolean;
begin
    if length(cobBox1.text)<>4 then
    begin
        showmessage('请选择串口');
        exit;
    end;
    try
        comm1.CommName:=cobBox1.text;
        comm1.BaudRate:=9600;
        comm1.Outx_XonXoffFlow:=false;
        comm1.Inx_XonXoffFlow:=false;

        comm1.StartComm();
    except
        //showmessage(E
        comm1.StopComm;
        InitMycomm:=false;
        exit;
    end;
    initMycomm:=true;
end;

procedure Tfm_main1.CloseMycomm();
begin
    if boolean(comm1.Handle) then
    begin
        comm1.StopComm;
    end;
end;
//自动侦听并应答
function Tfm_main1.MyCommListen():boolean;
var
wDataLen:Word;
sData:string;
begin
    try
        sData:='AT S0=1 E1 Q1 M1 ' + Chr(13);
        wDataLen:=length(sData);
        comm1.WriteCommData(pchar(sData),wDataLen);
        //'S0=n (n>=1)自动应答. n为响铃次数
        //'E0/E1 关闭/打开命令字符回应
        //'Q0/Q1 modem返回/不返回结果码
        //'M0/M1 关闭/打开MODEM扬声器.
    except
        MyCommListen:=false;
        exit;
    end;
    mycommstat1.server:=true;
    MyCommListen:=true;
end;
procedure Tfm_main1.N5Click(Sender: TObject);
begin
    if true then
    begin
       if not MyCommListen() then
       begin
            memo1.Lines.add('开始侦听失败！');
       end;
    end
    else
    begin
        memo1.lines.add('串口初始化失败！');
    end;

end;
function Tfm_main1.MyDial(dialstr:string):boolean;
var
wDataLen:Word;
sData:string;
begin
    if not boolean(comm1.Handle) then
    begin
        if not InitMycomm() then
        begin
            showmessage('串口打开失败！');
            mydial:=false;
            exit;
        end;
    end;

    sData:='ATDT'+dialstr+chr(13);
    wDataLen:=length(sData);
    comm1.WriteCommData(pchar(sData),wDataLen);
    mycommstat1.server:=false;
    mydial:=true;
end;
procedure Tfm_main1.HandserverData(strData:string);
//处理Server数据
var
DataStr:String;
begin
    DataStr:=strData;
    if length(datastr)>0 then
    begin
        memo1.Lines[memo1.lines.count-1]:=memo1.Lines[memo1.lines.count-1]+datastr;
    end;

end;
procedure Tfm_main1.HandClientData(strData:string);
var
DataStr:string;
begin
    DataStr:=strData;
    if length(datastr)>0 then
    begin
         memo1.Lines[memo1.lines.count-1]:=memo1.Lines[memo1.lines.count-1]+datastr;
    end;
end;

function Tfm_main1.MySendData(dataStr:string):boolean;
var
wDataLen:Word;
sData:string;
begin
    try
        if boolean(comm1.handle) then
        begin
            sData:=datastr;
            wDataLen:=length(sData);
            comm1.WriteCommData(pchar(sData),wDataLen);
        end;
    except
        mysenddata:=false;
        exit;
    end;
    mysenddata:=true;
end;

procedure Tfm_main1.Button1Click(Sender: TObject);
var
i:integer;
begin
    mysenddata(memo2.Lines.Text);
end;

procedure Tfm_main1.N6Click(Sender: TObject);
begin
    mydial(edit2.text);
end;

procedure Tfm_main1.Memo2KeyPress(Sender: TObject; var Key: Char);
begin
    mysenddata(key);
end;

procedure Tfm_main1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
    CloseMycomm();
end;

procedure Tfm_main1.Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
  BufferLength: Word);
var
strData:string;
begin
   SetLength(strData, BufferLength); //接收RS232的数据并显示Memo1上。
   Move(Buffer^, PChar(strData)^, BufferLength);
   if mycommstat1.server then
   begin
       HandserverData(strData);
   end
   else
   begin
       HandClientData(strData);
   end;
end;

procedure Tfm_main1.Button2Click(Sender: TObject);
begin
    InitMyComm();
end;

procedure Tfm_main1.Comm1ModemStateChange(Sender: TObject;
  ModemEvent: Cardinal);
begin
    case  modemevent of
    ME_CTS: memo2.Lines.add('cts');
    ME_DSR: memo2.Lines.add('dsr');
    ME_RING: memo2.Lines.add('ring');
    ME_RLSD: memo2.Lines.add('RLSD');
    end;
end;

procedure Tfm_main1.Button3Click(Sender: TObject);
begin
     mysenddata(gcmdhead+gCmdGetSpxx+gcmdtail);
end;

end.