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
ShowMessageInMainthread('REQUEST: ' + aArgument[0].AsJSon);
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);
if aCallback <> nil then
aCallback.SendResponse('thank for the push!');
end);
client.Connect;
client.SocketIO.Emit(C_CLIENT_EVENT, SO([ 'request', 'some data']),
procedure(const ASocket: ISocketIOContext; const aJSON: ISuperObject; const aCallback: ISocketIOCallback)
begin
ShowMessageInMainthread('RESPONSE: ' + aJSON.AsJSon);
end);
WorkT.Interval := 5 * 1000;
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;
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;
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;
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.
28.04.2019, 14:13
WeBSockets Клиент - Сервер Делфи не соединяется по Интернету
Линейный вид
