fm_mainclt.pas

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

unit fm_mainclt;

interface

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

type
  Tfm_mainclt1 = class(TForm)
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    Comm1: TComm;
    ProgBar1: TProgressBar;
    StatBar1: TStatusBar;
    Panel1: TPanel;
    Image1: TImage;
    Image2: TImage;
    Timer1: TTimer;
    StatBar2: TStatusBar;
    Panel2: TPanel;
    LblTishi: TLabel;
    Panel3: TPanel;
    BtnDial: TBitBtn;
    BtnInit: TBitBtn;
    BtnSetup: TBitBtn;
    GroupBox4: TGroupBox;
    RBtn1: TRadioButton;
    RBtn2: TRadioButton;
    RBtn3: TRadioButton;
    GroupBox5: TGroupBox;
    BtnGetFile: TButton;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    RadioButton3: TRadioButton;
    BBtnUpFile: TBitBtn;
    BtnHangup: TButton;
    RadioButton4: TRadioButton;
    RadioButton5: TRadioButton;
    GroupBox3: TGroupBox;
    LBox1: TListBox;
    Panel4: TPanel;
    LBox2: TListBox;
    procedure Memo2KeyPress(Sender: TObject; var Key: Char);
    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 BtnGetFileClick(Sender: TObject);
    procedure BtnDialClick(Sender: TObject);
    procedure BtnHangupClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure BtnSetupClick(Sender: TObject);
    procedure BBtnUpFileClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    { Private declarations }
    function InitMyComm():boolean;
    function MyCommListen():boolean;
    function MyDial(dialstr:string):boolean;
    procedure HandClientData(strData:string);
    function MySendData(dataStr:string):boolean;
    function MySendCmd(cmdStr:string;cmdVal:string):boolean;
    procedure CloseMycomm();
    procedure AddTishi(TishiStr:string);
    procedure myGetFile();
    procedure myUpfile();
    function MysendFile(filename:string;startpos:integer):integer;
    function mySendfilelist():boolean;
    function AnalyzerFilelist(filestr:string):boolean;
    function myGetfilelist():boolean;
  public
    { Public declarations }
  end;

var
  fm_mainclt1: Tfm_mainclt1;

implementation

uses pfm_clientset;

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

        comm1.StartComm();
    except
        //showmessage(E
        comm1.StopComm;
        InitMycomm:=false;
        exit;
    end;
    addtishi('初始化串口成功');
    initMycomm:=true;
end;

procedure Tfm_mainclt1.CloseMycomm();
begin
    if boolean(comm1.Handle) then
    begin
        comm1.StopComm;
    end;
end;
//自动侦听并应答
function Tfm_mainclt1.MyCommListen():boolean;
var
wDataLen:Word;
sData:string;
begin
    try
        sData:='AT S0=1 E0 Q0' + 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_mainclt1.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:='AT E0 Q0' + Chr(13);
    sData:='ATDT'+dialstr+chr(13);
    wDataLen:=length(sData);
    comm1.WriteCommData(pchar(sData),wDataLen);
    mycommstat1.server:=false;
    mydial:=true;
end;

