Pues con RTC (gran parte fue copiando de los ejemplos):
procedure TfrmMain.remHomeCheckRequest(Sender: TRtcConnection);
begin
with TRtcDataServer(Sender) do
begin
if Request.FileName = '/' then
Accept;
end;//with
end;
procedure TfrmMain.remHomeDataReceived(Sender: TRtcConnection);
begin
with TRtcDataServer(Sender) do
begin
if Request.Complete then
begin
Write('<html><body>');
Write('<p><big>Servidor Sincronizador de PDA y ERP</big></p>');
Write('<p><small>PDASync Versión 1.0</small></p>');
Write('<p><a href="http://www.elmalabarista.com">El malabarista</a></p>');
Write('</body></html>');
end;//if
end;//with
end;
procedure TfrmMain.remPostFilesCheckRequest(Sender: TRtcConnection);
begin
with TRtcDataServer(Sender) do
begin
if (Request.FileName = '/Post/Archivos') and (Request.Method='POST') then
Accept;
end;//with
end;
procedure TfrmMain.remPostFilesDataReceived(Sender: TRtcConnection);
var
xml:String;
Largo:Int64;
begin
with TRtcDataServer(Sender) do
begin
if Request.Complete then
begin
try
Request.Params.AddText(Read);
xml := Request.Params.asString['xml'];
if Length(xml)=0 then
begin
raise Exception.Create('No se enviaron datos');
end;//if
xml := StringReplace(xml,'|amp;','&',[ rfReplaceAll, rfIgnoreCase ]);
dm.SaveFile(Request.Params.asString['FileName'],Request.Params);
xml := '[ACTUALIZADO]';
Largo := Length(xml);
if Request['Accept-Encoding'] = 'gzip,deflate' then
begin
xml := ZCompressStr(xml);
Response['Content-Encoding']:='deflate';
end;
Response['OriginalLength']:=IntToStr(Largo);
Response.StatusText := xml;
write(xml);
except
on E:Exception do
begin
msg('ERR!'+e.Message);
Response.Status(500,E.Message);
Write('Status 500: '+ E.Message);
end;
end;
end;//if
end;//with
end;
procedure TfrmMain.WebServerConnecting(Sender: TRtcConnection);
begin
if not Sender.inMainThread then
Sender.Sync(WebServerConnecting)
else
begin
CS.Enter;
try
Inc(CliCnt);
with Sender do
begin
Msg('++++ '+PeerAddr+':'+PeerPort+' ['+IntToStr(CliCnt)+' open]');
end;//with
tray.IconIndex := 2;
finally
CS.Leave;
end;//try
end;//if
end;
procedure TfrmMain.WebServerDataIn(Sender: TRtcConnection);
begin
if not Sender.inMainThread then
Sender.Sync(WebServerDataIn)
else
begin
TotalDataIn:=TotalDataIn+Sender.DataIn;
BarraEstado.SimpleText:='Recibiendo ' + IntToStr(TotalDataIn)+' + '+IntToStr(TotalDataOut)+' bytes';
end;//if
end;
procedure TfrmMain.WebServerDataOut(Sender: TRtcConnection);
begin
if not Sender.inMainThread then
Sender.Sync(WebServerDataOut)
else
begin
TotalDataOut:=TotalDataOut+Sender.DataOut;
BarraEstado.SimpleText:='Enviando ' + IntToStr(TotalDataIn)+' + '+IntToStr(TotalDataOut)+' bytes';
end;
end;
procedure TfrmMain.WebServerDisconnect(Sender: TRtcConnection);
begin
if not Sender.inMainThread then
Sender.Sync(WebServerDisconnect)
else
begin
CS.Enter;
try
Dec(CliCnt);
with Sender do
Msg('---- '+PeerAddr+':'+PeerPort+' ['+IntToStr(CliCnt)+' close]');
if CliCnt=0 then
begin
tray.IconIndex := 7;
end;//if
finally
CS.Leave;
end;//try
end;//if
end;
procedure TfrmMain.WebServerInvalidRequest(Sender: TRtcConnection);
begin
if not Sender.inMainThread then
Sender.Sync(WebServerInvalidRequest)
else
begin
with TRtcDataServer(Sender) do
begin
Msg('ERR! '+PeerAddr+' > "'+Request.Method+' '+Request.FileName+'" > Invalid Request: Header size limit exceeded.');
Response.Status(400,'Bad Request');
Write('Status 400: Bad Request');
end;//with
end;//if
end;
procedure TfrmMain.WebServerListenError(Sender: TRtcConnection; E: Exception);
begin
if not Sender.inMainThread then
Sender.Sync(WebServerListenError,E)
else
begin
Msg('ERR! ' + E.Message);
end;
end;
procedure TfrmMain.WebServerListenLost(Sender: TRtcConnection);
begin
if not Sender.inMainThread then
Sender.Sync(WebServerListenLost)
else
begin
Msg('Perdida comunicación');
btnRun.Action := actRun;
end;
end;
procedure TfrmMain.WebServerListenStart(Sender: TRtcConnection);
begin
if not Sender.inMainThread then
Sender.Sync(WebServerListenStart)
else
begin
Msg('Servidor iniciado. Escuchando en puerto ' + WebServer.ServerPort);
end;
end;
procedure TfrmMain.WebServerListenStop(Sender: TRtcConnection);
begin
if not Sender.inMainThread then
Sender.Sync(WebServerListenStart)
else
begin
Msg('Servidor detenido');
btnRun.Action := actRun;
end;
end;
procedure TfrmMain.WebServerRequestAccepted(Sender: TRtcConnection);
begin
if not Sender.inMainThread then
Sender.Sync(WebServerRequestAccepted)
else
begin
with TRtcDataServer(Sender) do
begin
Msg(Request.Method+':'+PeerAddr+' > "' + Request.URI+'"');
end;//with
end;//if
end;
procedure TfrmMain.WebServerRequestNotAccepted(Sender: TRtcConnection);
begin
if not Sender.inMainThread then
Sender.Sync(WebServerRequestNotAccepted)
else
begin
// Anything that comes this far is not acceptable by any DataProvider component.
with TRtcDataServer(Sender) do
begin
Msg('BAD! '+PeerAddr+' > "'+Request.Method+' '+Request.FileName+'" > Method "'+Request.Method+'" not supported.');
Response.Status(400,'Bad Request');
Write('Status 400: Bad Request');
Disconnect;
end;//with
end;//if
end;