Delphi ServerSocket,ClientSocket示例
2008-05-09 16:20

Delphi TServerSocket,TClientSocket实现传送文件代码

1.建立两个工程Server及Client

分别放TServerSocket及TClientSocket控件,Demo,Edit控件等。

2.设置TServerSocket name为 SS, ServerType为stNonBlocking,TClientSocket name为cs,ClientType为ctNonBlocking表示异步读写信息。注意ClientType和ServerType要相一致.若为ctBlocking则表示同步读写信息。(相一致,这点相当重要!香巴拉~)

3.Socket传送文件的顺序图

a)Client-->Server MP_QUERY

b)Server-->Client MP_ACCEPT

c) Client-->Server MP_FileProperty

d)Server-->Client MP_NextWillBeData

e)Client-->Server MP_NextWillBeData

f)Server-->Client MP_DATA

g) Client-->Server 发送数据

h) Server接收数据并处理

i)Client-->Server MP_END结束

4.Client端代码

unit UnitClient;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ScktComp, StdCtrls, Buttons, ExtCtrls, ComCtrls;
Const
//设置协议标志符
//标志将要发送文件名
MP_QUERY ='aaaaa';
//标志服务器拒绝接收
MP_REFUSE ='bbbbb';
//标志服务器同意接收文件
MP_ACCEPT ='ccccc';
//标志将要传递数据
MP_NEXTWILLBEDATA='ddddd';
//标志服务器端准备接收数据
MP_DATA ='eeeee';
//标志客户端取消了本次发送操作
MP_ABORT ='fffff';
//标志已经发送完毕
MP_END='iiiii';
//标志发送的文件长度
MP_FILEPROPERTY='jjjjj';
//指定每次发送包的大小
iBYTEPERSEND=1024;

type
TForm1 = class(TForm)
    OpenDialog1: TOpenDialog;
    cs: TClientSocket;
    Panel1: TPanel;
    btnSendFile: TBitBtn;
    edtIPAddress: TEdit;
    Memo1: TMemo;
    edtHostName: TEdit;
    RB1: TRadioButton;
    RB2: TRadioButton;
    ProBar: TProgressBar;
    Btncancel: TBitBtn;
    Btnexit: TBitBtn;
    procedure btnSendFileClick(Sender: TObject);
    procedure csRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure FormCreate(Sender: TObject);
    procedure BtncancelClick(Sender: TObject);
    procedure BtnexitClick(Sender: TObject);
private
    //定义一个发送文件的数据流
    fsSend: TFileStream;
    //设置开始状态位
    tStart:Boolean;
    //标识当前时间
    TickCount:Longword;
    { Private declarations }
