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.

最新文章

  1. C#自定义工业控件开发
  2. 使用Autofac在MVC中实现IOC
  3. Java概述之从源码到运行
  4. ACM之Java速成(3)
  5. jsp、js、html等
  6. foreach遍历原理(一)
  7. Big Data Security Part One: Introducing PacketPig
  8. url参数中出现+、空格、=、%、&、#等字符的解决办法
  9. mybatis只能模糊查询英文不能查询中文
  10. iOS应用如何得知用户有新拍的图片?
  11. 中国IT史上两大严重事故对我们的警醒及预防措施
  12. FFmpeg开发实战(五):FFmpeg 抽取音视频的视频数据
  13. There are multiple modules with names that only differ in casing. 黄色warning
  14. redis quick start
  15. 构建BSP (boardsupport packet)
  16. 实现1sym转换成2个sym送给CVI(VGA数据)
  17. Apache修改了配置文件中的路径后,登录该地址网页出现问题 (其中介绍了selinux的域和安全上下文)
  18. android应用程序签名(转)
  19. SAP SD 顾问面试问题 consultant interview questionnaire
  20. B2B、B2C、C2C、O2O 和 P2P 的含义

热门文章

  1. 白话解释IIS并发连接数
  2. 2304: Lights Out(枚举)
  3. margin问题
  4. hrbustoj 1985(进制转换函数)
  5. HTML5 学习01
  6. HDU 2485 Destroying the bus stations
  7. [转]:如何使用Android Studio把自己的Android library分享到jCenter和Maven Central
  8. VS下载地址
  9. git diff 差异对比
  10. PHP 反射应用之一(插件框架)