Форум по программированию Delphi Sources

 



Вернуться   Форум по программированию Delphi Sources > Все о Delphi > Интернет и сети
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 28.04.2019, 14:13
lexx_rus lexx_rus вне форума
Прохожий
 
Регистрация: 28.04.2019
Сообщения: 1
Версия Delphi: DX 10 Seattle
Репутация: 10
Восклицание 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.



Инфы по теме очень не много, приходится методом тыка все проверять, нашел пару примеров использования, но они все по сети. Помогите модифицировать код или скиньте рабочий пример пожалуйста. Очень нужно!!! Времени в обрез.
Ответить с цитированием
Ответ



Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 00:26.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources", 2004-2019

ВКонтакте   Facebook   Twitter