谁能提供一个socket阻塞线程通讯的例子看一看?拜托?

妞妞的粑粑 2002-02-27 04:32:37
每个客户链接是产生一个新线程,问新线程怎么和clientsocket通讯?
...全文
45 1 打赏 收藏 转发到动态 举报
写回复
用AI写文章
1 条回复
切换为时间正序
请发表友善的回复…
发表回复
dwind 2002-03-12
  • 打赏
  • 举报
回复
Unit main;

Interface

Uses
Windows, SysUtils, Messages, Classes, Forms, ScktComp, Controls, StdCtrls,
Menus, Mask, Spin, ComCtrls, ExtCtrls;

Const
CM_IncCount = WM_USER + 1;

Type
TForm1 = Class(TForm)
ServerSocket: TServerSocket;
MainMenu: TMainMenu;
File1: TMenuItem;
ActiveItem: TMenuItem;
N1: TMenuItem;
Exit1: TMenuItem;
Panel1: TPanel;
Label1: TLabel;
CacheEdit: TSpinEdit;
Label2: TLabel;
PortEdit: TSpinEdit;
Label3: TLabel;
ThreadCount: TEdit;
Panel2: TPanel;
ListBox1: TListBox;
Panel3: TPanel;
StatusBar1: TStatusBar;
CharCount: TLabel;
Procedure ServerSocketGetThread(Sender: TObject;
ClientSocket: TServerClientWinSocket;
Var SocketThread: TServerClientThread);
Procedure FormCreate(Sender: TObject);
Procedure FormClose(Sender: TObject; Var Action: TCloseAction);
Procedure Exit1Click(Sender: TObject);
Procedure PortEditChange(Sender: TObject);
Procedure ActiveItemClick(Sender: TObject);
Procedure ServerSocketThreadEnd(Sender: TObject;
Thread: TServerClientThread);
Procedure ServerSocketThreadStart(Sender: TObject;
Thread: TServerClientThread);
Procedure CacheEditChange(Sender: TObject);
protected
Procedure CMIncCount(Var Msg: TMessage); message CM_IncCount;
public
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;
RecText: String;
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;
End;

Procedure TForm1.ServerSocketGetThread(Sender: TObject;
ClientSocket: TServerClientWinSocket;
Var SocketThread: TServerClientThread);
Begin
// Create a new thread for connection
SocketThread := TFileServerThread.Create(False, ClientSocket);
ClientSocket.SendText('Welcome to Server'+#13#10);
End;

Procedure TForm1.FormCreate(Sender: TObject);
Begin
CacheEdit.Value := ServerSocket.ThreadCacheSize;
PortEdit.Value := ServerSocket.Port;
CharCount.Caption := '0';
ActiveItemClick(Nil);
End;

Procedure TForm1.FormClose(Sender: TObject; Var Action: TCloseAction);
Begin
ServerSocket.Close;
End;

Procedure TForm1.CMIncCount(Var Msg: TMessage);
Begin
CharCount.Caption := IntToStr(StrToInt(CharCount.Caption) + 1);
End;

Procedure TForm1.Exit1Click(Sender: TObject);
Begin
Close;
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.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;

End.

////////////////////
object Form1: TForm1
Left = 720
Top = 130
Width = 399
Height = 262
Caption = 'Server'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
Menu = MainMenu
OldCreateOrder = True
OnClose = FormClose
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object Panel1: TPanel
Left = 0
Top = 0
Width = 120
Height = 197
Align = alLeft
BevelOuter = bvNone
TabOrder = 0
object Label1: TLabel
Left = 8
Top = 5
Width = 94
Height = 13
Caption = 'Thread Cache Size:'
end
object Label2: TLabel
Left = 10
Top = 50
Width = 22
Height = 13
Caption = 'Port:'
end
object Label3: TLabel
Left = 10
Top = 91
Width = 65
Height = 13
Caption = 'Thread Count'
end
object CacheEdit: TSpinEdit
Left = 9
Top = 22
Width = 61
Height = 22
MaxValue = 20
MinValue = -1
TabOrder = 0
Value = 0
OnChange = CacheEditChange
end
object PortEdit: TSpinEdit
Left = 8
Top = 64
Width = 60
Height = 22
MaxLength = 4
MaxValue = 9000
MinValue = 1
TabOrder = 1
Value = 1
OnChange = PortEditChange
end
object ThreadCount: TEdit
Left = 8
Top = 107
Width = 62
Height = 21
Color = clBtnFace
ReadOnly = True
TabOrder = 2
Text = '0'
end
end
object Panel2: TPanel
Left = 120
Top = 0
Width = 271
Height = 197
Align = alClient
BevelOuter = bvNone
Caption = 'Panel2'
TabOrder = 1
object ListBox1: TListBox
Left = 0
Top = 21
Width = 271
Height = 176
Align = alClient
ItemHeight = 13
TabOrder = 0
end
object Panel3: TPanel
Left = 0
Top = 0
Width = 271
Height = 21
Align = alTop
Alignment = taLeftJustify
BevelOuter = bvNone
Caption = 'Chars Sent:'
TabOrder = 1
object CharCount: TLabel
Left = 55
Top = 4
Width = 50
Height = 13
Caption = 'CharCount'
end
end
end
object StatusBar1: TStatusBar
Left = 0
Top = 197
Width = 391
Height = 19
Panels = <>
SimplePanel = True
end
object ServerSocket: TServerSocket
Active = False
Port = 1024
ServerType = stThreadBlocking
OnGetThread = ServerSocketGetThread
OnThreadStart = ServerSocketThreadStart
OnThreadEnd = ServerSocketThreadEnd
Left = 315
Top = 1
end
object MainMenu: TMainMenu
Left = 350
Top = 1
object File1: TMenuItem
Caption = '&Server'
object ActiveItem: TMenuItem
Caption = '&Active'
OnClick = ActiveItemClick
end
object N1: TMenuItem
Caption = '-'
end
object Exit1: TMenuItem
Caption = 'E&xit'
OnClick = Exit1Click
end
end
end
end

////////////////////////////

program server;

uses
Forms,
main in 'main.pas' {Form1};

{$R *.RES}

begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

对你应该有用。

828

社区成员

发帖
与我相关
我的任务
社区描述
Delphi 非技术区
社区管理员
  • 非技术区社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