|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#1
|
|||
|
|||
WeBSockets Клиент - Сервер Делфи не соединяется по Интернету
Здравствуйте! Помогите с проблемой. Пытаюсь разобраться с библиотекой WEBSockets, TidWEBHTTPClient и TidWEBServer, использую эти компоненты для обмена данными. Программа умеет соединять ся по сети и отправлять текстовую информацию и картинки. Но когда пытаюсь подключиться к серверу через интернет. выдает ошибку Connect time out.
Код:
uses BaseUnit; var server: TIdWebsocketServer; client: TIdHTTPWebsocketClient; const C_CLIENT_EVENT = 'CLIENT_TO_SERVER_EVENT_TEST'; C_SERVER_EVENT = 'SERVER_TO_CLIENT_EVENT_TEST'; procedure ShowMessageInMainthread(const aMsg: string) ; begin TThread.Synchronize(nil, procedure begin form1.logServer.Lines.Add(datetimetostr(date)+':'+timetostr(time)+' '+aMsg); end); end; procedure TForm1.Button1Click(Sender: TObject); begin server := TIdWebsocketServer.Create(Self); server.DefaultPort := 12345; server.SocketIO.OnEvent(C_CLIENT_EVENT, procedure(const ASocket: ISocketIOContext; const aArgument: TSuperArray; const aCallback: ISocketIOCallback) begin //show request (threadsafe) ShowMessageInMainthread('REQUEST: ' + aArgument[0].AsJSon); //send callback (only if specified!) if aCallback <> nil then aCallback.SendResponse( SO(['succes', True]).AsJSon ); end); server.Active := True; client := TIdHTTPWebsocketClient.Create(Self); client.Port := 12345; client.Host := 'localhost'; client.SocketIOCompatible := True; client.SocketIO.OnEvent(C_SERVER_EVENT, procedure(const ASocket: ISocketIOContext; const aArgument: TSuperArray; const aCallback: ISocketIOCallback) begin ShowMessageInMainthread('Data PUSHED from server: ' + aArgument[0].AsJSon); //server wants a response? if aCallback <> nil then aCallback.SendResponse('thank for the push!'); end); client.Connect; client.SocketIO.Emit(C_CLIENT_EVENT, SO([ 'request', 'some data']), //provide callback procedure(const ASocket: ISocketIOContext; const aJSON: ISuperObject; const aCallback: ISocketIOCallback) begin //show response (threadsafe) ShowMessageInMainthread('RESPONSE: ' + aJSON.AsJSon); end); //start timer so server pushes (!) data to all clients WorkT.Interval := 5 * 1000; //5s // Timer1.Enabled := True; end; procedure TForm1.Button2Click(Sender: TObject); var strm:tmemorystream; s:string; begin if not assigned(client) then begin client := TIdHTTPWebsocketClient.Create(Self); client.Port := 8585; client.OnBinData := ClientBinDataReceived; end; client.Host := IpEdit.Text; case RG1.ItemIndex of 0:begin if not client.CheckConnection then begin client.Connect; client.UpgradeToWebsocket; client.IOHandler.Write('Connection is Active'); end; end; 1:begin client.SocketIOCompatible := False; //client.UpgradeToWebsocket; strm := TMemoryStream.Create; try client.Get('http://'+client.Host+':8585/index.html', strm); with TStreamReader.Create(strm) do begin strm.Position := 0; s := ReadToEnd; Free; end; showmessage(s); finally strm.Free; end; end; end; StatusT.Tag:=0; end; procedure TForm1.Button3Click(Sender: TObject); var a:integer; e_r:Tmyerrors; begin try if client.CheckConnection then client.IOHandler.Write('Disconnect') else exit; maxwait(7); client.Disconnect(true); client.ResetChannel; except e_r.TypeofErr:=ERP_TCP; E_R.ErrIndex:=1; errorhandle(e_r); end; end; procedure TForm1.Button4Click(Sender: TObject); begin WorkT.Enabled:=not WorkT.Enabled; end; procedure TForm1.ClientBinDataReceived(const aData: TStream); begin // end; procedure TForm1.HandleHTTPServerCommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo); var sfile: string; begin if ARequestInfo.Document = '/index.html' then AResponseInfo.ContentText := 'dummy index.html' else begin sfile := ExtractFilePath(Application.ExeName) + ARequestInfo.Document; if FileExists(sfile) then AResponseInfo.ContentStream := TFileStream.Create(sfile, fmOpenRead); end; end; procedure TForm1.SerButtonClick(Sender: TObject); begin if not assigned(server) then begin server := TIdWebsocketServer.Create(Self); server.DefaultPort := 8585; server.OnMessageText := ServerMessageTextReceived; server.OnMessageBin:=ServerdataMessage; server.OnCommandGet:=HandleHTTPServerCommandGet; server.KeepAlive:=true; end; server.Active := not server.Active; if server.Active then logserver.Lines.Add(datetimetostr(date)+' : Server is STARTED') else logserver.Lines.Add(datetimetostr(date)+' : Server is STOPPED') end; procedure TForm1.ServerDataMessage(const AContext: TIDServerWSContext; const Adata: TStream); var jpg:TjpegImage; begin try TThread.Synchronize(nil, procedure begin jpg:=tJpegImage.Create; image1.Stretch:=true; Adata.Position:=0; //Showmessage(inttostr(adata.Size)); if Adata.Size>0 then begin jpg.LoadFromStream(Adata); image1.Picture.Bitmap.Assign(jpg); end; end); finally if assigned(jpg) then jpg.Free; end; end; procedure TForm1.ServerMessageTextReceived(const AContext: TIdServerWSContext; const aText: string); var strm: TStringStream; begin ShowMessageInMainthread('Client: '+Acontext.Connection.Socket.Binding.PeerIP+' Get text:'+#10#13+ aText); strm := TStringStream.Create('SERVER: ' + aText); AContext.IOHandler.Write(strm, wdtBinary); end; procedure TForm1.StatusTTimer(Sender: TObject); begin StatusT.Enabled:=false; if assigned(client) then if client.CheckConnection then begin Label1.Font.Color:=clgreen; label1.Caption:='Client Connected'; end else begin Label1.Font.Color:=clred; label1.Caption:='Client Disconnected'; if StatusT.Tag<=0 then begin if application.MessageBox('Connection closed! Reconnect?','Error',mb_yesNO+mb_iconquestion)=6 then button2.Click else StatusT.Tag:=1; end; end; StatusT.Enabled:=true; end; procedure TForm1.WorkTTimer(Sender: TObject); var jpg:TjpegImage; Js:TmemoryStream; begin WorkT.Enabled := false; {server.SocketIO.EmitEventToAll(C_SERVER_EVENT, SO(['data', 'pushed from server']), procedure(const ASocket: ISocketIOContext; const aJSON: ISuperObject; const aCallback: ISocketIOCallback) begin //show response (threadsafe) TThread.Synchronize(nil, procedure begin ShowMessage('RESPONSE from a client: ' + aJSON.AsJSon); end); end); } try jpg:=getScreenJpg; Js:=TmemoryStream.create; jpg.SaveToStream(js); if (assigned(client)) and (Client.Connected) then client.IOHandler.Write(js,wdtBinary); workT.Enabled:=true; finally if assigned(jpg) then jpg.Free; if assigned(Js) then js.Free; end; end; procedure TForm1.WriteMesbuttonClick(Sender: TObject); begin if assigned(Client) then if client.Connected then begin Client.IOHandler.Write(Edit1.Text); end; end; end. В общем не подключается никак. порты в роутере пробросил. ip посмотрел на myip.ru. Инфы по теме очень не много, приходится методом тыка все проверять, нашел пару примеров использования, но они все по сети. Помогите модифицировать код или скиньте рабочий пример пожалуйста. Очень нужно!!! Времени в обрез. |