Napisałem sobie własny serwer HTTP oparty na TServerSocket i TClientSocket. Wszystko działa ładnie pięknie, tylko przeglądarka, po odebraniu kodu HTML wysyła dużo zapytań o obrazki i inne elementy. Mój program nie nadąża z analizą nagłówków i z realizowaniem zapytań. Jak sobie z tym poradzić? Oto kod realizujący analizę zapytytania:
var
odczytane,poz:integer;
l:integer;
b:PCHar;
files,ext,ctype:string;
s:string;
f:file;
fs:TFileStream;
begin
if not closed then //closed - czy aktualnie transfer, inaczej wysyła obrazki w "połowie"
begin
closed:=true;
s:=socket.receivetext;
l:=Length(s);
rec:=rec+l;
m.text:=s;
panel2.caption:='Odebrano '+inttostr(rec div 1024)+' kB';
if copy(s,0,3)='GET' then
begin
files:=copy(s,5,pos('HTTP',s)-6);
end;
if files<>'' then begin
lb.items.Add('Żądanie GET: '+files);
files:=stringreplace(files,'/','\',[rfIgnoreCase]+[rfReplaceAll]);
if copy(files,length(files),1)='\' then begin
if fileexists(edit1.text+files+'index.html') then files:=files+'index.html';
if fileexists(edit1.text+files+'index.htm') then files:=files+'index.htm';
if fileexists(edit1.text+files+'main.html') then files:=files+'main.html';
end;
if copy(files,length(files),1)='\' then
begin
req.caption:='Generowanie listy plików';
//robimy spis plików w katalogu, ale tylko wtedy gdy nie ma plikow index ani nie podano oknkretnej nazwy
socket.SendText(GenerateFL(edit1.text+files,files,'*.*')); //generateFL - robi liste plikow w podanym katalogu(a'la Apache)
lb.items.Add('Odpowiedź: Lista plików');
end
else
if pos('..',files)<>0 then Http403 //brak dostepu
else
if fileexists(edit1.text+files) then
begin
req.caption:='Przygotowywanie nagłówka';
ctype:=DocToCT(edit1.text+files); //funkcja zwraca odpowiedni Content-Type, np. text/html
odczytane:=0;
poz:=0;
fs:=TFileStream.Create(edit1.text+files,fmOpenRead + fmShareExclusive); //tworzymy stream
send:=send+fs.size;
b:=Pchar('HTTP/1.0 200 OK'+#13#10+'Server: Insure Web Server'+#13#10+'Connection: Keep-Alive'+#13#10+'Content-Type: '+ctype+#13#10+'Content-Length: '+inttostr(fs.size)); //wysylamy naglowek
Socket.SendBuf(b,SizeOf(b));
req.caption:='Wysyłanie pliku';
fs.position:=0;
socket.SendStreamThenDrop(fs);
Panel1.caption:='Wysłano: '+inttostr(send div 1024) +' kB';
lb.items.Add('Odpowiedź na żądanie. Wysłano plik '+edit1.text+files+' ['+ctype+']');
end else
begin
lb.items.Add('Odpowiedź na żądanie. 404 Brak pliku: '+edit1.text+files);
HTTP404(files); //funkcja wysyla blad 404
end;
end;
if not rsocket then CloseConnect; //zamykanie poloczenia, dziala wspaniale
if rsocket then rsocket:=false;
end else lb.items.add('<insure> > Nadmiarowe zapytanie: Nie wykonano.');
end;