fm_mainclt.pas

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

            image2.visible:=true;
        end;
    end;
end;
function Tfm_mainclt1.MysendFile(filename:string;startpos:integer):integer;
var
buf:array [1..4096] of char;
NumRead,ccc: Integer;
F11:file;
begin
    sendstr:='';
    assignfile(f11,filename);
    reset(f11,1);
    if startpos<>0 then
    begin
        seek(f11,startpos);
    end;
    numread:=0;
    if (not eof(f11)) then
    begin
        //if comm1.SendDataEmpty then continue;
        ccc:=sizeof(buf);
        BlockRead(f11, Buf, SizeOf(Buf), NumRead);
        sendstr:=copy(buf,1,numread);
        //mysenddata(datastr);
    end;
    closefile(f11);
    mysendfile:=numread;
end;
function Tfm_mainclt1.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;
//发送指令及参数
function Tfm_mainclt1.MySendCmd(cmdStr:string;cmdVal:string):boolean;
begin
    MySendCmd:=mysenddata(gcmdhead+cmdStr+'='+cmdVal+gcmdtail);
end;
procedure Tfm_mainclt1.Memo2KeyPress(Sender: TObject; var Key: Char);
begin
    mysenddata(key);
end;

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

procedure Tfm_mainclt1.Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
  BufferLength: Word);
var
strData:string;
begin
   SetLength(strData, BufferLength); //接收RS232的数据并显示Memo1上。
   Move(Buffer^, PChar(strData)^, BufferLength);

   HandClientData(strData);
   myclientset.midletime:=time();
end;

procedure Tfm_mainclt1.BtnInitClick(Sender: TObject);
begin
    if InitMyComm() then
    begin
        btnsetup.Enabled:=false;
        BtnInit.Enabled:=false;
        btndial.Enabled:=true;
    end;
end;

procedure Tfm_mainclt1.Comm1ModemStateChange(Sender: TObject;
  ModemEvent: Cardinal);
begin
   case  modemevent of
//    ME_CTS: //memo2.Lines.add('cts');
//    ME_DSR: //memo2.Lines.add('dsr');
    ME_RING:
    begin
        addtishi('客户端呼叫！');
    end;
    ME_RLSD:
    begin
        if isonline=false then
        begin
            btndial.Enabled:=false;
            btnInit.Enabled:=false;
            mysendfile1.msending:=false;
            myrevfile1.mreceiving:=false;
            BBtnUpFile.Enabled:=true;
            addtishi('MODEM通讯网络接通');
            myClientset.mStarttime:=time();
            timer1.Enabled:=true;
            mysendcmd('FDID',myClientset.mClientFdid);
            btnGetfile.Enabled:=true;
            isonline:=true;
        end
        else
        begin
            mysendfile1.msending:=false;
            BBtnUpFile.enabled:=false;
            myrevfile1.mreceiving:=false;
            btndial.Enabled:=true;
            timer1.Enabled:=false;
            btnGetfile.Enabled:=false;
            addtishi('MODEM断开！需再次拨号');
            isonline:=false;
        end;
    end;
    end;
end;

procedure Tfm_mainclt1.BtnGetFileClick(Sender: TObject);
begin

    if myrevfile1.mReceiving=true then
    begin
        lbltishi.Caption:='正在下载文件，不能再次请求';
    end
    else if mysendfile1.mSending=true then
    begin
        lbltishi.Caption:='正在上传文件，不能再次请求';
    end;
    myGetfile();
end;
procedure Tfm_mainclt1.myGetFile();
var
fname:string;
begin
    if RadioButton1.Checked then
    begin
        fname:='spmx';
    end
    else if RadioButton2.Checked then
    begin
        fname:='udspmx';
    end
    else if RadioButton3.Checked then
    begin
        fname:='fdygxx';
    end
    else if RadioButton4.Checked  then
    begin
        fname:='retfdthd';
    end
    else if RadioButton5.Checked then
    begin
        fname:='retfdtcd';
    end
    else
    begin
        showmessage('选择要下载的文件');
        exit;
    end;
    lbox1.Clear;
    mysendcmd('GETFILELIST',fname);

end;
procedure Tfm_mainclt1.BtnDialClick(Sender: TObject);
begin
   //mysenddata('ATH'+chr(13));
   btndial.Enabled:=false;
   mydial(myclientset.mDialnum);
   btnhangup.Enabled:=true;
end;

procedure Tfm_mainclt1.BtnHangupClick(Sender: TObject);
begin
    if myrevfile1.mReceiving or mysendfile1.msending then
    begin
        addtishi('正在传输数据，不能挂机');
        exit;
    end;
    if boolean(comm1.Handle) then
    begin
        //用户取消挂机
        mysendcmd('HANDUP','CANCEL');
        sleep(1000);
        mysenddata('+++');
        sleep(1000);
        mysenddata('ATH'+chr(13));
    end;
    btndial.Enabled:=true;
    btnhangup.Enabled:=false;
end;

procedure Tfm_mainclt1.FormCreate(Sender: TObject);
begin
    image2.top:=image1.Top;
    image2.Left:=image1.left;
    panel2.Caption:=myclientset.mClientName;
end;
procedure Tfm_mainclt1.AddTishi(TishiStr:string);
begin
    lbox2.items.insert(0,timetostr(time())+'--'+tishistr);
    if lbox2.items.count>30 then
    begin
        lbox2.items.delete(lbox2.Items.count-1);
        lbox2.items.delete(lbox2.Items.count-1);
    end;
