Здравствуйте!
Было такое задание:

Нужно создать Web-сервер но в консольном интерфейсе который работает только по протоколу HTTP? используя например Эксплорер.
Сервер должен принимать запросы по протоколу TCP 80 
Файлы html,графика должны розмещатся в каталоге указанном в командной строке сервера
Сервер последовательный
Минимум обрабатывать запрос GET
Формировать ответы включая и коды ошибок
Используя интерфейс сокетов.

Значит есть готовое решение представляю исходники
lab6
{$APPTYPE CONSOLE}

uses server, winsock, mime_types, SysUtils, classes;


function GetHex(str:String):integer;
var
   v:integer;
begin

     v := ord(str[1]);

     if (v >= ord('0')) and (v <= ord('9')) then
     begin
          result := v-ord('0');
     end
     else if (v >= ord('A')) and (v <= ord('F')) then
     begin
          result := v-ord('A')+10;
     end
     else if (v >= ord('a')) and (v <= ord('f')) then
     begin
          result := v-ord('a')+10;
     end;
end;

function FromURI(str:String):String;
var
   s:String;
   pos, endpos:PChar;
begin
     s := '';

     pos := PChar(str);
     endpos := pos+length(str);

     while pos < endpos do
     begin
          if pos[0] = '%' then
          begin
               write(GetHex(pos[1])*16+GetHex(pos[2]), ' ');
               s := s+chr(GetHex(pos[1])*16+GetHex(pos[2]));
               pos := pos+3;
          end
          else
          begin
               s := s+pos[0];
               pos := pos+1;
          end;
     end;

     writeln;

     result := s;

end;



var
   wsa:TWSAData;
   srv:CServer;
   s:TSocket;

   len:integer;

   rbuf:String;
   answer:String;
   file_content:String;

   mime:CMimeTypes;

   pos:PChar;
   method:String;
   url:String;

   f:TFileStream;

   need_exit:boolean;

begin

     if WSAStartup($0002, wsa) = 0 then
     begin
          srv := CServer.Create;

          if srv.Bind('0.0.0.0', 80) then
          begin
               writeln('Server started');

               mime := CMimeTypes.Create;

               need_exit := false;

               while not need_exit do
               begin

               s := srv.GetSocket;
               
               if s <> INVALID_SOCKET then
               begin

                    SetLength(rbuf, 10*1024);
                    len := recv(s, Pointer(rbuf)^, 10*1024, 0);
                    SetLength(rbuf, len);

                    writeln(rbuf);

                    pos := PChar(rbuf);

                    method := '';

                    while pos[0] <> ' ' do
                    begin
                         method := method+pos[0];
                         pos := pos+1;
                    end;

                    pos := pos+2;
                    url := '';

                    while pos[0] <> ' ' do
                    begin
                         url := url+pos[0];
                         pos := pos+1;
                    end;

                    url := FromURI(url);

                    if url = 'exit' then need_exit := true;


                    writeln('Method: '+method);
                    writeln('URL: '+url);

                    if FileExists(url) then
                    begin
                         f := TFileStream.Create(url, fmOpenRead);

                         answer := 'HTTP/1.1 200 OK'+#13+#10;
                         answer := answer+'Cache-control: no-cache'+#13+#10;
                         answer := answer+'Connection: close'+#13+#10;
                         answer := answer+'Content-type: '+mime.GetMimeType(PChar(ExtractFileExt(url))+1)+#13+#10;
                         answer := answer+'Content-length: '+IntToStr(f.Size)+#13+#10+#13+#10;

                         writeln(answer);

                         SetLength(file_content, f.Size);
                         f.Read(Pointer(file_content)^, f.Size);

                         answer := answer+file_content;

                         send(s, Pointer(answer)^, length(answer), 0);

                         closesocket(s);
                         f.Free;
                    end
                    else
                    begin
                         answer := 'HTTP/1.1 404 Not Found'+#13+#10;
                         answer := answer+'Cache-control: no-cache'+#13+#10;
                         answer := answer+'Connection: close'+#13+#10;

                         writeln(answer);
                         
                         send(s, Pointer(answer)^, length(answer), 0);

                         closesocket(s);
                    end;
               end
               else
               begin
                    writeln('Error');
               end;

               end;

               mime.Free;
          end
          else
          begin
               writeln('Server error');
          end;

          srv.Free;

          WSACleanup;
     end
     else
     begin
         writeln('WSA Error');
     end;
end.


Сервер

unit server;

interface

uses winsock;

type

CServer = class

private

       ListenSocket:TSocket;
       Port:integer;
       Binded:boolean;

public
      constructor Create;
      destructor Destroy; override;

      function Bind(ip_address:String; port:integer):boolean;
      function GetSocket:TSocket;
      function GetPort:integer;

