文章/答案/技术大牛

发布

社区首页 >问答首页 >基于delphi的多线程服务器套接字xe5

问基于delphi的多线程服务器套接字xe5
EN

Stack Overflow用户

提问于 2013-12-15 02:30:56

回答 2查看 3.2K关注 0票数 1

如何使多线程套接字与事件(onread，onconnect，.)为；

unit Unit1;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.StdCtrls,
  androidapi.JNI.JavaTypes, FMX.Layouts, FMX.Memo, IdBaseComponent, IdThreadComponent,
  Android.Soket;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    th: TIdThreadComponent;
    procedure Button1Click(Sender: TObject);
    procedure thRun(Sender: TIdThreadComponent);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  serversoket:JServerSoket;
  client:JSoket;
  output:JoutStream;
  input :JinStream;

implementation

{$R *.fmx}

procedure TForm1.Button1Click(Sender: TObject);
begin
  try
    serversoket:=TJServerSoket.JavaClass.init(8090);
    memo1.Lines.Add('listen, only 1 client');
  except
    on E:Exception do memo1.Lines.Add('Cant open port: '+E.Message);

  end;
  th.Active:=true;
  th.Start;
end;

procedure TForm1.thRun(Sender: TIdThreadComponent);
var msg:string;
begin
  client  :=serversoket.accept;
  if client.isConnected then
  begin
    if client.getInputStream.available>-1 then
    begin
      input:=tjinstream.JavaClass.init(client.getInputStream);
      output:=tJoutStream.JavaClass.init(client.getOutputStream)  ;
    end;
    while true do
     begin
      msg:=jstringtostring(input.readline);
      memo1.Lines.Add('Read: '+ msg );
      output.writeUTF(stringtojstring('msg: '+msg ) );
      memo1.Lines.Add('Write!' );
      output.flush;
     end;
  end;
end;

end.

用于delphi的android服务器socket api ( :P )；

unit Android.Soket;

interface

uses  Androidapi.JNIBridge, Androidapi.Jni,  androidapi.JNI.JavaTypes, androidapi.JNI.Net,
      Androidapi.JNI.Os, FMX.Helpers.Android, Androidapi.JNI.GraphicsContentViewText,System.SysUtils,
      System.Types, System.UITypes, System.Classes, System.Variants,FMX.Memo;


