The demo, i have attached, shows very good the effext when pressing F5
twice quick.
Only add the path for an image bigger than 500 KB in http.pas line 194
and line 184.
Access the server with index.html.
Thanks for your help in advance!
Roberto schrieb:
If the user is pressing F5, then the browser will kill the previous
connections. Your code should eventually notice that the Socket has
been closed (LastError <> 0) or will timeout after xx seconds.
Not sure where the problem is, but it will likely help if you post more code.
On 29/01/07, Deborah <[EMAIL PROTECTED]> wrote:
Deborah schrieb:
Hello,
i have a problem using Synapse with free pascal.
To send a header i use a loop in a thread like:
for n := 0 to Headers.Count - 1 do begin
Fsock.SendString(headers[n] + CRLF);
end;
Headers is TStringlist containing the header.
This loop works in general fine except in case the F5 button is pressed
several times.
To show a webpage are, let's say, 5 threads needed. If one presses the
F5 button once, all the 5 threads are passed fine. But in case the F5
button is pressed several time, the first thread is started several
times too. The problem is, that only the last of these first threads
passes the loop and finishes the thread.All the others got stuck in the
SendString method.
I tried using exception handling, added a FSock.CanWrite(1000) before
the loop and set an FSock.Timeout(5000) in the Create method of the
thread but unfortunately nothing helped yet.
Deborah
-------------------------------------------------------------------------
Take Surveys. Earn Cash. Influence the Future of IT
Join SourceForge.net's Techsay panel and you'll get the chance to share your
opinions on IT & business topics through brief surveys - and earn cash
http://www.techsay.com/default.php?page=join.php&p=sourceforge&CID=DEVDEV
_______________________________________________
synalist-public mailing list
[email protected]
https://lists.sourceforge.net/lists/listinfo/synalist-public
unit http;
interface
uses
Classes, blcksock, winsock, Synautil, SysUtils;
type
TTCPHttpDaemon = class(TThread)
private
Sock:TTCPBlockSocket;
public
Constructor Create;
Destructor Destroy; override;
procedure Execute; override;
end;
TTCPHttpThrd = class(TThread)
private
Sock:TTCPBlockSocket;
public
Headers: TStringList;
InputData, OutputData: TMemoryStream;
Constructor Create (hsock:tSocket);
Destructor Destroy; override;
procedure Execute; override;
function ProcessHttpRequest(Request, URI: string): integer;
end;
implementation
{ TTCPHttpDaemon }
Constructor TTCPHttpDaemon.Create;
begin
sock:=TTCPBlockSocket.create;
FreeOnTerminate:=true;
Priority:=tpNormal;
inherited create(false);
end;
Destructor TTCPHttpDaemon.Destroy;
begin
Sock.free;
inherited Destroy;
end;
procedure TTCPHttpDaemon.Execute;
var
ClientSock:TSocket;
begin
with sock do
begin
CreateSocket;
setLinger(true,10000);
bind('0.0.0.0','80');
listen;
repeat
if terminated then break;
if canread(1000) then
begin
ClientSock:=accept;
if lastError=0 then TTCPHttpThrd.create(ClientSock);
end;
until false;
end;
end;
{ TTCPHttpThrd }
Constructor TTCPHttpThrd.Create(Hsock:TSocket);
begin
sock:=TTCPBlockSocket.create;
Headers := TStringList.Create;
InputData := TMemoryStream.Create;
OutputData := TMemoryStream.Create;
Sock.socket:=HSock;
FreeOnTerminate:=true;
Priority:=tpNormal;
inherited create(false);
end;
Destructor TTCPHttpThrd.Destroy;
begin
Sock.free;
Headers.Free;
InputData.Free;
OutputData.Free;
inherited Destroy;
end;
procedure TTCPHttpThrd.Execute;
var
b: byte;
timeout: integer;
s: Ansistring;
method, uri, protocol: string;
size: integer;
x, n: integer;
resultcode: integer;
begin
timeout := 120000;
//read request line
s := sock.RecvString(timeout);
if sock.lasterror <> 0 then
Exit;
if s = '' then
Exit;
method := fetch(s, ' ');
if (s = '') or (method = '') then
Exit;
uri := fetch(s, ' ');
if uri = '' then
Exit;
protocol := fetch(s, ' ');
headers.Clear;
size := -1;
//read request headers
if protocol <> '' then
begin
if pos('HTTP/', protocol) <> 1 then
Exit;
repeat
s := sock.RecvString(Timeout);
if sock.lasterror <> 0 then
Exit;
if s <> '' then
Headers.add(s);
if Pos('CONTENT-LENGTH:', Uppercase(s)) = 1 then
Size := StrToIntDef(SeparateRight(s, ' '), -1);
until s = '';
end;
//recv document...
InputData.Clear;
if size >= 0 then
begin
InputData.SetSize(Size);
x := Sock.RecvBufferEx(InputData.Memory, Size, Timeout);
InputData.SetSize(x);
if sock.lasterror <> 0 then
Exit;
end;
OutputData.Clear;
ResultCode := ProcessHttpRequest(method, uri);
sock.SendString('HTTP/1.0 ' + IntTostr(ResultCode) + CRLF);
if protocol <> '' then
begin
headers.Add('Content-length: ' + IntTostr(OutputData.Size));
headers.Add('Connection: close');
headers.Add('Date: ' + Rfc822DateTime(now));
headers.Add('Server: Synapse HTTP server demo');
headers.Add('');
for n := 0 to headers.count - 1 do
sock.sendstring(headers[n] + CRLF);
end;
if sock.lasterror <> 0 then
Exit;
Sock.SendBuffer(OutputData.Memory, OutputData.Size);
end;
function TTCPHttpThrd.ProcessHttpRequest(Request, URI: string): integer;
var
l: TStringlist;
begin
//sample of precessing HTTP request:
// InputData is uploaded document, headers is stringlist with request headers.
// Request is type of request and URI is URI of request
// OutputData is document with reply, headers is stringlist with reply headers.
// Result is result code
result := 504;
if request = 'GET' then
begin
headers.Clear;
headers.Add('Content-type: Text/Html');
if (ExtractFileExt(URI)='.html') or (ExtractFileExt(URI)='.htm') then begin
l := TStringList.Create;
try
l.Add('<html>');
l.Add('<head></head>');
l.Add('<body>');
l.Add('Request Uri: ' + uri);
l.Add('<br>');
l.Add('This document is generated by Synapse HTTP server demo!<br>');
l.Add('<img src="info.bmp" alt="x" border="2"><br/>example-1<br/>');
l.Add('</body>');
l.Add('</html>');
l.SaveToStream(OutputData);
finally
l.free;
end;
Result := 200;
end else begin
try
OutputData.LoadFromFile('C:\Dokumente und
Einstellungen\deborah\Desktop\httpserv\info.bmp'); //Add path were the image is
saved
Result := 200;
finally
end;
end;
end;
end;
end.
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<PathDelim Value="\"/>
<Version Value="5"/>
<General>
<MainUnit Value="0"/>
<IconPath Value="./"/>
<TargetFileExt Value=".exe"/>
<ActiveEditorIndexAtStart Value="1"/>
</General>
<VersionInfo>
<ProjectVersion Value=""/>
</VersionInfo>
<PublishOptions>
<Version Value="2"/>
<IgnoreBinaries Value="False"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
<Units Count="2">
<Unit0>
<Filename Value="serv.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="serv"/>
<CursorPos X="1" Y="19"/>
<TopLine Value="1"/>
<EditorIndex Value="0"/>
<UsageCount Value="21"/>
<Loaded Value="True"/>
</Unit0>
<Unit1>
<Filename Value="http.pas"/>
<UnitName Value="http"/>
<CursorPos X="95" Y="194"/>
<TopLine Value="168"/>
<EditorIndex Value="1"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit1>
</Units>
<JumpHistory Count="2" HistoryIndex="1">
<Position1>
<Filename Value="serv.lpr"/>
<Caret Line="20" Column="95" TopLine="1"/>
</Position1>
<Position2>
<Filename Value="serv.lpr"/>
<Caret Line="19" Column="1" TopLine="1"/>
</Position2>
</JumpHistory>
</ProjectOptions>
<CompilerOptions>
<Version Value="5"/>
<PathDelim Value="\"/>
<SearchPaths>
<OtherUnitFiles Value="G:\Developer\units\synapse\source\lib\"/>
</SearchPaths>
<CodeGeneration>
<Generate Value="Faster"/>
</CodeGeneration>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Debugging>
<BreakPoints Count="6">
<Item1>
<Source Value="G:\Developer\units\pk\pkMiniGUI.pas"/>
<Line Value="1240"/>
</Item1>
<Item2>
<Source Value="G:\Developer\units\pk\pkMiniGUI.pas"/>
<Line Value="1175"/>
</Item2>
<Item3>
<Source Value="G:\Developer\tools\Updates\IntranetServer\sbNetSrv.pas"/>
<Line Value="166"/>
</Item3>
<Item4>
<Source Value="G:\Developer\tools\Updates\IntranetServer\sbNetSrv.pas"/>
<Line Value="213"/>
</Item4>
<Item5>
<Source Value="G:\Developer\tools\Updates\IntranetServer\sbNetSrv.pas"/>
<Line Value="170"/>
</Item5>
<Item6>
<Source Value="G:\Developer\tools\Updates\IntranetServer\UnitIntranetConfig.pas"/>
<Line Value="294"/>
</Item6>
</BreakPoints>
<Watches Count="2">
<Item1>
<Expression Value="FFinished"/>
</Item1>
<Item2>
<Expression Value="FLastUpdate"/>
</Item2>
</Watches>
<Exceptions Count="2">
<Item1>
<Name Value="ECodetoolError"/>
</Item1>
<Item2>
<Name Value="EFOpenError"/>
</Item2>
</Exceptions>
</Debugging>
</CONFIG>
program serv;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Classes, http
{ add your units here };
var dDaemon: TTCPHttpDaemon;
begin
dDaemon := TTCPHttpDaemon.Create;
WriteLn('Server is started');
dDaemon.WaitFor;
dDaemon.Free;
end.
-------------------------------------------------------------------------
Using Tomcat but need to do more? Need to support web services, security?
Get stuff done quickly with pre-integrated technology to make your job easier.
Download IBM WebSphere Application Server v.1.0.1 based on Apache Geronimo
http://sel.as-us.falkag.net/sel?cmd=lnk&kid=120709&bid=263057&dat=121642
_______________________________________________
synalist-public mailing list
[email protected]
https://lists.sourceforge.net/lists/listinfo/synalist-public