public
    { Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

//发送文件
procedure TForm1.btnSendFileClick(Sender: TObject);
begin
//关闭套接字连接
cs.Close;
//初始化进程条
Probar.Position:=0;
if RB1.Checked then
begin
   cs.Host:='';
   //指定要连接的主机IP地址
   cs.Address:=edtIPAddress.Text;
end
else
//指定要连接的主机名
cs.Host:=edtHostName.Text;
//要连接的主机所用端口号
cs.Port:=2000;
//打开套接字连接
cs.Open;
//点击发送确认按钮
if OpenDialog1.Execute then
Begin
//发送连接请求
    cs.Socket.SendText(MP_QUERY+OpenDialog1.FileName);
end;
end;

//客户端接收来自服务器端的信息
procedure TForm1.csRead(Sender: TObject; Socket: TCustomWinSocket);
var
MsgRecv:string;
bufSend:pointer;
iLength:Integer;
begin
//得到客户端发来的信息
MsgRecv:=Socket.ReceiveText;
//取前5位,得到协议标志符
MsgRecv:=copy(MsgRecv,1,5);
//接收到拒绝信息
if MsgRecv=MP_REFUSE then
    memo1.Lines.Add('连接请求被拒绝!')
    //接收到确认接收信息
else if MsgRecv=MP_ACCEPT then
begin
    //为要发送的文件创建文件流
    fsSend:=TFileStream.Create(OpenDialog1.FileName,fmOpenRead);
    tStart:=False;
    //进度条显示
    Probar.Max:=fsSend.Size;
    memo1.Lines.Add('开始发送!');
    //获取发送开始时的时间
    TickCount:=GetTickCount;
    //创建文件流并发送文件长度。
    Socket.SendText(MP_FILEPROPERTY+inttostr(Trunc(fsSend.Size/iBYTEPERSEND)+1));
end
else if MsgRecv=MP_NEXTWILLBEDATA then
begin
    //通知接收端将要传送数据。
    Socket.SendText(MP_NEXTWILLBEDATA);
end
else if MsgRecv=MP_DATA then
begin
    //接收到确认信息,开始发送数据。
    if not tStart then
    begin
      memo1.Lines.Add('发送数据中... ...');
      tStart:=True;
    end;
    //还有数据没有发送。
    if fsSend.Position< fsSend.Size-1 then
    begin
      iLength:=fsSend.Size-1-fsSend.Position;
      //将数据分段发送
      if iLength>iBYTEPERSEND then
        iLength:=iBYTEPERSEND;
      GetMem(bufSend,iLength+1);
      try
        //读取文件流数据
        fsSend.Read(bufSend^,iLength);
        //发送长度为iLength的数据
        Socket.SendBuf(bufSend^,iLength);
         //进度条显示
        Probar.Position:=fsSend.Position;
      finally
        //释放内存
        FreeMem(bufSend,iLength+1);
      end;
    //发送完毕
    end else
    begin
      //通知主机文件传送结束。
      Socket.SendText(MP_END);
      memo1.Lines.Add('发送完成!');
      //获取发送耗时
      memo1.Lines.Add('发送耗时'+IntToStr(GetTickCount-TickCount)+'毫秒');
      fsSend.Free;    
    end;
//取消文件发送过程
end else if MsgRecv=MP_ABORT then
begin
    memo1.Lines.Add('中止!');
    //文件传送取消
    fsSend.Free;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Memo1.Clear;
end;
//取消
procedure TForm1.BtncancelClick(Sender: TObject);
begin
//取消文件发送过程
cs.Socket.SendText(MP_ABORT);
end;

procedure TForm1.BtnexitClick(Sender: TObject);
begin
Form1.Close;
end;

end.
5.Server端代码

unit UnitServer;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons, ScktComp, ExtCtrls;
Const
//设置协议标志符
//标志将要发送文件名
MP_QUERY ='aaaaa';
//标志服务器拒绝接收
MP_REFUSE ='bbbbb';
//标志服务器同意接收文件
MP_ACCEPT ='ccccc';
//标志将要传递数据
MP_NEXTWILLBEDATA='ddddd';
//标志服务器端准备接收数据
MP_DATA ='eeeee';
//标志客户端取消了本次发送操作
MP_ABORT ='fffff';
//标志已经发送完毕
MP_END='iiiii';
//标志发送的文件长度
MP_FILEPROPERTY='jjjjj';
//指定每次发送包的大小
iBYTEPERSEND=1024;
type
TForm1 = class(TForm)
    SaveDialog1: TSaveDialog;
    ss: TServerSocket;
    Memo1: TMemo;
    procedure ssClientRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
private
    //定义一个接收文件的数据流
    fsRecv:TFileStream;
    //设置开始状态位
    tStart:Boolean;
    //标识当前时间
    TickCount:Longword;
    { Private declarations }
public
    { Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}
//服务器端接收来自客户端的信息
procedure TForm1.ssClientRead(Sender: TObject; Socket: TCustomWinSocket);
var
msgr,theFileName:string;
bufRecv:Pointer;
iLength:Integer;
begin
//接收到的数据的长度
iLength:=Socket.ReceiveLength;
//开辟一块新的内存,用来保存接收到的数据
GetMem(bufRecv,iLength);
try
    //接收数据
    Socket.ReceiveBuf(bufRecv^,iLength);
    //将接收到的数据以字符串的形式存到msgr中
    msgr:=StrPas(PChar(bufRecv));
    //取前5个字符
    msgr:=Copy(msgr,1,5);
    if msgr=MP_QUERY then
    begin
      //去掉字符串前后的空格和控制字符
      msgr:=Trim(StrPas(PChar(bufRecv)));
      //第5个字符后面的字符串为文件名
      theFileName:=ExtractFileName(Copy(msgr,6,Length(msgr)));
      SaveDialog1.Title:='请选择或输入接收到的数据保存到的文件名:';
      SaveDialog1.FileName:=theFileName;
      //点击确认保存按钮
      if SaveDialog1.Execute then
      begin
        //为需保存的文件创建文件流
        fsRecv:=TFileStream.Create(SaveDialog1.FileName,fmCreate);
        //如果同意接收数据。
        memo1.Lines.Add ('开始接收!');
        TickCount:=GetTickCount;
        //发送同意接收文件的信息
        Socket.SendText(MP_ACCEPT);
        tStart:=False;
      end
      else
        //发送拒绝接收文件的信息
        Socket.SendText(MP_REFUSE);
    end
    else if msgr=MP_FILEPROPERTY then
    begin
      //接收文件长度并说明主机可以接收数据了
      Socket.SendText(MP_NEXTWILLBEDATA);
    end
    else if msgr=MP_NEXTWILLBEDATA then
    begin
      //要求发送端发送数据
      Socket.SendText(MP_DATA);
    end else if msgr=MP_END then
    begin
      memo1.Lines.Add ('文件传送完成!');
      memo1.Lines.Add ('接收耗时'+IntToStr(GetTickCount-TickCount)+'毫秒');
      fsRecv.Free;
    end
    //接收到文件传送取消信息
    else if msgr=MP_ABORT then    
    begin
      memo1.Lines.Add ('MP_ABORT');
      Socket.SendText(MP_ABORT);
      fsRecv.Free;
    end
   else
    begin
      if not tStart then
      begin
        memo1.Lines.Add('接收数据...');
        tStart:=True;
      end;
      //将接收缓冲区数据写入文件
      fsRecv.WriteBuffer(bufRecv^,iLength);
      //通知客户端继续发送数据
      Socket.SendText(MP_DATA);
    end;
finally
    //释放内存
    FreeMem(bufRecv,iLength);
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Memo1.Clear;
//设置的监听端口
ss.Port:=2000;
//开始监听
ss.Open;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
ss.Close;
end;

end.

Delphi ServerSocket,ClientSocket示例的更多相关文章

  1. 编写serversocket简单示例1

    package j2se.core.net.tcp; import java.io.DataOutputStream;import java.io.IOException;import java.ne ...

  2. delphi webbrowser 常用方法示例

    var Form : IHTMLFormElement ; D:IHTMLDocument2 ; begin with WebBrowser1 do begin D := Document as IH ...

  3. [Delphi] Webbroker ISAPI 示例说明

    新建Webbroker项目: 选择类型: 开始可以使用:Indy VCL Application 方便调试,完成后,再新建一个DLL 项目,引用业务单元.   示例代码如下: unit uDataMo ...

  4. delphi 操作xml示例(DelphiBBS)

    自:http://www.delphibbs.com/keylife/iblog_show.asp?xid=20713 ======================================== ...

  5. 最简单的TTcpServer与TTcpClient通信实例-Delphi

    unit TcpSCDemo;//最简单的TTcpServer与TTcpClient通信实例-Delphi //Borland推出TTcpServer与TTcpClient作为主要的网络通信控件,意味 ...

  6. 使用delphi+intraweb进行微信开发4—微信消息加解密

    示例代码已经放出!请移步使用delphi+intraweb进行微信开发1~4代码示例进行下载,虽为示例代码但是是从我项目中移出来的,封装很完备适于自行扩展和修改. 在上一讲当中我做了个简单的微信文本消 ...

  7. 让Delphi的DataSnap发挥最大效率

    让Delphi的DataSnap发挥最大效率 让Delphi的DataSnap发挥最大效率 一个DataSnap的应用程序由两个层组成: DataSnap服务器,它有一个带有一个或者更多DataSet ...

  8. [原创] Delphi Win API函数 操作帮助文件 HtmlHelpA函数介绍

    Delphi Win API函数 操作帮助文件 HtmlHelpA函数介绍 函数原型:HWND HtmlHelpA( HWND hwndCaller, LPCSTR pszFile, UINT uCo ...

  9. delphi 压缩

    DELPHI 通过ZLib来压缩文件夹 unit Unit1; interface uses ZLib, Windows, Messages, SysUtils, Variants, Classes, ...

随机推荐

  1. unity, polygon collider 2D 添加顶点

    正常情况下只要按下了Edit Collider按钮,鼠标停在polygon collider 2D的一条边上,就会出现一个虚拟的新顶点,此时如果按下鼠标,新顶点就创建出来了. 但是我今天遇到一个奇怪的 ...

  2. javascript 停止事件冒泡以及阻止默认事件冒泡

    停止事件冒泡 function stopBubble(e) { // 如果提供了事件对象,则这是一个非IE浏览器 if ( e && e.stopPropagation ) { // ...

  3. Nancy 简单学习

    1. 环境 vs2010 , nancy 2. 需要测试的功能 1. 输出 页面输出简单文本 2. 输出json 数据 3. 操作 1. 创建asp.net 空项目 2. 添加引用Nancy库 使用n ...

  4. 【转】Win7注册表的使用(更新中)

    一.注册表的存储结构和数据类型 1.基本概念: Windows 7的注册表主要由“键”和“键值”构成,称HKEY为根键(RootKey),SubKey为子键. 键(Key):“位于左侧窗格如同文件夹图 ...

  5. 初识MariaDB存储引擎

    在看MariaDB的存储引擎之前,可以先了解MySQL存储引擎. MySQL常用的存储引擎: MyISAM存储引擎:是MySQL的默认存储引擎.MyISAM不支持事务.也不支持外键,但其访问速度快,对 ...

  6. js禁止从浏览器缓存读取消息

    $.ajaxSetup ({ cache: false //设置成false将不会从浏览器缓存读取信息 });

  7. eclipse中tomcat发布失败(Could not delete May be locked by another process)原因及解决办法

    在eclipse中tomcat发布项目时,偶尔出现了以下情况: publishing to tomcat v7.0 services at localhost has encountered a pr ...

  8. 【initrd】向虚拟文件系统initrd.img中添加驱动

    虚拟文件系统:initrd-2.6.18-194.el5.img 希望添加网卡或SCSI等驱动 步骤: 解压initrd-2.6.18-194.el5.img: 添加*.ko文件,并修改init可执行 ...

  9. 读书笔记:Ross:概率模型导论:方差和协方差

    例2.34 考虑N个人,一些人赞同某个提议,另一些人反对.假定Np个人赞同,N-Np人反对,p未知.现在想要通过随机选取n个人调查他们的态度,并由此来估计总体中赞同这个提议的人员比例p. 设Xi=1表 ...

  10. python之pexpect模块

    最近在看<Python自动化运维技术与最佳实战>这本书,学到了一个运维中用到的模块:pexpect 下面是其定义: Pexpect 是一个用来启动子程序并对其进行自动控制的 Python ...