服务端代码:
unit RtcHttpServer; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ImgList, StdCtrls, ComCtrls, rtcInfo, rtcConn, rtcDataSrv, rtcHttpSrv, rtcFunction, rtcSrvModule; type TMsgType = (mtOK, mtHelp, mtErr); TrtcHttpServerDemo = class(TForm) RtcHttpServer1: TRtcHttpServer; ListView1: TListView; Button1: TButton; Button2: TButton; ImageList1: TImageList; RtcFunctionGroup1: TRtcFunctionGroup; RtcFunction1: TRtcFunction; RtcServerModule1: TRtcServerModule; procedure Button1Click(Sender: TObject); procedure RtcHttpServer1Connect(Sender: TRtcConnection); procedure RtcHttpServer1Connecting(Sender: TRtcConnection); procedure RtcHttpServer1Disconnect(Sender: TRtcConnection); procedure RtcHttpServer1ListenStart(Sender: TRtcConnection); procedure RtcHttpServer1SessionClose(Sender: TRtcConnection); procedure RtcHttpServer1SessionOpen(Sender: TRtcConnection); procedure RtcHttpServer1ListenLost(Sender: TRtcConnection); procedure RtcFunction1Execute(Sender: TRtcConnection; Param: TRtcFunctionInfo; Result: TRtcValue); private procedure LogEvent(msg: String; msgType: TMsgType); procedure LogClear; public { Public declarations } end; var rtcHttpServerDemo: TrtcHttpServerDemo; implementation {$R *.dfm} procedure TrtcHttpServerDemo.Button1Click(Sender: TObject); begin //开始监听 RtcHttpServer1.Listen(); end; procedure TrtcHttpServerDemo.LogClear; begin //清除事件列表 ListView1.Items.Clear; end; procedure TrtcHttpServerDemo.LogEvent(msg: String; msgType:TMsgType); var ltIco: TListItem; begin ltIco := ListView1.Items.Add; ltIco.SubItems.Add(msg); ltIco.SubItems.Add(DateTimeToStr(Now)); //设置图标 case msgType of mtOK: ltIco.StateIndex := 1; mtHelp: ltIco.StateIndex := 0; mtErr: ltIco.StateIndex := 2; end; ListView1.Scroll(10, 10); end; procedure TrtcHttpServerDemo.RtcFunction1Execute(Sender: TRtcConnection; Param: TRtcFunctionInfo; Result: TRtcValue); begin with Sender as TRtcDataServer do begin //请求名字 LogEvent('请求参数:' + Param.asString['name'], mtOK); Result.asString := 'Hello: ' + Param.asString['name']; end; end; procedure TrtcHttpServerDemo.RtcHttpServer1Connect(Sender: TRtcConnection); //连接事件 begin LogEvent('连接成功:客户端地址:' + Sender.PeerAddr + ',当前客户端连接数' + IntToStr(Sender.TotalConnectionCount), mtOK); end; procedure TrtcHttpServerDemo.RtcHttpServer1Connecting(Sender: TRtcConnection); begin LogEvent(Sender.sPeerAddr + '正在连接中...', mtOk); end; procedure TrtcHttpServerDemo.RtcHttpServer1Disconnect(Sender: TRtcConnection); begin LogEvent(Sender.sPeerAddr + '连接断开了... 当前客户端连接数' + IntToStr(Sender.TotalConnectionCount - 1), mtOk); end; procedure TrtcHttpServerDemo.RtcHttpServer1ListenLost(Sender: TRtcConnection); begin LogEvent('监听丢失:' + Sender.PeerAddr, mtErr); end; procedure TrtcHttpServerDemo.RtcHttpServer1ListenStart(Sender: TRtcConnection); begin LogClear; LogEvent('服务启动中',Mtok); end; procedure TrtcHttpServerDemo.RtcHttpServer1SessionClose(Sender: TRtcConnection); begin LogEvent('会话已关闭',MtErr); end; procedure TrtcHttpServerDemo.RtcHttpServer1SessionOpen(Sender: TRtcConnection); begin LogEvent('会话已成功连接',MtErr); end; end.
客户端代码:
unit RtcClient; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, rtcConn, rtcDataCli, rtcHttpCli, rtcInfo, rtcFunction, StdCtrls, ExtCtrls, ComCtrls, ImgList, rtcCliModule; type TMsgType = (mtOK, mtHelp, mtErr); TfrmRtcHttpClient = class(TForm) RtcFunction1: TRtcFunction; RtcHttpClient1: TRtcHttpClient; ListView1: TListView; Panel1: TPanel; Button1: TButton; ImageList1: TImageList; RtcClientModule1: TRtcClientModule; RtcFunctionGroup1: TRtcFunctionGroup; Button2: TButton; RtcResult1: TRtcResult; edit1: TEdit; procedure Button1Click(Sender: TObject); procedure RtcHttpClient1ConnectError(Sender: TRtcConnection; E: Exception); procedure RtcHttpClient1ConnectFail(Sender: TRtcConnection); procedure RtcFunction1Execute(Sender: TRtcConnection; Param: TRtcFunctionInfo; Result: TRtcValue); procedure edit1KeyPress(Sender: TObject; var Key: Char); procedure RtcResult1Return(Sender: TRtcConnection; Data, Result: TRtcValue); procedure RtcHttpClient1Connect(Sender: TRtcConnection); private procedure LogEvent(msg: String; msgType: TMsgType); procedure LogClear; public { Public declarations } end; var frmRtcHttpClient: TfrmRtcHttpClient; implementation {$R *.dfm} procedure TfrmRtcHttpClient.Button1Click(Sender: TObject); begin if RtcHttpClient1.isConnected or RtcHttpClient1.isConnecting then exit; RtcHttpClient1.Connect(); end; procedure TfrmRtcHttpClient.edit1KeyPress(Sender: TObject; var Key: Char); begin //发送请求 if key = #13 then begin with RtcClientModule1, Data do begin with NewFunction('SimpleTest') do begin asString['name'] := edit1.Text; Call(RtcResult1); end; end; end; end; procedure TfrmRtcHttpClient.LogClear; begin ListView1.Items.Clear; end; procedure TfrmRtcHttpClient.LogEvent(msg: String; msgType: TMsgType); var ltIco, ltEvent, ltDate: TListItem; begin ltIco := ListView1.Items.Add; ltIco.SubItems.Add(msg); ltIco.SubItems.Add(DateTimeToStr(Now)); //设置图标 case msgType of mtOK: ltIco.StateIndex := 1; mtHelp: ltIco.StateIndex := 0; mtErr: ltIco.StateIndex := 2; end; ListView1.Scroll(10, 10); end; procedure TfrmRtcHttpClient.RtcFunction1Execute(Sender: TRtcConnection; Param: TRtcFunctionInfo; Result: TRtcValue); begin Param.asString['name'] := 'pengshaomin'; LogEvent('服务器响应:' + Result.asString, mtOK); end; procedure TfrmRtcHttpClient.RtcHttpClient1Connect(Sender: TRtcConnection); begin LogEvent('连接服务器[' + Sender.sServerAddr +']成功', mtOK); end; procedure TfrmRtcHttpClient.RtcHttpClient1ConnectError(Sender: TRtcConnection; E: Exception); begin LogEvent('连接服务器[' + Sender.sServerAddr +']错误', mtErr); end; procedure TfrmRtcHttpClient.RtcHttpClient1ConnectFail(Sender: TRtcConnection); begin LogEvent('连接服务器[' + Sender.sServerAddr +']失败', mtErr); end; procedure TfrmRtcHttpClient.RtcResult1Return(Sender: TRtcConnection; Data, Result: TRtcValue); begin with Sender as TRtcDataClient do begin LogEvent( (Sender as TRtcDataClient).sServerAddr + '服务器:' + Result.asString, mtOK); end; end; end.
http://www.cnblogs.com/pengshaomin/archive/2012/10/10/2718579.html