Khan's Notebook GCC/GNU/Linux Delphi/Window Java/Anywhere

路漫漫,长修远,我们不能没有钱
随笔 - 172, 文章 - 0, 评论 - 257, 引用 - 0
数据加载中……

[导入]终于搞定了异步通信了,调试了两天,发现偶还素犯了一个弱智错误

我把client的socket初始化内容写在了message响应函数里面了,每次触发消息的时候就把客户端的socket置0了

 

服务器端代码如下:

由于比较简单,所以不贴注释了,如果有什么不懂d地方,大家对着翻吧

 

unit Listener;

interface

uses
  SysUtils,  Controls, Forms, winsock, Classes, ComCtrls, StdCtrls;


const ASYNC_EVENT = $0400 + 1;
  SO_CONDITIONAL_ACCEPT = $3002;
type

  TCMSocketMessage = record //select 消息结构
    Msg: Cardinal; //系统消息
    Socket: TSocket; //产生消息的源socket 句柄
    SelectEvent: Word; //select消息
    SelectError: Word; //错误
    Result: Longint;
  end;

 

type
  TMain = class(TForm)
    SBar: TStatusBar;
    Memo1: TMemo;
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    s: TSocket;
    SClinent: TSocket;
    procedure bindAddr;
    procedure CMIncCount(var Msg: TCMSocketMessage); message ASYNC_EVENT;
    procedure listenAddr;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Main: TMain;

implementation

{$R *.dfm}

procedure TMain.FormDestroy(Sender: TObject);
begin
  closeSocket(s);
  WSACleanup();
end;

procedure TMain.FormCreate(Sender: TObject);
var
  wsa: TWSaData;
  flag: integer;
begin
  SClinent := 0;
  //SysUtils.BoolToStr()
  flag := WSAStartup($0202, wsa); //加载winsock
  if flag <> 0 then begin
    SBar.Panels[2].Text := format('错误号:%d', [WSAGetLastError()]);
    SBar.Panels[1].Text := 'Winsock库加载失败';
  end;

  bindAddr;
  listenAddr;
end;


procedure TMain.bindAddr;
var
  addr: TSockAddrIn;
  flag: integer;
begin
  s := socket(AF_INET, SOCK_STREAM, IPPROTO_TCP); //服务器端的socket
  addr.sin_port := htons(45531);
  addr.sin_family := AF_INET;
  addr.sin_addr.S_addr := INADDR_ANY; //inet_addr(pchar(host));

  flag := bind(s, addr, sizeof(addr));
  if flag = SOCKET_ERROR then begin
    SBar.Panels[2].Text := format('错误号:%d', [WSAGetLastError()]);
    SBar.Panels[1].Text := 'IP绑定错误';
  end else begin
    flag := WSAAsyncSelect(s, Handle, ASYNC_EVENT, FD_ACCEPT or FD_CONNECT or FD_CLOSE or FD_READ or FD_WRITE);
    if flag = SOCKET_ERROR then begin
      SBar.Panels[2].Text := format('错误号:%d', [WSAGetLastError()]);
      SBar.Panels[1].Text := 'WSAAsyncSelect错误';
    end;
  end;
end;

procedure TMain.listenAddr;
var flag: integer;
begin
  flag := listen(s, 10);
  if flag = SOCKET_ERROR then begin
    SBar.Panels[2].Text := format('错误号:%d', [WSAGetLastError()]);
    SBar.Panels[1].Text := '监听失败';
  end;
end;

 

procedure TMain.CMIncCount(var Msg: TCMSocketMessage);
var
  addr: TSockAddrIn;
  len: integer;
  SendBuf: array[1..1024] of AnsiChar;
  recvBuf: array[1..1024] of AnsiChar;
  str: string;
  OldOpenType {, NewOpenType}: integer;
