fm_mainsev.pas

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

unit fm_mainsev;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  OleCtrls, SPComm, ExtCtrls, Menus, StdCtrls,my_fun, Buttons, ComCtrls,
  Db, DBTables;

type
  Tfm_mainsev1 = class(TForm)
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    Comm1: TComm;
    BtnInit: TButton;
    BBtnStart: TBitBtn;
    StatBar1: TStatusBar;
    ProgBar1: TProgressBar;
    Panel1: TPanel;
    Image1: TImage;
    Image2: TImage;
    LblTishi: TLabel;
    GroupBox3: TGroupBox;
    StatBar2: TStatusBar;
    Timer1: TTimer;
    Label1: TLabel;
    lblfdid: TLabel;
    Label4: TLabel;
    lblfdname: TLabel;
    BBtnSetup: TBitBtn;
    LBox2: TListBox;
    Table1: TTable;
    Edit1: TEdit;
    Query1: TQuery;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
      BufferLength: Word);
    procedure BtnInitClick(Sender: TObject);
    procedure Comm1ModemStateChange(Sender: TObject; ModemEvent: Cardinal);
    procedure BBtnStartClick(Sender: TObject);
    procedure Comm1SendDataEmpty(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure Timer1Timer(Sender: TObject);
    procedure BBtnSetupClick(Sender: TObject);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
  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:ansistring):boolean;
    function MySendCmd(cmdStr:string;cmdVal:string):boolean;
    procedure CloseMycomm();
    procedure AddTishi(TishiStr:string);
    function MysendFile(filename:string;startpos:integer):integer;
    function myGetfilelist(strfile:string):string;
    function AddFileRz(fname:string):boolean;
  public
    { Public declarations }
  end;

var
  fm_mainsev1: Tfm_mainsev1;

implementation

uses pfm_serverset;

{$R *.DFM}
var
mycommstat1:mTmycommStat;
ServerRevData:ansistring;
OutBuffEmpty1:boolean;//发送缓冲区是否为空
IsOnline:boolean;//网络是否接通
sendstr:ansistring;//发送的字符串
//初始化
function Tfm_mainsev1.InitMyComm():boolean;
begin
    if length(myserverset.mCommName)<>4 then
    begin
        showmessage('请选择串口');
        exit;
    end;
    try
        comm1.CommName:=myserverset.mCommName;
        comm1.BaudRate:=9600;
        comm1.Outx_XonXoffFlow:=false;
        comm1.Inx_XonXoffFlow:=false;
        comm1.StartComm();
    except
        comm1.StopComm;
        InitMycomm:=false;
        exit;
    end;
    outbuffempty1:=true;
    addtishi('初始化串口成功');
    initMycomm:=true;
end;

procedure Tfm_mainsev1.CloseMycomm();
begin
    if boolean(comm1.Handle) then
    begin
        comm1.StopComm;
    end;
end;

//自动侦听并应答
function Tfm_mainsev1.MyCommListen():boolean;
var
wDataLen:Word;
sData:string;
begin
    try
        sData:='AT S0=1 E1 Q1' + 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;