type

  ////////////////////////////soket/////////////////////////////


  [javaSignature('java/net/InetAddress')]
  JAdres=interface(JObject)
  ['{7A525333-38BC-4D2A-8160-D164D1CAA30E}']
    function getHostName:Jstring;cdecl;
    property Host:Jstring read getHostName;
  end;

  JAdresClass=interface(JObjectClass)
  ['{B34C47C9-7FC8-4120-B087-60F517A9323D}']
  end;
  TJAdres = class(TJavaGenericImport<JAdresClass, JAdres>) end;


 ////////////////out buffer////////////////////


  [javaSignature('java/io/OutputStream')]
  Jout=interface(jobject)
    ['{AC9EEC99-FF3A-46E4-AFC3-C4D3309D8C8E}']
  end;
  JoutClass = interface(JObjectClass)
    ['{46FBBEEE-22C7-45EA-BED3-A41BED01E500}']
    end;
  TJout = class(TJavaGenericImport<JoutClass, Jout>) end;

  [javaSignature('java/io/DataOutputStream')]
  JoutStream=interface(jobject)
    ['{A6421CC3-B76C-4124-AB2E-AEE0C4749E71}']
    procedure write(buffer:TJavaArray<byte>;offset,count:integer);cdecl;overload;
    procedure write(buffer:TJavaArray<byte>);cdecl;overload;
    procedure write(buffer:byte);cdecl;overload;
    procedure writeChars(str:jstring);cdecl;
    procedure writeUTF(str:jstring);cdecl;
    procedure close;cdecl;
    procedure flush;cdecl;
  end;
  JoutStreamClass = interface(JObjectClass)
    ['{83D69F8F-8833-4EF5-B00D-2EA45F58AC46}']
    function init(obj:Jout):JoutStream; cdecl;overload;//Deprecated
  end;
  TJoutStream = class(TJavaGenericImport<JoutStreamClass, JoutStream>) end;
  ///////////////////////input buffer/////////////////

  [javaSignature('java/io/InputStream')]
  Jin=interface(jobject)
    ['{50F3A57E-7E09-4727-954C-34298755D5ED}']
    function read(buffer:TJavaArray<byte>;offset:integer;count:integer):integer;cdecl;overload;
    function read(buffer:TJavaArray<byte>):integer;cdecl;overload;
    function read():integer;cdecl;overload;
    function available():integer;cdecl;
    procedure close;cdecl;
    procedure reset;cdecl;
  end;
  JinClass = interface(JObjectClass)
    ['{91C1D3F0-30FD-4961-9560-1B9045DBAC3B}']
    function init():Jin; cdecl;overload;//Deprecated
  end;
  TJin = class(TJavaGenericImport<JinClass, Jin>) end;
  /////////////////////////////////////////////////////
  [javaSignature('java/io/DataInputStream')]
  JinStream=interface(jobject)
  ['{839ACAEC-229A-4261-88B4-136173B6FCBF}']
    function available():integer;cdecl;
    function read(buffer:TJavaObjectArray<byte>;offset,count:integer):integer;cdecl;overload;
    function read(buffer:TJavaObjectArray<byte>):integer;cdecl;overload;
    function read():integer;cdecl;overload;
    function readUTF():jstring;cdecl;
    function readLine():jstring;cdecl;
    procedure close;cdecl;
    procedure reset;cdecl;
  end;
  JinStreamClass = interface(JObjectClass)
  ['{27B4071A-5BC8-4594-A701-DBB92DBEE45A}']
    function init(obj:Jin):JinStream; cdecl;overload;
  end;
  TJinStream = class(TJavaGenericImport<JinStreamClass, JinStream>) end;

 ////////////////client socket////////////////////
  [javaSignature('java/net/Socket')]
  JSoket=interface(jobject)
  ['{A8A35BE7-5562-44C5-B599-40B76AD30116}']
    procedure close;cdecl;
    function getOutputStream:Jout;cdecl;
    function getInputStream:Jin;cdecl;
    function isConnected:boolean;cdecl;


  end;

  JSoketClass = interface(JObjectClass)
  ['{E66CE6BA-9E0E-4ED0-A4B7-D683C8AB3597}']
    function init:JSoket;cdecl;
  end;
  TJSoket = class(TJavaGenericImport<JSoketClass, JSoket>) end;

////////////////server socket//////////////////////////

  [javaSignature('java/net/ServerSocket')]
  JServerSoket=interface(jobject)
    ['{56C0FCBB-AE14-4DCE-9E06-9CCC2DB73C5B}']
    function getLocalPort:integer;cdecl;
    procedure bind(localAddr:integer);cdecl;
    procedure close;cdecl;
    function getInetAddress:JAdres;cdecl;
    function accept():JSoket;cdecl;

    property Port: Integer read getLocalPort;
    property iNetAdres: JAdres read getInetAddress;


  end;

  JServerSoketClass = interface(JObjectClass)
  ['{8A35BED3-B8BB-4069-BEB9-2D859F6F74C1}']
    function init(port:integer):JServerSoket;
  end;
  TJServerSoket = class(TJavaGenericImport<JServerSoketClass, JServerSoket>) end;

implementation

end.

(这些代码可以读写！)屏幕图像；https://drive.google.com/file/d/0BxODt2IJsmR8ZktjNzF5VllzekE/edit?usp=sharing

android

delphi

serversocket

回答 2

Stack Overflow用户

回答已采纳

发布于 2013-12-15 21:09:35

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    th: TIdThreadComponent;
    th2: TIdThreadComponent; //for 2. client.
    procedure Button1Click(Sender: TObject);
    procedure thRun(Sender: TIdThreadComponent);
    procedure th2Run(Sender: TIdThreadComponent);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
......

procedure TForm1.thRun(Sender: TIdThreadComponent);
var msg:string;
  client:JSoket;
  input :JinStream;
  output:JoutStream;