end;
procedure Tfm_mainclt1.Timer1Timer(Sender: TObject);
var
Hour, Min, Sec, MSec: Word;
begin
    statbar2.Panels[0].text:='连接时间：'+timetostr(time()-myclientset.mStarttime);
    statbar2.Panels[1].text:='闲置时间：'+timetostr(time()-myclientset.midletime);
    DecodeTime(time()-myclientset.midletime, Hour, Min, Sec, MSec);
    if (min*60+sec)>120 then
    begin
        myRevfile1.mReceiving:=false;
        mySendfile1.mSending:=false;
        btnhangup.Click;
    end;
end;

procedure Tfm_mainclt1.BtnSetupClick(Sender: TObject);
begin
   Application.CreateForm(Tfm_clientset, fm_clientset);
   fm_clientset.edit2.text:=myclientset.mDialNum;
   fm_clientset.CobBox1.Text:=myclientset.mCommName;
   fm_clientset.edit1.text:=myclientset.mClientFdid;
   fm_clientset.edit3.text:=myclientset.mClientName;
   fm_clientset.edit4.text:=myclientset.mcltdatapath;
   if fm_clientset.showmodal=IDOK then
   begin
       myclientset.mClientFdid:=fm_clientset.edit1.text;
       myclientset.mClientName:=fm_clientset.edit3.text;
       myclientset.mDialNum:=fm_clientset.Edit2.text;
       myclientset.mCommName:=fm_clientset.CobBox1.Text;
       myclientset.mcltdatapath:=fm_clientset.edit4.text;
       initsave2('客户端MODEM设置','串口',myclientset.mCommName);
       initsave2('客户端MODEM设置','电话',myclientset.mDialNum);
       initsave2('客户端MODEM设置','分店简称',myClientset.mClientName);
       initsave2('客户端MODEM设置','分店标识',myClientset.mClientFdid);
        initsave2('客户端MODEM设置','数据路径',myClientset.mCltDatapath);
       panel2.Caption:=myclientset.mClientName;
   end;
   fm_clientset.free;
end;

procedure Tfm_mainclt1.BBtnUpFileClick(Sender: TObject);
var
fname:string;
begin
    if myrevfile1.mReceiving=true then
    begin
        lbltishi.Caption:='正在下载文件，不能再次请求';
        exit;
    end
    else if mysendfile1.mSending=true then
    begin
        lbltishi.Caption:='正在上传文件，不能再次请求';
        exit;
    end;
    myUpfile();
end;
procedure Tfm_mainclt1.myUpfile();
var
fname:string;
filelist1:tstringlist;
i:integer;
begin
    if RBtn1.Checked then
    begin
        fname:='xsrz-'+myclientset.mClientFdid+'-*.db';
    end
    else if RBtn2.Checked then
    begin
        fname:='fdthd-'+myclientset.mClientFdid+'-*.db';
    end
    else if RBtn3.Checked then
    begin
        fname:='fdtcd-'+myclientset.mClientFdid+'-*.db';
    end
    else
    begin
        showmessage('选择要上传的文件');
        exit;
    end;

    mysendfile1.mfilename:=fname;
    //上传文件
    {filelist1:=mySearchfile(myClientset.mCltDataPath+'updata\'+fname);
    for i:=0 to filelist1.count-1 do
    begin
        copyfile(pchar(myClientset.mCltDataPath+'updata\'+filelist1.Strings[i]),
        pchar('sendfile\'+filelist1.Strings[i]),false);
    end;}
    //filelist1.Clear;
    filelist1:=mysearchfile('sendfile\'+fname);
    lbox1.items.clear;
    for i:=0 to filelist1.count-1 do
    begin
        lbox1.items.add(filelist1.Strings[i]);
    end;
    mysendfilelist();
end;
function Tfm_mainclt1.mySendfilelist():boolean;
begin
    if lbox1.Items.count>0 then
    begin
        mysendfile1.mfilename:=lbox1.Items.strings[0];
        panel4.Caption:='正在上传：'+lbox1.items.strings[0];
        lbox1.Items.delete(0);
        mysendfile1.mfileallsize:=GetFileLen('sendfile\'+mysendfile1.mfilename);
        if  mysendfile1.mfileallsize>0 then
        begin
            mysendcmd('UPFILE',mysendfile1.mfilename);
            mysendfilelist:=true;
            exit;
        end
        else
        begin
            addtishi('错误，上传文件存不在');
        end;
    end;
    mysendfilelist:=false;

end;
procedure Tfm_mainclt1.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
    canclose:=false;
    if mysendfile1.mSending then
    begin
        lbltishi.Caption:='正在发送数据，不能关闭';
    end
    else if  myrevfile1.mReceiving then
    begin
       lbltishi.Caption:='正在接收数据，不能关闭';
    end
    else if btnhangup.Enabled=true then
    begin
        lbltishi.caption:='请先挂断MODEM';
    end
    else
    begin
        canclose:=true;
    end;
    //BtnHangup.Click;
end;
function  Tfm_mainclt1.AnalyzerFilelist(filestr:string):boolean;
var
pos1:integer;
tmpstr:string;
begin
    addtishi(filestr);
    pos1:=pos('=',filestr);
    while pos1>0 do
    begin
        tmpstr:=copy(filestr,1,pos1-1);
        lbox1.items.add(tmpstr);
        filestr:=copy(filestr,pos1+1,length(filestr)-pos1);
        pos1:=pos('=',filestr);
    end;
end;
function Tfm_mainclt1.myGetfilelist():boolean;
begin
    if lbox1.Items.count>0 then
    begin
        myRevfile1.mfilename:=lbox1.items.Strings[0];
        mysendcmd('GETFILE',lbox1.items.strings[0]);
        panel4.Caption:='正在下载：'+lbox1.items.strings[0];
        lbox1.items.Delete(0);
        mygetfilelist:=true;
        exit;
    end;
    mygetfilelist:=false;
end;
end.