unit httphelp;
interface

type
   THttpEncoding    = (encUUEncode, encBase64, encMime);

// HTTP::Status code processing
function status_message(code : integer) : string;
function is_info(code : integer) : boolean;
function is_success(code : integer) : boolean;
function is_redirect(code : integer) : boolean;
function is_error(code : integer) : boolean;
function is_client_error(code : integer) : boolean;
function is_server_error(code : integer) : boolean;

{ Syntax of an URL: protocol://[user[:password]@]server[:port]/path }
procedure ParseURL(const URL : String;
                   var Proto, User, Pass, Host, Port, Path : String);

function EncodeLine(Encoding : THttpEncoding;
                     SrcData : PChar; Size : Integer):String;
function EncodeStr(Encoding : THttpEncoding; const Value : String) : String;

function UrlDecode(S : String) : String;

function RFC1123_Date(aDate : TDateTime) : String;
// for HTTP modified since!

function bool2str(bin: boolean) : string;

function header_200 : string;

function header_302(new_url: string) : string;

function start_html(title: string; metastr : string): string;

function h3(str : string): string;
function h2(str : string): string;
function h1(str : string): string;

function end_html : string;

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
const
 CRLF = #13+#10;

 // C_... Constants
 C_POST = 'POST ';
 C_GET = 'GET ';
 C_HEAD = 'HEAD ';

 C_HTTP10 = ' HTTP/1.0';
 C_HTTP11 = ' HTTP/1.1';

 C_ACCEPT = 'Accept: ';
 C_REFERER = 'Referer: ';
 C_ACCEPT_LANGUAGE = 'Accept-Language: ';
 C_CONTENT_TYPE = 'Content-Type: ';
 C_ACCEPT_ENCODING = 'Accept-Encoding: ';
 C_USER_AGENT = 'User-Agent: ';
 C_HOST = 'Host: ';
 C_CONTENT_LENGTH = 'Content-Length: ';
 C_PROXY_CONNECTION = 'Proxy-Connection: ';
 C_PRAGMA = 'Pragma: ';

 C_IF_MODIFIED = 'If-Modified-Since: '; // + RFC1123_Date(FModifiedSince) + ' GMT'
 C_MODIFIED = 'Last-Modified: ';  // ANSWER

 C_IF_MATCH = 'If-None-Match: ';
 C_MATCH = 'ETag: '; // ANSWER

 C_AUTH = 'Authorization: Basic '; // + EncodeStr(encBase64, Username + ':' + Password)
 C_AUTH_PROXY = 'Proxy-Authorization: Basic '; //+ EncodeStr(encBase64, ProxyUsername + ':' + ProxyPassword)


 // DC := Default Constants
 DC_ACCEPT = 'image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/vnd.ms-powerpoint, application/vnd.ms-excel, application/msword, application/pdf, */*';
 DC_ACCEPT_LANGUAGE = 'de';
 DC_CONTENT_TYPE = 'application/x-www-form-urlencoded';
 DC_ACCEPT_ENCODING = 'gzip, deflate';
 DC_USER_AGENT = 'Mozilla/4.0 (compatible; MSIE 5.01; Windows NT 5.0)';
 DC_PROXY_CONNECTION = 'no-cache';
 DC_PRAGMA = 'Keep-Alive';

 DC_PORT = '80';
 DC_PROXY_PORT = '8080';

 DC_OK ='200 OK'+CRLF;
 DC_TCP = '6';


const
    bin2uue  : String = '`!"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';
    bin2b64  : String = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
    uue2bin  : String = ' !"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_ ';
    b642bin  : String = '~~~~~~~~~~~^~~~_TUVWXYZ[\]~~~|~~~ !"#$%&''()*+,-./0123456789~~~~~~:;<=>?@ABCDEFGHIJKLMNOPQRS';
    linesize = 45;

const
   RC_CONTINUE                         =100;
   RC_SWITCHING_PROTOCOLS              =101;

   RC_OK                               =200;
   RC_CREATED                          =201;
   RC_ACCEPTED                         =202;
   RC_NON_AUTHORITATIVE_INFORMATION    =203;
   RC_NO_CONTENT                       =204;
   RC_RESET_CONTENT                    =205;
   RC_PARTIAL_CONTENT                  =206;

   RC_MULTIPLE_CHOICES                 =300;
   RC_MOVED_PERMANENTLY                =301;
   RC_FOUND                            =302;
   RC_SEE_OTHER                        =303;
   RC_NOT_MODIFIED                     =304;
   RC_USE_PROXY                        =305;
   RC_TEMPORARY_REDIRECT               =307;

   RC_BAD_REQUEST                      =400;
   RC_UNAUTHORIZED                     =401;
   RC_PAYMENT_REQUIRED                 =402;
   RC_FORBIDDEN                        =403;
   RC_NOT_FOUND                        =404;
   RC_METHOD_NOT_ALLOWED               =405;
   RC_NOT_ACCEPTABLE                   =406;
   RC_PROXY_AUTHENTICATION_REQUIRED    =407;
   RC_REQUEST_TIMEOUT                  =408;
   RC_CONFLICT                         =409;
   RC_GONE                             =410;
   RC_LENGTH_REQUIRED                  =411;
   RC_PRECONDITION_FAILED              =412;
   RC_REQUEST_ENTITY_TOO_LARGE         =413;
   RC_REQUEST_URI_TOO_LARGE            =414;
   RC_UNSUPPORTED_MEDIA_TYPE           =415;
   RC_REQUEST_RANGE_NOT_SATISFIABLE    =416;
   RC_EXPECTATION_FAILED               =417;

   RC_INTERNAL_SERVER_ERROR            =500;
   RC_NOT_IMPLEMENTED                  =501;
   RC_BAD_GATEWAY                      =502;
   RC_SERVICE_UNAVAILABLE              =503;
   RC_GATEWAY_TIMEOUT                  =504;
   RC_HTTP_VERSION_NOT_SUPPORTED       =505;


implementation
uses sysutils;

function IsDigit(Ch : Char) : Boolean;
begin
    Result := (ch in ['0'..'9']);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function IsXDigit(Ch : char) : Boolean;
begin
    Result := (ch in ['0'..'9']) or (ch in ['a'..'f']) or (ch in ['A'..'F']);
end;

function XDigit(Ch : char) : Integer;
begin
    if ch in ['0'..'9'] then
        Result := ord(Ch) - ord('0')
    else
        Result := (ord(Ch) and 15) + 9;
end;


function htoin(value : PChar; len : Integer) : Integer;
var
    i : Integer;
begin
    Result := 0;
    i      := 0;
    while (i < len) and (Value[i] = ' ') do
        i := i + 1;
    while (i < len) and (isxDigit(Value[i])) do begin
        Result := Result * 16 + xdigit(Value[i]);
        i := i + 1;
    end;
end;

function htoi2(value : PChar) : Integer;
begin
    Result := htoin(value, 2);
end;


function UrlDecode(S : String) : String;
var
    I  : Integer;
    Ch : Char;
begin
    Result := '';
    I := 1;
    while (I <= Length(S)) and (S[I] <> '&') do begin
        Ch := S[I];
        if Ch = '%' then begin
            Ch := chr(htoi2(@S[I + 1]));
            Inc(I, 2);
        end
        else if Ch = '+' then
            Ch := ' ';
        Result := Result + Ch;
        Inc(I);
    end;
end;


function status_message(code : integer) : string;
var r : string;
begin;
r:='RC_UNKNOWN_ERROR_CODE';
case code of
   RC_CONTINUE                         : r:='RC_CONTINUE';
   RC_SWITCHING_PROTOCOLS              : r:='RC_SWITCHING_PROTOCOLS';
   RC_OK                               : r:='RC_OK';
   RC_CREATED                          : r:='RC_CREATED';
   RC_ACCEPTED                         : r:='RC_ACCEPTED';
   RC_NON_AUTHORITATIVE_INFORMATION    : r:='RC_NON_AUTHORITATIVE_INFORMATION';
   RC_NO_CONTENT                       : r:='RC_NO_CONTENT';
   RC_RESET_CONTENT                    : r:='RC_RESET_CONTENT';
   RC_PARTIAL_CONTENT                  : r:='RC_PARTIAL_CONTENT';
   RC_MULTIPLE_CHOICES                 : r:='RC_MULTIPLE_CHOICES';
   RC_MOVED_PERMANENTLY                : r:='RC_MOVED_PERMANENTLY';
   RC_FOUND                            : r:='RC_FOUND';
   RC_SEE_OTHER                        : r:='RC_SEE_OTHER';
   RC_NOT_MODIFIED                     : r:='RC_NOT_MODIFIED';
   RC_USE_PROXY                        : r:='RC_USE_PROXY';
   RC_TEMPORARY_REDIRECT               : r:='RC_TEMPORARY_REDIRECT';
   RC_BAD_REQUEST                      : r:='RC_BAD_REQUEST';
   RC_UNAUTHORIZED                     : r:='RC_UNAUTHORIZED';
   RC_PAYMENT_REQUIRED                 : r:='RC_PAYMENT_REQUIRED';
   RC_FORBIDDEN                        : r:='RC_FORBIDDEN';
   RC_NOT_FOUND                        : r:='RC_NOT_FOUND';
   RC_METHOD_NOT_ALLOWED               : r:='RC_METHOD_NOT_ALLOWED';
   RC_NOT_ACCEPTABLE                   : r:='RC_NOT_ACCEPTABLE';
   RC_PROXY_AUTHENTICATION_REQUIRED    : r:='RC_PROXY_AUTHENTICATION_REQUIRED';
   RC_REQUEST_TIMEOUT                  : r:='RC_REQUEST_TIMEOUT';
   RC_CONFLICT                         : r:='RC_CONFLICT';
   RC_GONE                             : r:='RC_GONE';
   RC_LENGTH_REQUIRED                  : r:='RC_LENGTH_REQUIRED';
   RC_PRECONDITION_FAILED              : r:='RC_PRECONDITION_FAILED';
   RC_REQUEST_ENTITY_TOO_LARGE         : r:='RC_REQUEST_ENTITY_TOO_LARGE';
   RC_REQUEST_URI_TOO_LARGE            : r:='RC_REQUEST_URI_TOO_LARGE';
   RC_UNSUPPORTED_MEDIA_TYPE           : r:='RC_UNSUPPORTED_MEDIA_TYPE';
   RC_REQUEST_RANGE_NOT_SATISFIABLE    : r:='RC_REQUEST_RANGE_NOT_SATISFIABLE';
   RC_EXPECTATION_FAILED               : r:='RC_EXPECTATION_FAILED';
   RC_INTERNAL_SERVER_ERROR            : r:='RC_INTERNAL_SERVER_ERROR';
   RC_NOT_IMPLEMENTED                  : r:='RC_NOT_IMPLEMENTED';
   RC_BAD_GATEWAY                      : r:='RC_BAD_GATEWAY';
   RC_SERVICE_UNAVAILABLE              : r:='RC_SERVICE_UNAVAILABLE';
   RC_GATEWAY_TIMEOUT                  : r:='RC_GATEWAY_TIMEOUT';
   RC_HTTP_VERSION_NOT_SUPPORTED       : r:='RC_HTTP_VERSION_NOT_SUPPORTED';

end;
status_message:=r;
end;


function is_info(code : integer) : boolean;
(* Return TRUE if $code is an Informational status code.
   This class of status code indicates a provisional response which can't have any content. *)
begin;
   if (code >= 100) and (code < 200) then is_info:=true else is_info:=false;
end;

function is_success(code : integer) : boolean;
(* Return TRUE if $code is a Successful status code. *)
begin;
   if (code >= 200) and (code < 300) then is_success:=true else is_success:=false;
end;

function is_redirect(code : integer) : boolean;
(* Return TRUE if $code is a Redirection status code.
   This class of status code indicates that further action needs to be taken
   by the user agent in order to fulfill the request. *)
begin;
   if (code >= 300) and (code < 400) then is_redirect:=true else is_redirect:=false;
end;

function is_error(code : integer) : boolean;
(* Return TRUE if $code is an Error status code.
   The function return TRUE for both client error or a server error status codes. *)
begin;
   if (code >= 400) and (code < 600) then is_error:=true else is_error:=false;
end;

function is_client_error(code : integer) : boolean;
(* Return TRUE if $code is an Client Error status code.
   This class of status code is intended for cases in which the client seems to have erred. *)
begin;
   if (code >= 400) and (code < 500) then is_client_error:=true else is_client_error:=false;
end;

function is_server_error(code : integer) : boolean;
(* Return TRUE if $code is an Server Error status code.
   This class of status codes is intended for cases in which the server is aware
   that it has erred or is incapable of performing the request. *)
begin;
   if (code >= 500) and (code < 600) then is_server_error:=true else is_server_error:=false;
end;

function bool2str(bin: boolean) : string;
begin;
  if bin=true then bool2str:='Ja' else bool2str:='Nein';
end;