procedure Tfm_mainclt1.HandClientData(strData:string);
//处理Client数据
var
DataStr,tmpstr:String;
posCmdHead,posCmdTail:integer;
cmdStr,Valstr:string;
igetfrom:integer;
tmpint,fhandle:integer;
begin
    DataStr:=strData;
    ClientRevData:=strData;
    //addtishi(strdata);
    posCmdHead:=pos(gcmdhead,ClientRevData);
    posCmdTail:=pos(gcmdtail,ClientRevData);
    if (posCmdHead>0) and (posCmdTail>poscmdhead) then
    begin
        tmpstr:=copy(ClientRevData,posCmdhead+length(gCmdhead),
            posCmdTail-posCmdhead-length(gcmdhead));
        analyzeCmd(tmpstr,cmdstr,valstr);
        if cmdstr='GETNAME' then
        begin
            addtishi('服务器名字：'+valstr);
            mysendcmd('FDNAME',myclientset.mClientName);
        end
        //addtishi('请求文件'+tmpstr);
        //发送的字符串为请求文件的大小
        else if cmdStr='FILELIST' then
        begin //服务器返回文件下载的文件列表
            AnalyzerFilelist(valstr);
            addtishi('得到服务器返回的文件列表,开始下载');
            mygetfilelist();
        end
        else if cmdStr='NEXTFILE' then
        begin
            if lbox1.Items.Count>0 then
            begin
                myGetfilelist();
            end;
        end
        else if cmdstr='FILELEN' 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);
                addtishi('创建文件成功');
            end;
                igetfrom:=getfilelen('revfile\tmprevfile\'+myrevfile1.mfilename);
                mySendcmd('GETFROM',inttostr(igetfrom));
        end
        else if cmdstr='FILEOK' then
        begin
            //addtishi('请求成功，'+valstr);
            myrevfile1.mFileThissize:=strtoint(valstr);
            myrevfile1.mfilethissized:=0;
            myRevFile1.mreceiving:=true;
        end
        else if cmdstr='NEXTPART' then
        begin//请求下一个文件块
            myrevfile1.mfilesize:=getfilelen('revfile\tmprevfile\'+myrevfile1.mfilename);
            mysendcmd('GETNEXTPART',inttostr(myrevfile1.mfilesize));
        end
        else if cmdstr='ERROR' then
        begin
            addtishi('错误！'+valstr);
            myRevfile1.mreceiving:=false;
            mysendfile1.mSending:=false;
        end//以下是处理上传文件的
        else if cmdstr='UPFILELEN' then
        begin
            addtishi('服务器询问文件大小');
            if mysendfile1.mfileallsize<>0 then
            begin
                mySendcmd('UPFILELEN',inttostr(mysendfile1.mfileallsize));
            end
            else
            begin
                mySendcmd('ERROR','文件大小为0');
            end;
        end
        else if cmdstr='UPGETFROM' then
        begin
            addtishi('服务器请求上载的文件从'+valstr+'处开始');
            iGetfrom:=0;
            try
                igetfrom:=strtoint(valstr);
                if not fileexists('sendfile\'+mysendfile1.mfilename) then
                begin
                    mysendcmd('ERROR','不存在请求的文件');
                    exit;
                end;
                mysendcmd('UPFILEOK',inttostr(MysendFile('sendfile\'+mysendfile1.mfilename,iGetFrom)));
                mysenddata(sendstr);
                mysendfile1.mSending:=true;
            except
                Mysendcmd('ERROR','起始长度不是整数');;
            end;
        end
        else if cmdstr='UPNEXTPARTOK' then
        begin//服务器向客户端请求发送下一个文件块数据
            igetfrom:=strtoint(valstr);
           
            if fileexists('sendfile\'+mysendfile1.mfilename) then
            begin
                 mysendcmd('UPFILEOK',inttostr(MysendFile('sendfile\'+mysendfile1.mfilename,iGetFrom)));
                 mysenddata(sendstr);
            end
            else
            begin
                 //mysendcmd('UPFILEOVER','上传完毕');
                 
            end;

        end
        else if cmdstr='UPFILEOVER' 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;
            panel4.Caption:='';
            if lbox1.Items.Count>0 then
            begin
                mysendfilelist();
            end;
        end
        else if cmdstr='UPGETINGLEN' then
        begin
            try
                mysendfile1.mfileSendSize:=strtoint(valstr);
            except
            end;
            tmpint:=0;
            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('UPNEXTPART',valstr);
        end;
        if (myrevfile1.mReceiving=true) and (cmdstr<>'FILEOK') then
        begin //如果已经处于接收文件数据状态但是接到命令，则停止接收
            myRevfile1.mreceiving:=false;
        end;
        ClientRevData:=copy(ClientRevData,poscmdtail+length(gcmdtail),
            length(ClientRevData)-poscmdtail-length(gcmdtail)+1);
    end;
    if myrevfile1.mreceiving then
    begin
        myrevfile1.mFilethissized:=myrevfile1.mfilethissized+length(clientrevdata);
        myrevfile1.mFilesize:=AppendTofile1('revfile\tmprevfile\'+myRevfile1.mfilename,clientRevData);
        statbar1.panels[1].Text:='已下载大小:'+inttostr(myrevfile1.mFilesize)+'字节';
        if myrevfile1.mFilesize>myrevfile1.mFileAllsize then
        begin
            mysendcmd('ERROR','下载出错,得到的文件大于原始文件');
            deletefile('revfile\tmprevfile\'+myRevfile1.mfilename);
            addtishi('传输出错，得到的文件大于原始文件');
            myrevfile1.mreceiving:=false;
        end
        else if myrevfile1.mfilesize=myrevfile1.mFileAllsize then
        begin
            mysendcmd('FILEOVER','文件下载完成');
            addtishi('文件下载完成');
            if copyfile(pchar('revfile\tmprevfile\'+myRevfile1.mfilename),
                pchar('revfile\'+myrevfile1.mfilename),false) then
            begin
                deletefile('revfile\tmprevfile\'+myRevfile1.mfilename);
            end;
            progbar1.position:=100;
            statbar1.Panels[2].text:='100%';
            myrevfile1.mReceiving:=false;
        end
        else
        begin
            if myrevfile1.mfileallsize<>0 then
            begin
                tmpint:=(myrevfile1.mfilesize*100 div myrevfile1.mFileAllsize);
                progbar1.Position:=tmpint;
                statbar1.Panels[2].text:=inttostr(tmpint)+'%';
                //告诉服务器已经接收了多少大小
            end;
            if myrevfile1.mFilethissize=myrevfile1.mfilethissized then
            begin
                mysendcmd('GETINGLEN',inttostr(myrevfile1.mfilesize));
            end
            else if myrevfile1.mFilethissize<myrevfile1.mfilethissized then
            begin
                mysendcmd('ERROR','传输过程出错');
                deletefile('revfile\tmprevfile\'+myRevfile1.mfilename);
            end;
        end;
    end;
    if (length(datastr)>0)  then
    begin
        if image1.Visible=false then
        begin
            image1.visible:=true;
            image2.visible:=false;
        end
        else
        begin
            image1.visible:=false;