begin
  len := 0;

  str := '';

  case Msg.SelectEvent of
    FD_READ: begin
        len := sizeof(recvBuf);
        ioctlsocket(SClinent, FIONREAD, Longint(len));
        fillchar(recvBuf, sizeof(recvBuf), 0);
        recv(SClinent, recvBuf, sizeof(recvBuf), 0);

        Memo1.Lines.Add(string(recvBuf));
        Memo1.Lines.Add('read');
        if Memo1.Lines.Count > 10 then
          memo1.Clear;

        sleep(10);
        fillchar(SendBuf, sizeof(SendBuf), 0);
        Strcopy(@SendBuf, pansichar('OK'));
        Send(SClinent, sendbuf, sizeof(sendbuf), 0);
      end;

    FD_WRITE: begin


        Memo1.Lines.Add('write');
      end;
    FD_ACCEPT: begin
        len := sizeof(OldOpenType);

        if getsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE, PChar(@OldOpenType), len) = 0 then begin
          try
            len := sizeof(addr);
            SClinent := accept(s, @addr, @len);

            if SClinent = INVALID_SOCKET then begin
              Memo1.Lines.Add('无效的socket:' + inttostr(SClinent));
            end;
            Memo1.Lines.Add('accept');
          finally
            len := sizeof(OldOpenType);
            setsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE, PChar(@OldOpenType), len);
          end;
        end;
        WSAAsyncSelect(SClinent, handle, ASYNC_EVENT, $33);

      end;
    FD_CONNECT: begin
        Memo1.Lines.Add('connect');
      end;
    FD_CLOSE: begin
        Memo1.Lines.Add('close');
      end;
  end;
end;

end.
//由于服务器端没有缓存机制,所以多个client连接的时候,第二个client的socket会覆盖前一个的,大家看情况改改就行了,网络上大把代码都是用控件或者其他封装好d类来写d,所以资料郁闷死了.

 

 

客户端代码:

program Client;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  windows,
  winsock;

var
  addr: TSockAddrIn;
  wsa: TWSaData;
  flag: integer;
  s: TSocket;
  Host: string;
  Port: Word;
  BufSend: array[1..1024] of Ansichar; //中间信息
  BufRev: array[1..1024] of Ansichar;
  i: Integer;
begin
  { TODO -oUser -cConsole Main : Insert code here }

  Host := '127.0.0.1';
  port := 45531;

  flag := WSAStartup($0202, wsa); //加载winsock
  if flag <> 0 then begin
    Writeln(format('错误号:%d', [WSAGetLastError()]));
    Writeln('Winsock库加载失败');
  end else begin
    Writeln('Winsock库加载成功')
  end;

  //s := socket(AF_INET, SOCK_STREAM, IPPROTO_TCP); //服务器端的socket
  s := socket(PF_INET, SOCK_STREAM, 0);
  FillChar(addr, sizeof(addr), 0); //初始化地址空间

  addr.sin_port := htons(port);
  addr.sin_family := AF_INET;
  addr.sin_addr.S_addr := {INADDR_ANY; } inet_addr(pchar(host));

  if connect(s, addr, sizeof(addr)) = 0 then begin
    Writeln('主机:' + Host + ' 连接成功')
  end else begin
    Writeln('主机:' + Host + ' 连接失败');
  end;

  FillChar(BufSend, 1024, 0);

  StrPCopy(@BufSend, '测试信息包');
  for i := 0 to 100 do begin
    Writeln(inttostr(s));
    if Send(s, Bufsend, Length(BufSend), 0) <> SOCKET_ERROR then begin
      Writeln('消息已发送');
      sleep(500);

      FillChar(BufRev, 1024, 0);
      //strcopy(bufsend,pansichar('a'))
      if recv(s, BufRev, Length(BufSend), 0) <> SOCKET_ERROR then begin
        writeln('接收到的信息:' + trim(string(BufRev)));
      end else begin
        Writeln('接收消息失败!')
      end;

    end else begin
      Writeln('消息发送失败')
    end;
  end;

 

  if closeSocket(s) = 0 then begin
    Writeln('已经关闭socket')
  end else begin
    Writeln('关闭socket 出错')
  end;

  WSACleanup();
  Readln;
end.

posted on 2006-01-12 09:56 Khan 阅读(1423) 评论(0)  编辑 收藏 引用 所属分类: Delphi


只有注册用户登录后才能发表评论。
网站导航: 博客园   IT新闻   BlogJava   博问   Chat2DB   管理