Ver Mensaje Individual
  #5  
Antiguo 17-12-2008
Avatar de mamcx
mamcx mamcx is offline
Moderador
 
Registrado: sep 2004
Ubicación: Medellín - Colombia
Posts: 3.911
Reputación: 25
mamcx Tiene un aura espectacularmamcx Tiene un aura espectacularmamcx Tiene un aura espectacular
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;
__________________
El malabarista.
Responder Con Cita