begin
  client  :=serversoket.accept;
  if client.isConnected then
  begin
    if client.getInputStream.available>-1 then
    begin
      input:=tjinstream.JavaClass.init(client.getInputStream);
      output:=tJoutStream.JavaClass.init(client.getOutputStream)  ;
      ////////////////////////////////////////////////////////////
      th2.Active:=true;//2. thread start if 1. client connected!
      th2.Start;
      ////////////////////////////////////////////////////////////
    end;
    while true do
     begin
      msg:=jstringtostring(input.readline);
      memo1.Lines.Add('Read: '+ msg );
      output.writeUTF(stringtojstring('msg: '+msg ) );
      memo1.Lines.Add('Write!' );
      output.flush;
     end;
  end;
end;

......
procedure TForm1.th2Run(Sender: TIdThreadComponent);
var msg:string;
  client:JSoket;
  input :JinStream;
  output:JoutStream;
begin
  client  :=serversoket.accept;
  if client.isConnected then
  begin
    if client.getInputStream.available>-1 then
    begin
      input:=tjinstream.JavaClass.init(client.getInputStream);
      output:=tJoutStream.JavaClass.init(client.getOutputStream)  ;
     //if more client....
    end;
    while true do
     begin
      msg:=jstringtostring(input.readline);
      memo1.Lines.Add('Read2: '+ msg );
      output.writeUTF(stringtojstring('msg2: '+msg ) );
      memo1.Lines.Add('Write2!' );
      output.flush;
     end;
  end;
end;
........

屏幕图像：https://drive.google.com/file/d/0BxODt2IJsmR8WVEzTUh3NXJtcjA/edit?usp=sharing

这些密码有效。我试过了。我在等待答复/评论。非常感谢你，特别是@RemyLebeau

票数 0

Stack Overflow用户

发布于 2013-12-15 17:28:59

TIdThreadComponent是Indy的一个组件，它有自己的TIdTCPServer多线程组件。您应该使用TIdTCPServer而不是TJServerSocket，后者是一个由Delphi的JNI桥层包装的Java类，因此它不会在CPU上“本机”运行。TIdTCPServer这样做，就像Delphi /FMX框架的其他部分一样。

uses
  ..., IdTCPServer, IdContext;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    IdTCPServer1: TIdTCPServer;
    procedure Button1Click(Sender: TObject);
    procedure IdTCPServer1Connect(AContext: TIdContext);
    procedure IdTCPServer1Disconnect(AContext: TIdContext);
    procedure IdTCPServer1Execute(AContext: TIdContext);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  IdTCPServer1.DefaultPort := 8090;
  try
    IdTCPServer1.Active := True;
    memo1.Lines.Add('listening');
  except
    on E: Exception do memo1.Lines.Add('Cant open port: '+E.Message);
  end;
end;

procedure TForm1.IdTCPServer1Connect(AContext: TIdContext);
begin
  TThread.Synchronize(nil,
    procedure
    begin
      memo1.Lines.Add('connected');
    end
  );
end;

procedure TForm1.IdTCPServer1Disconnect(AContext: TIdContext);
begin
  TThread.Synchronize(nil,
    procedure
    begin
      memo1.Lines.Add('disconnected');
    end
  );
end;

procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var
  msg: string;
begin
  msg := AContext.Connection.IOHandler.ReadLn;
  TThread.Synchronize(nil,
    procedure
    begin
      memo1.Lines.Add('Read: '+ msg );
    end
  );
  AContext.Connection.IOHandler.Write('msg: '+msg, IndyTextEncoding_UTF8);
  TThread.Synchronize(nil,
    procedure
    begin
      memo1.Lines.Add('Write!');
    end
  );
end;

票数 1

页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持

原文链接：

https://stackoverflow.com/questions/20590602

复制

相似问题

问基于delphi的多线程服务器套接字xe5
EN

回答 2

Stack Overflow用户

Stack Overflow用户

社区

活动

圈层

关于

腾讯云开发者

热门产品

热门推荐

更多推荐

问基于delphi的多线程服务器套接字xe5EN

回答 2

Stack Overflow用户

Stack Overflow用户

社区

活动

圈层

关于

腾讯云开发者

热门产品

热门推荐

更多推荐

问基于delphi的多线程服务器套接字xe5
EN