在线时间:8:00-16:00
迪恩网络APP
随时随地掌握行业动态
扫描二维码
关注迪恩网络微信公众号
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.
|
2023-10-27
2022-08-15
2022-08-17
2022-09-23
2022-08-13
请发表评论