• 设为首页
  • 点击收藏
  • 手机版
    手机扫一扫访问
    迪恩网络手机版
  • 关注官方公众号
    微信扫一扫关注
    迪恩网络公众号

delphiTServerSocket的多线程

原作者: [db:作者] 来自: [db:来源] 收藏 邀请

 

http://blog.sina.com.cn/s/blog_471218c2010001qc.html

 

 

unit U_dxc;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Spin, ScktComp, ComCtrls, Menus, activex;
const
  CM_IncCount = WM_USER + 1;
    
type
  TForm1 = class(TForm)
    ServerSocket: TServerSocket;
    CacheEdit: TSpinEdit;
    PortEdit: TSpinEdit;
    ThreadCount: TEdit;
    Memo1: TMemo;
    MainMenu: TMainMenu;
    File1: TMenuItem;
    ActiveItem: TMenuItem;
    N1: TMenuItem;
    Exit1: TMenuItem;
    StatusBar1: TStatusBar;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    procedure ServerSocketClientError(Sender: TObject;
      Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
      var ErrorCode: Integer);
    procedure ServerSocketGetThread(Sender: TObject;
      ClientSocket: TServerClientWinSocket;
      var SocketThread: TServerClientThread);
    procedure ServerSocketThreadEnd(Sender: TObject;
      Thread: TServerClientThread);
    procedure ServerSocketThreadStart(Sender: TObject;
      Thread: TServerClientThread);
    procedure CacheEditChange(Sender: TObject);
    procedure PortEditChange(Sender: TObject);
    procedure ActiveItemClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Exit1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
  
{ TFileServerThread }
  TFileServerThread = class(TServerClientThread)
  public
    procedure ClientExecute; override;
  end;
var
  Form1: TForm1;
implementation
{$R *.dfm}
{ TFileServerThread }
procedure TFileServerThread.ClientExecute;
var
  Data : array[0..1023] of char;
  aa0, aa1 : string;
  RecText : string;
  //cd : integer;
  SocketStream : TWinSocketStream;
begin
  While Not Terminated And ClientSocket.Connected Do
  Try
    SocketStream := TWinSocketStream.Create(ClientSocket, 30000);
    Try
      FillChar(Data, SizeOf(Data), 0);
      If SocketStream.Read(Data, SizeOf(Data)) = 0 Then
      Begin
        // If we didn't get any data after xx seconds then close the connection
        ClientSocket.SendText('Timeout on Server'+#13#10);
        //Wait a little time to allow sending of text before disconnect
        sleep(1);
        ClientSocket.Close;
        Terminate;
      End;
      RecText := Data;
      If Length(RecText) > 2 Then
        Delete(RecText, Pos(#13#10, RecText), 2); // Delete #13#10
      If ClientSocket.Connected Then
      Begin
        ClientSocket.SendText(RecText);
        SendMessage(Form1.Listbox1.Handle, LB_ADDSTRING, 0, Integer(PChar(RecText)));
        PostMessage(Form1.Handle, CM_INCCOUNT, 0, 0);
      End;
    Finally
      SocketStream.Free;
    End;
  Except
    HandleException;
  End;  While Not Terminated And ClientSocket.Connected Do
  Try
    SocketStream := TWinSocketStream.Create(ClientSocket, 30000);
    Try
      FillChar(Data, SizeOf(Data), 0);
      If SocketStream.Read(Data, SizeOf(Data)) = 0 Then
      Begin
        // If we didn't get any data after xx seconds then close the connection
        ClientSocket.SendText('Timeout on Server'+#13#10);
        //Wait a little time to allow sending of text before disconnect
        sleep(1);
        ClientSocket.Close;
        Terminate;
      End;
      RecText := Data;
      If Length(RecText) > 2 Then
        Delete(RecText, Pos(#13#10, RecText), 2); // Delete #13#10
      If ClientSocket.Connected Then
      Begin
        ClientSocket.SendText(RecText);
        SendMessage(Form1.Listbox1.Handle, LB_ADDSTRING, 0, Integer(PChar(RecText)));
        PostMessage(Form1.Handle, CM_INCCOUNT, 0, 0);
      End;
    Finally
      SocketStream.Free;
    End;
  Except
    HandleException;
  End;
end;
procedure TForm1.ServerSocketClientError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
  errorcode := 0;
  ThreadCount.Text := IntToStr(StrToInt(ThreadCount.Text) - 1);
end;
procedure TForm1.ServerSocketGetThread(Sender: TObject;
  ClientSocket: TServerClientWinSocket;
  var SocketThread: TServerClientThread);
begin
  SocketThread := TFileServerThread.Create(False, ClientSocket);
end;
procedure TForm1.ServerSocketThreadEnd(Sender: TObject;
  Thread: TServerClientThread);
begin
  ThreadCount.Text := IntToStr(StrToInt(ThreadCount.Text) - 1);
end;
procedure TForm1.ServerSocketThreadStart(Sender: TObject;
  Thread: TServerClientThread);
begin
  ThreadCount.Text := IntToStr(StrToInt(ThreadCount.Text) + 1);
end;
procedure TForm1.CacheEditChange(Sender: TObject);
begin
  ServerSocket.ThreadCacheSize := CacheEdit.Value;
end;
procedure TForm1.PortEditChange(Sender: TObject);
begin
  ServerSocket.Port := StrToInt(PortEdit.Text);
end;
procedure TForm1.ActiveItemClick(Sender: TObject);
begin
  ServerSocket.Active := not ServerSocket.Active;
  ActiveItem.Checked := ServerSocket.Active;
  if ServerSocket.Active then
    StatusBar1.SimpleText := 'Active'
  else
    StatusBar1.SimpleText := 'InActive';
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
  CacheEdit.Value := ServerSocket.ThreadCacheSize;
  PortEdit.Value := ServerSocket.Port;
  ActiveItemClick(nil);
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  ServerSocket.Close;
end;
procedure TForm1.Exit1Click(Sender: TObject);
begin
  Close;
end;
end.

鲜花

握手

雷人

路过

鸡蛋
该文章已有0人参与评论

请发表评论

全部评论

专题导读
上一篇:
在delphi7里怎么给已有的单元文件改名发布时间:2022-07-18
下一篇:
delphistring.split按照任意字符串分割语句发布时间:2022-07-18
热门推荐
阅读排行榜

扫描微信二维码

查看手机版网站

随时了解更新最新资讯

139-2527-9053

在线客服(服务时间 9:00~18:00)

在线QQ客服
地址:深圳市南山区西丽大学城创智工业园
电邮:jeky_zhao#qq.com
移动电话:139-2527-9053

Powered by 互联科技 X3.4© 2001-2213 极客世界.|Sitemap