Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > OOP
Registrarse FAQ Miembros Calendario Guía de estilo Buscar Temas de Hoy Marcar Foros Como Leídos

Grupo de Teaming del ClubDelphi

Respuesta
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 04-09-2014
darkamerico darkamerico is offline
Miembro
 
Registrado: dic 2010
Posts: 225
Poder: 14
darkamerico Va por buen camino
Wink TTCPServer Web con Soporte de PHP

Saludos amigos de la comunidad Delphi, les traigo el código de un servidor web hecho en Delphi 2010 que utiliza el componente TTCPServer de la pestaña Internet de la VCL, funciona todo bien, sin embargo, quisiera saber como agregarle soporte para procesar archivos php, tal como apache agrega su Handler, si alguien puede tomar como base el código que comparto aquí y agregarle el parsing de php, se lo agradecería infinitamente:

Código Delphi [-]
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Sockets, Buttons;

type
  TForm1 = class(TForm)
    servidor: TTcpServer;
    txtLog: TMemo;
    btnPrender: TBitBtn;
    btnApagar: TBitBtn;
    btnSalir: TBitBtn;
    procedure servidorAccept(Sender: TObject; ClientSocket: TCustomIpClient);
    procedure btnPrenderClick(Sender: TObject);
    procedure btnApagarClick(Sender: TObject);
    procedure btnSalirClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.btnApagarClick(Sender: TObject);
begin
  servidor.Close;
  txtLog.Lines.Add(DateTimeToStr(now) + ': Servidor Parado');
end;

procedure TForm1.btnSalirClick(Sender: TObject);
begin
  btnApagarclick(Sender);
  close;
end;

procedure TForm1.btnPrenderClick(Sender: TObject);
begin
  servidor.Open;
  txtLog.Lines.Add(DateTimeToStr(now) + ': Servidor Ok');
end;

procedure TForm1.servidorAccept(Sender: TObject; ClientSocket: TCustomIpClient);
var
  Linea, Ruta:string;
  HTTPpos:integer;
begin
  Linea:=' ';
  while ClientSocket.Connected and (Linea<>'') do
  begin
    Linea:=ClientSocket.Receiveln();
    txtLog.Lines.Add(Linea);

    if Copy(Linea,1,3) = 'GET' then
    begin
      HTTPpos:=Pos('HTTP',Linea);
      Ruta:=Copy(Linea,5,HTTPpos-6);

      txtLog.Lines.Add('Ruta: ' + Ruta);
    end;
  end;

  if Ruta='/' then
    Ruta:='index.html';

  if FileExists('htdocs/' + Ruta) then
    with TStringList.Create do
    begin
      LoadFromFile('htdocs/' + Ruta);
      ClientSocket.Sendln('HTTP/1.0 200 OK');
      ClientSocket.Sendln('');
      ClientSocket.Sendln(Text);
      ClientSocket.Close;
      Free;
      Exit;
    end;

  if FileExists('htdocs/404.html') then
  begin
    with TStringList.Create do
    begin
      LoadFromFile('htdocs/404.html');
      ClientSocket.Sendln('HTTP/1.0 404 Not Found');
      ClientSocket.Sendln('');
      ClientSocket.Sendln(Text);
      ClientSocket.Close;
      Free;
    end;
  end
  else
  begin
    ClientSocket.Sendln('HTTP/1.0 404 Not Found');
    ClientSocket.Sendln('');
    ClientSocket.Sendln('

Error 404 - Archivo No Encontrado: ' + Ruta + '

'
); end; end; end.
Responder Con Cita
  #2  
Antiguo 08-09-2014
darkamerico darkamerico is offline
Miembro
 
Registrado: dic 2010
Posts: 225
Poder: 14
darkamerico Va por buen camino
Red face Buscando insesantemente

Buscando incesantemente, finalmente un avance creo yo, el articulo aqui

Aquí el código que encontré:

Código Delphi [-]
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, OleCtrls, SHDocVw;

