Aplicaciones de escritorio con control web

[mamcx]

Pues con RTC (gran parte fue copiando de los ejemplos):

Código Delphi [-]
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('');

      Write('
Servidor Sincronizador de PDA y ERP
');
      Write('
PDASync Versión 1.0
');
      Write('
El malabarista
');

      Write('');
    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;