在线程中调用winsock函数(API,注:连接,帧听等函数要方在线程外),不要用Delphi控件
解决方案 »
- photoshop或flash等程序的工具箱是怎么对子窗体操作的?
- Delphi中如何控制音量的大小和麦克风的大小啊!
- 如何能在DBGRID里面根据TITLE找到特定的那个列 并手动把数据加进去
- 救命!!关于word与olecontainer的问题,在线等待!!
- 现在哪里还有免费主页啊?国外的也可以,上传文件大于1M小于2M的就可以,本人急需!谢谢了!
- 给大家提供一个高速下载delphi6企业版的地方
- 请进,讨论一个问题,DELPHI究竟有没有葵花宝典和辟剑法,让人速成
- 有关with...do语句的问题,请高手Look.
- 如何在三层结构上把远处托管服务器上的数据库内容导入本地服务器的数据库上。
- 使用OpenCV查看IP摄像机视频的问题,大神请进
- TStringGrid的问题。
- 那有socket多线程的例子或者资料??
如果要自己写收发客户端发过来的数据,那要在ServerSocket1.OnGetThread 事件中写自己的TServerClientThread继承类。其它的忘了。呵呵
后台监听进程回发一个消息到主程序,主程序只要在onread事件中读取数据即可;
indy是delphi6中的组件,winshoes是它的前身.
SConnect.LoadWinSock2;type
TSocketThread = class(TThread)
private
FSocketHandle: THandle;
public
constructor Create(FSocketHandle: THandle);
procedure Execute; override;
end;constructor Create(FSocketHandle: THandle);
begin
FSocketHandle := FSocketHandle;
inherited Create(False);
end;procedure TSocketThread.Execute;
var
msg: TMsg;
Event: THandle;
begin
Event := WSACreateEvent;
WSAEventSelect(FSocketHandle, Event, False, FD_READ or FD_WRITE or FD_CLOSE);
PeekMessage(msg, 0, WM_USER, WM_USER, PM_NOREMOVE);
try
while not Terminated do
try
case MsgWaitForMultipleObjects(1, Event, False, INFINATE, QS_ALLINPUT) of
WAIT_OBJECT_0:
//客户端有消息,因为这只是个线程,不是TServerClientSocket,不知它是那个客户发过来的,而且读那些信息也很麻烦,如通知TMainForm中的ServerSocket 去读,如果有多个客户发来信息,那么会有同步的问题
WAIT_OBJECT_0 + 1:
//TMainForm发送给本线程的消息(PostThreadMessage())
while PeekMessage(msg, 0, 0, 0, PM_REMOVE) do
if (msg.hwnd=0) and (msg.message = WM_Terminate) then //ServerSocket.Active := False;
Terminate;
else
DispatchMessage(msg);
end;
except
Terminate;
end;
finally
WSACloseEvent(Event);
end;
end;
//WSACreateEvent, WSAEventSelect, WSACLoseEvent是SCOnnect.pas的函数指针,必须要调用LoadWinSock2初始化。当ServerSocket1.Active := True;
TSocketThread.Create(ServerSocket.Socket.SocketHandle);False://中止线程。
PostThreadMessage(FThread.ThreadID, WM_Terminate, 0,0);indy是delphi6控件
当ServerSocket1.Active := True;
而且当客户端连接时才行,侦听的是TServerSocket.Socket.Connection[I].SocketHandle;上面的程序不对了,我也不知怎么做了,呵
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.对你应该有用。