function Tfm_mainsev1.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_mainsev1.HandserverData(strData:string);
//处理Server数据
var
i:integer;
DataStr,tmpstr,tmpstr2:String;
cmdStr,Valstr:string;
posCmdHead,posCmdTail:integer;
igetfrom:integer;
tmpint:integer;
fhandle:integer;
begin
    DataStr:=strData;
    ServerRevData:=strData;
    //addtishi(strdata);
    posCmdHead:=pos(gcmdhead,ServerRevData);
    posCmdTail:=pos(gcmdtail,ServerRevData);
    if (posCmdHead>0) and (posCmdTail>poscmdhead) then
    begin

        tmpstr:=copy(serverRevData,posCmdhead+length(gCmdhead),
            posCmdTail-posCmdhead-length(gcmdhead));
        analyzeCmd(tmpstr,cmdstr,valstr);
        if cmdstr='FDID' then
        begin//分店的通讯标识
            addtishi('分店的通讯标识为：'+valstr);
            lblfdid.caption:=valstr;
            //请求发送分店的名字
            mysendcmd('GETNAME',myServerset.mServerName);

        end
        else if cmdstr='FDNAME' then
        begin
            addtishi('分店的名称为：'+valstr);
            lblfdname.caption:=valstr;
        end
        else if cmdstr='GETFILELIST' then
        begin//获得请求的文件列表
            tmpstr2:=myGetfilelist(valstr);
            mysendcmd('FILELIST',tmpstr2);
        end
        else if cmdstr='GETFILE' then
        begin
            //接到请求的文件名
            addtishi('客户端请求文件'+valstr);
            mysendfile1.mfilename:=valstr;
            mysendfile1.mfileallsize:=GetFileLen('sendfile\'+valstr);

            if mysendfile1.mfileallsize<>0 then
            begin
                mySendcmd('FILELEN',inttostr(mysendfile1.mfileallsize));
            end
            else
            begin
                mysendcmd('ERROR','文件不存在');
            end;
        end
        else if cmdstr='GETFROM' then
        begin
            iGetfrom:=0;
            try
                igetfrom:=strtoint(valstr);
                mysendfile1.mSending:=true;
                if not fileexists('sendfile\'+mysendfile1.mfilename) then
                begin
                    mysendcmd('ERROR','不存在请求的文件');
                    exit;
                end;
                
                mysendcmd('FILEOK',inttostr(MysendFile('sendfile\'+mysendfile1.mfilename,iGetFrom)));
                mysenddata(sendstr);
            except
                Mysendcmd('ERROR','起始长度不是整数');;
            end;
        end
        else if cmdstr='ERROR' then
        begin
            addtishi('发生错误！'+valstr);
            mysendfile1.mSending:=false;
            myrevfile1.mReceiving:=false;
        end
        else if cmdstr='FILEOVER' then
        begin
            addtishi('文件传送完成');
            progbar1.Position:=100;
            statbar1.Panels[0].Text:='文件大小:'+inttostr(mysendfile1.mfileallsize)+'字节';
            statbar1.Panels[1].Text:='客户端已经接收'+inttostr(mysendfile1.mfileallsize)+'字节';
            statbar1.Panels[2].Text:= '100%';
            mysendfile1.mSending:=false;
            if copyfile(pchar('sendfile\'+mysendfile1.mfilename),
                pchar('sendfile\sendbak\'+mysendfile1.mfilename),false) then
            begin
                deletefile('sendfile\'+mysendfile1.mfilename);
            end;
            AddFileRz(mysendfile1.mfilename);
            mysendcmd('NEXTFILE','传送下一个文件');
        end
        else if cmdstr='GETINGLEN' then
        begin
            try
                mysendfile1.mfileSendSize:=strtoint(valstr);
            except
            end;
            if mysendfile1.mfileallsize<>0 then
            begin
                tmpint:=mysendfile1.mfileSendSize*100 div mysendfile1.mfileallsize;
            end;
            progbar1.Position:=tmpint;
            statbar1.Panels[0].Text:='文件大小:'+inttostr(mysendfile1.mfileallsize)+'字节';
            statbar1.Panels[1].Text:='客户端已经接收'+valstr+'字节';
            statbar1.Panels[2].Text:= inttostr(tmpint)+'%';
            //告诉客户端请求下一个文件块
            mysendcmd('NEXTPART',valstr);
            igetfrom:=strtoint(valstr);
        end
        else if cmdstr='GETNEXTPART' then
        begin
            igetfrom:=strtoint(valstr);
           
            if not fileexists('sendfile\'+mysendfile1.mfilename) then
            begin
                mysendcmd('FILEOVER','文件传输完毕');
                exit;
            end
            else
            begin
                mysendcmd('FILEOK',inttostr(MysendFile('sendfile\'+mysendfile1.mfilename,iGetFrom)));
                mysenddata(sendstr);
            end;
        end
        else if cmdstr='HANGUP' then
        begin
            addtishi('用户挂断！'+valstr);
            mysendfile1.mSending:=false;
        end//以下是上传文件所用
        else if cmdstr='UPFILE' then
        begin
            addtishi('客户端上传文件'+valstr);
            myrevfile1.mfilename:=valstr;
            mysendcmd('UPFILELEN','OK');

        end
        else if cmdstr='UPFILELEN' then
        begin
            try
                myrevfile1.mfileallsize:=strtoint(valstr);
                statbar1.panels[0].Text:='文件大小：'+valstr+'字节';
            except
                Mysendcmd('ERROR','文件大小不是整数');
                exit;
            end;
            if fileexists('revfile\tmprevfile\'+myrevfile1.mfilename)=false then
            begin
                fhandle:=filecreate('revfile\tmprevfile\'+myrevfile1.mfilename);
                fileclose(fhandle);
            end;
                igetfrom:=getfilelen('revfile\tmprevfile\'+myrevfile1.mfilename);
                mySendcmd('UPGETFROM',inttostr(igetfrom));
        end
        else if cmdstr='UPNEXTPART' then
        begin//请求客户端发送下一文件块

             myrevfile1.mfilesize:=getfilelen('revfile\tmprevfile\'+myrevfile1.mfilename);
             addtishi('请求客户端上载从'+inttostr(myrevfile1.mfilesize));
             mysendcmd('UPNEXTPARTOK',inttostr(myrevfile1.mfilesize));
        end
        else if cmdstr='UPFILEOK' then
        begin
            //addtishi('请求成功，开始接收数据');
            myrevfile1.mFileThissize:=strtoint(valstr);
            myrevfile1.mfilethissized:=0;
            myRevFile1.mreceiving:=true;
        end;
        if (myrevfile1.mReceiving=true) and (cmdstr<>'UPFILEOK') then
        begin //如果已经处于接收文件数据状态但是接到命令，则停止接收