Здравствуйте! Помогите с проблемой. Пытаюсь разобраться с библиотекой 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.
Инфы по теме очень не много, приходится методом тыка все проверять, нашел пару примеров использования, но они все по сети. Помогите модифицировать код или скиньте рабочий пример пожалуйста. Очень нужно!!! Времени в обрез.