end;

implementation

constructor CServer.Create;
var
   val:boolean;
begin
     Binded := false;
     Port := 0;

     ListenSocket := socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);

     if ListenSocket <> INVALID_SOCKET then
     begin
     val := true;
     setsockopt(ListenSocket, SOL_SOCKET, SO_REUSEADDR, @val, sizeof(val));
     end;
end;


function CServer.GetPort:integer;
begin
     result := Port;
end;

function CServer.GetSocket:TSocket;
var
   len_addr:integer;
   in_a:TSockAddr;
begin
     if Binded and (ListenSocket <> INVALID_SOCKET) then
     begin
          if listen(ListenSocket, SOMAXCONN) <> SOCKET_ERROR then
          begin
        len_addr := sizeof(TSockAddr);

        result := accept(ListenSocket, @in_a, @len_addr);
                exit;
          end;
     end;

     result := INVALID_SOCKET;
end;

function CServer.Bind(ip_address:String; port:integer):boolean;
var
   sa:TSockAddr;
begin
     Port := port;

     Binded := false;

     if ListenSocket <> INVALID_SOCKET then
     begin
          FillChar(sa, sizeof(sa), 0);

          sa.sin_family := AF_INET;
          sa.sin_port := htons(Port);
          sa.sin_addr.s_addr := inet_addr(@ip_address[1]);

          if  winsock.bind(ListenSocket, sa, sizeof(sa)) <> SOCKET_ERROR then
          begin
               Binded := true;
          end;
     end;

     result := Binded;
end;

destructor CServer.Destroy;
begin
     Binded := false;

     if ListenSocket <> INVALID_SOCKET then
     begin
          closesocket(ListenSocket);
          ListenSocket := INVALID_SOCKET;
     end;
end;

end.


mime

unit mime_types;

interface

type

SMime = record
      Ext:String;
      Name:String;
end;

CMimeTypes = class

private

       Mime:Array[0..1024] of SMime;
       Count:integer;

       procedure ParseString(str:String);
       procedure ParseSubString(str:String);

public

      constructor Create;
      destructor Destroy; override;

      function GetMimeType(ext:String):String;

end;

implementation

uses classes, sysutils;


constructor CMimeTypes.Create;
var
   f:TFileStream;
   str:String;

   i:integer;
begin
     f := TFileStream.Create('mime.txt', fmOpenRead);

     SetLength(str, f.Size);

     f.Read(Pointer(str)^, f.Size);
     f.Free;

     Count := 0;

     ParseString(str);

end;


procedure CMimeTypes.ParseString(str:String);
var
   pos, pos1, pos2:PChar;
   substr:String;
begin
     pos := PChar(str);

     while pos <> nil do
     begin

     pos := StrPos(pos, '[');
     pos1 := pos;

     if pos1 <> nil then
     begin
          pos := StrPos(pos+1, ']');
          pos2 := pos;

          if pos2 <> nil then
          begin
                pos := pos1+1;

                substr := '';

                while pos < pos2 do
                begin
                     substr := substr+pos[0];
                     pos := pos+1;
                end;

                pos := pos2+1;

                ParseSubString(substr);
          end;
     end;
     end;
end;

procedure CMimeTypes.ParseSubString(str:String);
var
   pos, pos1, pos2:PChar;
   substr:String;
   current_mime:String;
begin

     current_mime := '';

     pos := PChar(str);

     while pos <> nil do
     begin

     pos := StrPos(pos, '"');
     pos1 := pos;

     if pos1 <> nil then
     begin
          pos := StrPos(pos+1, '"');
          pos2 := pos;

          if pos2 <> nil then
          begin
                pos := pos1+1;

                substr := '';

                while pos < pos2 do
                begin
                     substr := substr+pos[0];
                     pos := pos+1;
                end;

                pos := pos2+1;

                if current_mime = '' then
                begin
                     current_mime := substr;
                end
                else
                begin
                     Mime[Count].Name := current_mime;
                     Mime[Count].Ext := substr;
                     Count := Count+1;
                end;
          end;
     end;

     end;
end;

function CMimeTypes.GetMimeType(ext:String):String;
var
   i:integer;
begin

     for i := 0 to Count-1 do
     begin
          if Mime[i].Ext = ext then
          begin
               result := Mime[i].Name;
               exit;
          end;
     end;

     result := 'unknown';

end;


destructor CMimeTypes.Destroy;
begin
end;

end.


Обьясните как эта штука работает
Спасибо

Зачем изобретать велосипед воспользуйся apache как для виндовс или unix или виндос2003 iis   

Это сообщение отредактировал(а) larinva - 28.10.2009, 10:51