Вернуть ответ браузеру (TTcpServer)
Доброго времени суток! Организую небольшой прокси-сервер на основе TTcpServer. Все хорошо, но не получается нормально выдать браузеру ответ серверных манипуляций. Реализация (вернее, её подобие) сего процесса располагается в самом низу нижевыложенного кода, ниже комментария "пытаемся вернуть ответ браузеру". Выдает что-то необъяснимое, ничего не имеющее общего с тем, что скапливается в переменной ResponseData. Подскажите, пожалуйста, что не так делаю
Код:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Sockets, StdCtrls;
type
TForm1 = class(TForm)
TcpServer1: TTcpServer;
TcpClient1: TTcpClient;
Memo1: TMemo;
procedure TcpServer1Accept(Sender: TObject; ClientSocket: TCustomIpClient);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ разрезание строк по разделителю }
procedure Explode(var a: array of string; Border, S: string);
var
S2: string;
i: Integer;
begin
i := 0;
S2 := S + Border;
repeat
try
a[i] := Copy(S2, 0, Pos(Border, S2) - 1);
except
end;
Delete(S2, 1, Length(a[i] + Border));
Inc(i);
until S2 = '';
end;
{ запись в файл }
function WriteFile(FileData : String; FileName : String) : Bool;
Var
f:System.Text;
begin
AssignFile(f, FileName);
Append(f);
Write(f, FileData);
CloseFile(f);
end;
{ клиент }
function GetContent(Request : string) : string;
var
s, Content: string;
i, size: integer;
P: pchar;
RecLen: integer;
TCPClient1: TTcpClient;
Handle : HWND;
A : array[0..2] of string;
Host: string;
begin
{ парсим хост }
Explode(A, #13#10, Request);
Explode(A[0], ' ', Request);
Host := StringReplace(A[1], 'http://', '', [rfIgnoreCase]);
Host := StringReplace(Host, StrPos(PChar(Host), '/'), '', [rfIgnoreCase]);
{ настройки соединения }
TCPClient1:=TTCPClient.Create(nil);
TcpClient1.RemoteHost := Host;
TcpClient1.RemotePort := '80';
{ препринимаем попытку соединения }
if TcpClient1.Connect then
begin
{ отправляем запрос }
TcpClient1.SendLn(Request + #13#10#13#10);
{ выделяем память }
P := GetMemory(256);
{ получаем ответ }
RecLen := TcpClient1.ReceiveBuf(P^, 256);
{ обрабатываем все это дело }
while RecLen > 0 do
begin
Content := Content + P;
RecLen := TcpClient1.ReceiveBuf(P^, 256);
end;
{ закрываем соединение }
TcpClient1.Disconnect;
end
{ если соединение не удалось }
else MessageBox(Handle, 'Сервер не найден!', 'Error', 16);
{ убираемся }
TcpClient1.Free;
{ вовращаем ответ }
Result := Content;
end;
{ сервер }
procedure TForm1.TcpServer1Accept(Sender: TObject; ClientSocket: TCustomIpClient);
var
s, ResponseData: string;
r : pchar;
Siz: integer;
begin
{ получаем заголовки запроса клиента }
s:=ClientSocket.ReceiveLn;
{ отправляем запрос и получаем ответ }
ResponseData := GetContent(s);
{ пытаемся вернуть ответ браузеру }
s := Copy(ResponseData, 1, 256);
Siz := ClientSocket.SendBuf(s, SizeOf(s) );
while Siz>0 do begin
Delete(ResponseData, 1, 256);
s := Copy(ResponseData, 1, 256);
Siz := ClientSocket.SendBuf(s, SizeOf(s) );
end;
{ закрываем соединение }
ClientSocket.Close;
end;
end.
Залил весь проект, если потребуется...
Последний раз редактировалось WennY, 06.09.2011 в 16:56.
|