Delphi/CppBuilder

开发平台：
Delphi

ServerFrm.pas：源码内容
							unit ServerFrm;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, ComCtrls, WinSock, ExtCtrls;
type
  TFrmMain = class(TForm)
    StaBar: TStatusBar;
    SaveDialog1: TSaveDialog;
    Panel1: TPanel;
    Label2: TLabel;
    OtherPort: TEdit;
    Panel2: TPanel;
    btnListen: TBitBtn;
    btnRecv: TBitBtn;
    btnStop: TBitBtn;
    btnExit: TBitBtn;
    procedure btnExitClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btnRecvClick(Sender: TObject);
    procedure btnStopClick(Sender: TObject);
    procedure btnListenClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    StopTrans: Boolean; //是否停止传送开关
    InTrans: Boolean; //表示是否正在接收文件
    Server: TSocket; //定义服务器端Socket句柄
    //自定义过程接收文件
    procedure RecvFile(filename: string);
  end;
var
  FrmMain: TFrmMain;
const BlockLen = 1024 * 4;
implementation
{$R *.DFM}
//当窗体创建时，启动winSock动态链接库
procedure TFrmMain.FormCreate(Sender: TObject);
var
  aWSAData: TWSAData;
begin
  if WSAStartup($0101, aWSAData) <> 0 then
    raise Exception.Create('不能启动WinSock动态链接库！');
  MessageBox(Handle, aWSAData.szDescription, 'WinSock 态链接库版本', MB_OK);
end;
//关闭窗口
procedure TFrmMain.btnExitClick(Sender: TObject);
begin
  Close;
end;
//窗口关闭时，检测是否正在接收文件
procedure TFrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if InTrans then
    if MessageBox(Handle, '正在接收文件，停止吗？', '提示', MB_YESNO) = IDNO then
      abort;
  //关闭Socket
  if Server <> INVALID_SOCKET then
    closesocket(Server);
  //释放WinSock动态库创建的资源
  if WSACleanup <> 0 then
    MessageBox(Handle, '清除WinSock动态链接库错误!', '提示', MB_OK)
  else MessageBox(Handle, '清除WinSock动态链接库成功!', '提示', MB_OK)
end;
//让服务器端的Socket开始监听
procedure TFrmMain.btnListenClick(Sender: TObject);
var
  ca: SOCKADDR_IN;
begin
  //创建服务器端Socket
  Server := Socket(PF_INET, SOCK_STREAM, IPPROTO_IP);
  if Server = INVALID_SOCKET then
  begin
    StaBar.SimpleText := '创建接收Socket错误！';
    Exit;
  end;
  //绑定服务器端Socket
  ca.sin_family := PF_INET;
  ca.sin_port := htons(StrToInt(Trim(OtherPort.Text)));
  ca.sin_addr.S_addr := INADDR_ANY;
  if bind(Server, ca, sizeof(ca)) = SOCKET_ERROR then
  begin
    StaBar.SimpleText := '绑定接收端Socket错误！请更改接收端口！';
    closesocket(Server);
    Exit;
  end
  else
    StaBar.SimpleText := '绑定接收端Socket成功！';
  //开始监听
  listen(Server, 5);
  BtnListen.Enabled := False;
  BtnStop.Enabled := True;
end;
//接收文件
procedure TFrmMain.RecvFile(filename: string);
var
  Ftrans: file of Byte;
  Recelen: Integer;
  BlockBuf: array[0..BlockLen - 1] of Byte;
  RecvSocket: TSocket;
  ra: SOCKADDR_IN;
  ra_len: Integer;
begin
  Ra_len := sizeof(Ra);
  //等待连接的客户端Socket
  RecvSocket := accept(Server, @ra, @ra_len);
  //创建一个保存的文件
  AssignFile(Ftrans, filename);
  ReWrite(Ftrans);
  //设置状态变量
  StopTrans := False;
  InTrans := True;
  //接收数据
  Recelen := recv(RecvSocket, BlockBuf, BlockLen, 0);
  while (Recelen > 0) and (not StopTrans) do
  begin
    BlockWrite(Ftrans, BlockBuf[0], Recelen);
    Application.ProcessMessages;
    Recelen := recv(RecvSocket, BlockBuf, BlockLen, 0);
      //当停止接收时，停止传输
    if StopTrans then
    begin
      CloseFile(Ftrans);
      closesocket(RecvSocket);
      InTrans := False;
      MessageBox(Handle, '停止传输！', '提示', MB_OK);
      Exit;
    end;
  end;
  //关闭文件，接收的Socket
  CloseFile(Ftrans);
  closesocket(RecvSocket);
  InTrans := False;
  if (Recelen = SOCKET_ERROR) then
    MessageBox(Handle, '传输异常终止！', '提示', MB_OK)
  else
    MessageBox(Handle, '客户端已经关闭连接！文件可能已经传送完毕！', '提示', MB_OK);
end;
//开始接收文件
procedure TFrmMain.btnRecvClick(Sender: TObject);
begin
  if (Server = INVALID_SOCKET) then
  begin
    MessageBox(Handle, '还没有进行监听，请先进行监听！', '提示', MB_OK);
    Exit;
  end;
  if SaveDialog1.Execute then
    RecvFile(saveDialog1.FileName);
end;
//停止接收文件
procedure TFrmMain.btnStopClick(Sender: TObject);
begin
  StopTrans := True;
  if Server <> INVALID_SOCKET then closesocket(Server);
        //此处需说明；
  Server := INVALID_SOCKET;
  BtnStop.Enabled := False;
  BtnListen.Enabled := True;
end;
end.

						