类TListenSocket(我写的类似Borland Socket Service的类)[1]

{这是我根据borland socket service改写的类：tlistensocket, 它的功能是相当于："x:\program files\borland\delphi5\bin\scktsrvr.exe"。也是说它可以将你的分布式服务端程序变成一个有侦听功能的程序，有侦听，还有你的remote datamodule可以照样运行。写出来不久，如果有什么bug，请指出，谢谢。}

{本想把它做成控件方式的，现在不想去改动了。有需要再说，}

{

用法：

uses listensocket;

var socket:tlistensocket;

const listenport=8888;

socket:=tlistensocket.create(self);

socket.listenport:=listport;

socket.open;

//ok

}

unit listensocket;

interface

uses
  windows, messages, sysutils, classes, graphics, controls, forms, dialogs,
  sconnect,scktcomp,svcmgr, activex,midconst,winsock,myconst;

var 
    fclientthreads:tlist;
type
  tsocketdispatcherthread = class(tserverclientthread, isenddatablock)
  private
    frefcount: integer;
    finterpreter: tdatablockinterpreter;
    ftransport: itransport;
    flastactivity: tdatetime;
    ftimeout: tdatetime;
    fregisteredonly: boolean;
    procedure addclient;
    procedure removeclient;
  protected
    function createservertransport: itransport; virtual;
   { procedure addclient;
    procedure removeclient; }
    { iunknown }
    function queryinterface(const iid: tguid; out obj): hresult; stdcall;
    function _addref: integer; stdcall;
    function _release: integer; stdcall;
    { isenddatablock }
    function send(const data: idatablock; waitforresult: boolean): idatablock; stdcall;
  public
    constructor create(createsuspended: boolean; asocket: tserverclientwinsocket;
      const interceptguid: string; timeout: integer; registeredonly: boolean);
    procedure clientexecute; override;
  end;

type myserversocket=class(tserversocket)
  private
    procedure getthread(sender: tobject; clientsocket: tserverclientwinsocket;var socketthread: tserverclientthread);
  public
    constructor create(aowner: tcomponent); override;
end;

type
  tlistensocket = class(tobject)
  private
    factive:boolean;
    flistport :integer;
    fcachesize :integer;
    sh:myserversocket;
    fitemindex :integer;
    procedure setactivestate(value:boolean);
    function getclientcount :integer;
    { private declarations }
  public
    property cachesize :integer read fcachesize write fcachesize;
    property listport:integer read flistport write flistport;
    property active :boolean read factive write setactivestate;
    property clientcount:integer read getclientcount;
  public
    constructor create(aowner :tcomponent);
    destructor destroy;override;
    class procedure addclientthread(thread :tsocketdispatcherthread);
    class procedure removeclientthread(thread:tsocketdispatcherthread);
    procedure open;
    procedure close;
  end;

implementation

function tlistensocket.getclientcount :integer;
begin
  result:=fclientthreads.count;
end;

constructor tlistensocket.create(aowner :tcomponent);
begin
  loadwinsock2;
  factive:=false;
  fclientcount:=0;
  fcachesize :=10;
  fclientthreads:=tlist.create;
  sh:=myserversocket.create(nil);
  inherited create;
end;

destructor tlistensocket.destroy;
begin
  setactivestate(false);
  freeandnil(fclientthreahs);
  inherited destroy;
end;

procedure tlistensocket.open;
begin
  setactivestate(true);
end;

procedure tlistensocket.close;
begin
  setactivestate(false);
end;

class procedure tlistensocket.addclientthread(thread :tsocketdispatcherthread);
begin
  fclientthreads.add(thread);