type
  TForm1 = class(TForm)
    WebBrowser1: TWebBrowser;
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    function IsWindowsNT: Boolean;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
si: TStartupInfo;
pi: TProcessInformation;
sd: TSecurityDescriptor;
sa: TSecurityAttributes;
lpsa: PSecurityAttributes;
hReadPipe, hWritePipe : THandle;
BytesRead, FBreak: Integer;
dest: array [0..3999] of Char;
rdLoopDone: Boolean;
sl: TStringList;
i: Integer;
bShowHTML: Boolean;
begin
Memo1.Clear;
Sl := TStringList.Create;
lpsa := nil;
if (IsWindowsNT) then begin
InitializeSecurityDescriptor(@sd, 1); //Not sure what the value should be here - not running NT
SetSecurityDescriptorDacl(@sd, True, nil, False);
sa.nLength := SizeOf(TSecurityAttributes);
sa.bInheritHandle := True;
sa.lpSecurityDescriptor := @sd;
lpsa := @sa;
end;

//We create a pipe here to pass the DOS output to
Assert(CreatePipe(hReadPipe, hWritePipe, lpsa, 2500000));
GetStartupInfo(si);
si.cb := SizeOf(TStartupInfo);
si.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
si.wShowWindow := SW_HIDE;

//The write handle is asigned to the startupinfo record so CreateProcess knows
//where to send the output
si.hStdOutput := hWritePipe;
si.hStdError := hWritePipe;
Assert(Boolean(hWritePipe));

Assert(CreateProcess(nil, 'c:\xampp\php\php.exe d:\script.php scriptparameter=value', nil, nil, True, 0, nil, nil, si, pi));
CloseHandle(pi.hThread);

//Let's wait for the DOS app to finish
WaitForSingleObject(pi.hProcess, INFINITE);
Assert(Boolean(hReadPipe));
rdLoopDone := False;
FBreak := 1;

//And now read the data from the pipe and add it to our RichEdit control
while not rdLoopDone do begin
FillChar(dest, SizeOf(dest), 0);
Assert(ReadFile(hReadPipe, dest, SizeOf(dest), LongWord(BytesRead), nil));
// Save each output line to a stringlist
Sl.Add(String(dest));
// and print it to a memo
Memo1.Lines.Text := Memo1.Lines.Text + String(dest);
if (BytesRead < 4000) then
rdLoopDone := True;
if (FBreak > 150) then
rdLoopDone := True;
Inc(FBreak);
end;
for i := 0 to Pred(sl.Count) do
if Pos('Content-type: text/html', sl.Strings[i]) > 0 then
bShowHtml := True;
if bShowHTML then
begin
// This saves the output to HTML FIle
Sl.SaveToFile('c:\1test.html');
// and now navigates TWebbrowser to the outputed HTML
WebBrowser1.Navigate('c:\1test.html');
end;
CloseHandle(hReadPipe);
CloseHandle(hWritePipe);
CloseHandle(pi.hProcess);
end;

function TForm1.IsWindowsNT: Boolean;
var
  osv: TOsVersionInfo;
begin
  osv.dwOSVersionInfoSize := SizeOf(osv);
  GetVersionEx(osv);
  Result := (osv.dwPlatformId = VER_PLATFORM_WIN32_NT);
end;

end.

El error aparece en la línea:

Código Delphi [-]
Assert(ReadFile(hReadPipe, dest, SizeOf(dest), LongWord(BytesRead), nil));

Por favor ayuda, se que estoy cerca.

Gracias
Responder Con Cita
Respuesta


Herramientas Buscar en Tema
Buscar en Tema:

Búsqueda Avanzada
Desplegado

Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro

Temas Similares
Tema Autor Foro Respuestas Último mensaje
Soporte tecnico look Humor 2 07-03-2012 21:30:01
Soporte c# .NET yapt La Taberna 0 10-09-2010 12:25:33
¿Soporte de kylix? fox Lazarus, FreePascal, Kylix, etc. 9 11-11-2007 14:24:28
TTcpClient y TTcpServer b3nshi Varios 6 29-08-2007 23:34:03
Soporte de .Jpg en CLX rastafarey Gráficos 1 04-02-2005 23:57:01


La franja horaria es GMT +2. Ahora son las 00:57:18.


Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi