fm_mainsev.pas

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

            myRevfile1.mreceiving:=false;
        end;
        serverrevdata:=copy(serverrevdata,poscmdtail+length(gcmdtail),
                length(serverrevdata)-poscmdtail-length(gcmdtail)+1);
    end;
    if myrevfile1.mreceiving then
    begin
        myrevfile1.mFilethissized:=myrevfile1.mfilethissized+length(serverrevdata);
        myrevfile1.mFilesize:=AppendTofile1('revfile\tmprevfile\'+myRevfile1.mfilename,serverrevdata);
        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('UPFILEOVER','文件上载完成');
            if copyfile(pchar('revfile\tmprevfile\'+myRevfile1.mfilename),
                pchar('revfile\'+myRevfile1.mfilename),false) then
            begin
                deletefile('revfile\tmprevfile\'+myRevfile1.mfilename);
            end;
            addtishi('文件传送完成');
            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('UPGETINGLEN',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
        //memo1.Lines[memo1.lines.count-1]:=memo1.Lines[memo1.lines.count-1]+datastr;
        if image1.Visible=false then
        begin
            image1.visible:=true;
            image2.visible:=false;
        end
        else
        begin
            image1.visible:=false;
            image2.visible:=true;
        end;
    end;

end;
function Tfm_mainsev1.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
        ccc:=sizeof(buf);
        BlockRead(f11, Buf, SizeOf(Buf), NumRead);
        sendstr:=copy(buf,1,numread);
    end;
    closefile(f11);
    mysendfile:=numread;
end;

procedure Tfm_mainsev1.HandClientData(strData:string);
var
DataStr:string;
begin
    DataStr:=strData;
end;

function Tfm_mainsev1.MySendData(dataStr:ansistring):boolean;
var
wDataLen:Word;
sData:ansistring;
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_mainsev1.MySendCmd(cmdStr:string;cmdVal:string):boolean;
begin
    MySendCmd:=mysenddata(gcmdhead+cmdStr+'='+cmdVal+gcmdtail);
end;

procedure Tfm_mainsev1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
    CloseMycomm();
    table1.Active:=false;
end;

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

procedure Tfm_mainsev1.BtnInitClick(Sender: TObject);
begin
    if InitMyComm() then
    begin
        btnInit.Enabled:=false;
        bbtnsetup.Enabled:=false;
        bbtnstart.Enabled:=true;
    end;
end;

procedure Tfm_mainsev1.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
            addtishi('MODEM通讯网络接通');
            mysendfile1.msending:=false;
            myrevfile1.mreceiving:=false;
            myServerset.mCurClientStime:=time();
            groupbox3.Visible:=true;
            timer1.Enabled:=true;
            isonline:=true;
        end
        else
        begin
            lblfdid.Caption:='';
            lblfdname.Caption:='';
            groupbox3.Visible:=false;
            addtishi('MODEM断开，开始侦听下一个请求！');
            timer1.Enabled:=false;
            mysendfile1.msending:=false;
            myrevfile1.mreceiving:=false;
            isonline:=false;
        end;
    end;
    end;
end;

procedure Tfm_mainsev1.BBtnStartClick(Sender: TObject);
begin
    if true then
    begin
       if not MyCommListen() then
       begin
            addtishi('开始侦听来自客户端的请求失败！');
       end
       else
       begin
            addtishi('服务器启动，开始侦听来自客户端的请求');
            BBtnstart.Enabled:=false;
            myserverset.mStartingTime:=now();
       end;
    end
    else
    begin
        addtishi('串口初始化失败！');
    end;
end;

procedure Tfm_mainsev1.Comm1SendDataEmpty(Sender: TObject);
begin
    OutBuffEmpty1:=true;
end;
procedure Tfm_mainsev1.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_mainsev1.FormCreate(Sender: TObject);
begin
    image2.top:=image1.Top;
    image2.Left:=image1.left;

    table1.TableName:='rztrans\getfile.db';
    table1.Active:=true;
end;

procedure Tfm_mainsev1.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
    if isonline then
    begin
        if  application.MessageBox(pchar('有客户端MODEM连接，要关闭吗？'),
            pchar('警告！'),MB_YESNO)<>IDYES then
        begin
            lbltishi.Caption:='有客户端MODEM连接，不能关闭';
            canclose:=false;
        end;
    end;
end;

procedure Tfm_mainsev1.Timer1Timer(Sender: TObject);
begin
    statbar2.Panels[0].text:='连接时间：'+timetostr(time()-myserverset.mCurClientStime);
    statbar2.Panels[1].text:='闲置时间：'+timetostr(time()-myserverset.midletime);
   
end;

procedure Tfm_mainsev1.BBtnSetupClick(Sender: TObject);
begin
   Application.CreateForm(Tfm_serverset, fm_serverset);
   fm_serverset.CobBox1.Text:=myServerset.mCommName;
   fm_serverset.edit1.text:=myserverset.mServername;
   fm_serverset.edit4.text:=myserverset.mSevDatapath;
   if fm_serverset.showmodal=IDOK then
   begin
       myServerset.mCommName:=fm_serverset.CobBox1.Text;
       myserverset.mServername:=fm_serverset.edit1.text;
       myserverset.mSevDatapath:=fm_serverset.edit4.text;
       initsave2('服务器MODEM设置','串口',myServerset.mCommName);
       initsave2('服务器MODEM设置','服务器名称',myserverset.mServername);
       initsave2('服务器MODEM设置','总部数据路径',myserverset.mSevDatapath);
   end;
   fm_serverset.free;
end;
//根据客户端的请求获得文件列表
function Tfm_mainsev1.myGetfilelist(strfile:string):string;
var
filelist1:tstringlist;
tmpstr:string;
i:integer;
begin
     filelist1:=mySearchfile('sendfile\'+strfile+'-'+lblfdid.caption+'*.db');
     for i:=0 to filelist1.count-1 do
     begin
        if length(tmpstr)>240 then
        begin
            break;
        end;
        tmpstr:=tmpstr+filelist1.strings[i]+'=';
     end;
     addtishi(tmpstr);
     myGetfilelist:=tmpstr;
end;

function Tfm_mainsev1.AddFileRz(fname:string):boolean;
begin
    //将已经下载的文件移到sendbak目录下

    if copyfile(pchar('sendfile\'+fname),
          pchar('sendfile\sendbak\'+fname),false) then
    begin
        if not deletefile('sendfile\'+fname) then
        begin
            addtishi('文件下载完毕，但是移动文件失败');
        end;
    end;
    //将已经下载的文件加入到数据库中
    if table1.Locate('fname',fname,[])=false then
    begin
        table1.append;
        table1.FieldByName('fname').asstring:=fname;
        table1.FieldByName('rq').asdatetime:=now();
        table1.post;
    end;
end;

procedure Tfm_mainsev1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
    if (key=#13) and (edit1.text='zhong') then
    begin
        query1.SQL.clear;
        query1.sql.Add('delete from rztrans\getfile.db');
        query1.ExecSQL;
        query1.sql.clear;
        query1.sql.add('delete from rztrans\upfile.db');
        query1.ExecSQL;
    end;
end;

end.