{ +-------------------------------------------------------------+ }
{ |                                                             | }
{ |   GM-Software                                               | }
{ |   ===========                                               | }
{ |                                                             | }
{ |   Project: All Projects                                     | }
{ |                                                             | }
{ |   Description: Basic Internet things.                       | }
{ |                                                             | }
{ |                                                             | }
{ |   Copyright (C) - 2013 - Gerrit Moeller.                    | }
{ |                                                             | }
{ |   Source code dstributed under MIT license.                 | }
{ |                                                             | }
{ |   See: https://www.gm-software.de                           | }
{ |                                                             | }
{ +-------------------------------------------------------------+ }

{$INCLUDE GMCompilerSettings.inc}

unit GMINetBase;

interface

uses {$IFDEF JEDIAPI}{$IFNDEF FPC}jwaWinType,{$ENDIF}{$ELSE}Windows,{$ENDIF}
     GMActiveX, GMStrDef, GMCollections, GMIntf, GMCommon, GMUnionValue, GMSockets;

const

  CR = #$0d; // : AnsiChar
  LF = #$0a; // : AnsiChar

  CRLF = CR + LF; // : AnsiString = CR + LF;

//cUriGenericDelimiters = ':/?#[]@';
//cUriSubDelimiters = '!$&''()*+,;=';
//cUriUnreservedChars = '-._~';

  cUriGenericDelimiters = [':', '/', '?', '#', '[', ']', '@'];
  cUriSubDelimiters = ['!', '$', '&', '''', '(', ')', '*', '+', ',', ';', '='];
  cUriUnreservedChars = ['-', '.', '_', '~'];

  cUriNotPercentEncodeChars = cUriGenericDelimiters + cUriSubDelimiters + cUriUnreservedChars;

  cStrCommand = 'Command';
  cStrHidden = '*hidden*';

  cStrINetHeaderWordSeparators = cWhiteSpace + ';:,!^°§$&/=?\[]{}()<>´`*+~#''|';

  cStrContent = 'CONTENT';


type

  EGMINetException = class(EGMException);
  TGMINetExceptionClass = class of EGMINetException;


  TCmdResponse = record
    Code: AnsiString;
    Text: TGMStringArray;
  end;


  TGMINetHeaderAddMode = (hamAlwaysAdd, hamAddIfNew, hamReplaceIfExists, hamCoalesce);

  TGMINetProtocolBase = class;

  IGMINetProtocolBase = interface(IUnknown)
    ['{F3DACEB3-8B3B-41B2-998E-8E9FFA12B65F}']
    function Obj: TGMINetProtocolBase;
  end;

  TGMINetProtocolBase = class(TGMRefCountedObj, IGMINetProtocolBase)
   protected
    FHeadersToSend, FReceivedHeaders: IGMIntfCollection;

    function ExceptClassForCode(const ACode: AnsiString): TGMINetExceptionClass; virtual;
    function IsHeaderTermLine(const ALine: AnsiString): Boolean; virtual;
    function BuildErrorMsgPostfixFromResponseContent(const AResponseContent: ISequentialStream): TGMString; virtual;

   public
//  TransportLayer: ISequentialStream;

//  constructor Create(const ATransportLayer: ISequentialStream; const ARefLifeTime: Boolean = True); reintroduce; overload;
    function ConsumeContent(const ATransportLayer: ISequentialStream): TGMString; virtual;
    function Obj: TGMINetProtocolBase;
    function ProtocolDisplayName: TGMString; virtual;

    function ReadResponseLine(const ATransportLayer: ISequentialStream): AnsiString;
    function ReceiveCmdResponse(const ATransportLayer: ISequentialStream): TCmdResponse;
    function CheckCmdResponse(const ACommand: TGMString; const ACmdResponse: TCmdResponse; const ASuccessCodes: TGMString; const ACallingName: TGMString = ''): TCmdResponse;
    function ExecCommandStr(const ATransportLayer: ISequentialStream; ACommand, ASuccessCodes: TGMString; ACallingName: TGMString = ''; const AShowTrace: Boolean = True): TCmdResponse;

    function ReceiveHeaders(const ATransportLayer: ISequentialStream; const AHeaders: IGMIntfCollection): TGMString; virtual;
    function HeadersToSend: IGMIntfCollection;
    function ReceivedHeaders: IGMIntfCollection;
  end;


  TGMINetHeaderEntry = class(TGMNameAndStrValueObj)
   public
    constructor Create(const AHeaderLine: TGMString; const ARefLifeTime: Boolean = True); reintroduce; overload;
  end;


  TGMInetHeaderIterator = class(TGMRefCountedObj, IGMIterator)
   protected
    FBaseIterator: IGMIterator;
    FHeaderName: TGMString;

   public
    constructor Create(const ABaseIterator: IGMIterator; const AHeaderName: TGMString; const ARefLifeTime: Boolean = True); reintroduce;
    function NextEntry(out AEntry): Boolean;
    procedure Reset;
  end;

  EGMUriComponent = (uriScheme, uriUser, uriPassword, uriHost, uriPort, uriPath, uriQuery, uriFragment);
  EGMInitUriComponents = set of EGMUriComponent;

  const

  cAllUriComponents = [uriScheme .. uriFragment];
  cDfltUriComponents = [uriScheme .. uriPath];

  type

  RGMUriComponents = record
    Scheme: TGMString;
    User: TGMString;
    Password: TGMString;
    Host: TGMString;
    Port: TGMString;
    Path: TGMString;
    Query: TGMString;
    Fragment: TGMString;
  end;


function GMInitUriComponents(const AScheme, AUser, APassword, AHost, APort, APath, AQuery, AFragment: TGMString): RGMUriComponents;

function GMUriEncode(const AUrl: AnsiString; const AIgnorePercentChars: Boolean = True): AnsiString;
function GMUriDecode(const AUrl: AnsiString): AnsiString;

//function GMDecodeURLParams(const AUrlParams: AnsiString): AnsiString;
//function GMEncodeURLParams(const AUrlParams: AnsiString): AnsiString;

function GMBuildUri(const AUriComponents: RGMUriComponents): TGMString; overload;
function GMBuildUri(const AScheme, AUser, APassword, AHost, APort, APath, AQuery, AFragment: TGMString): TGMString; overload;
function GMParseUri(const AUri: TGMString): RGMUriComponents;
function GMMakeUriDefaultScheme(const AUri: TGMString; const ADefaultScheme: TGMString): TGMString;
function GMMergeUris(const AMergeFromUri, AMergeToUri: TGMString; const AComponents: EGMInitUriComponents = cDfltUriComponents): TGMString;

function GMTimeZoneBias: LongInt;
function GMINetTimeZoneOffsetFromUtc(const ATimeZone: TGMString; const ACaller: TObject = nil): TDateTime;
function GetINetMonthNo(const AMonthName: TGMString; const ACaller: TObject = nil): Word;

function GMDecodeINetTimeToUtc(const ATimeValue: TGMString; const ACaller: TObject = nil): TDateTime;
function GMEncodeUtcToINetTime(const AUtcTime: TDateTime; const ACaller: TObject = nil): TGMString;

function GMIso8601DateTimeToStr(const ALocalTime: TDateTime): TGMString;

//function GMReadResponseLine(const AStream: ISequentialStream; const AProtocolDisplayName: TGMString; const ACaller: TObject): AnsiString;

function GMGetINetHeaderStrValue(const AHttpHeaders: IGMIntfCollection; const AHeaderName: TGMString; const ADefaultValue: TGMString = ''; const ACheckHeaderExists: Boolean = False; const ACaller: TObject = nil): TGMString;
function GMGetINetHeaderIntValue(const AHttpHeaders: IGMIntfCollection; const AHeaderName: TGMString; const ADefaultValue: Int64 = 0): Int64;

procedure GMAddINetHeader(const AHeaders: IGMIntfCollection; const AName: TGMString; const AValue: RGMUnionValue; const AAddStrategy: TGMINetHeaderAddMode = hamReplaceIfExists);
function GMHeadersAsString(const AHeaders: IGMIntfCollection): TGMString;

function GMSplitURIParams(const AURI: TGMString; const AParams: IGMIntfCollection): TGMString;

function GMDeleteCharsA(const AValue, ADelChars: AnsiString; const NotDelChars: Boolean = False): AnsiString;

function GMCharCodingOfContentType(const AContentType: TGMString; const ADefaultCharKind: TGMCharKind = ckUnknown): TGMCharKind;


// Helper routines

function Int16ToLittleEndian(AValue: SmallInt): SmallInt;
function UInt16ToLittleEndian(AValue: Word): Word;
function Int32ToLittleEndian(AValue: LongInt): LongInt;
function UInt32ToLittleEndian(AValue: LongWord): LongWord;
function Int64ToLittleEndian(AValue: Int64): Int64;

function Int16fromLittleEndian(AValue: SmallInt): SmallInt;
function UInt16FromLittleEndian(AValue: Word): Word;
function Int32FromLittleEndian(AValue: LongInt): LongInt;
function UInt32FromLittleEndian(AValue: LongWord): LongWord;
function Int64FromLittleEndian(AValue: Int64): Int64;


var

  vINetDayNames: array [0..6] of TGMString = ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat');

  vINetMonthNames: array [1..12] of TGMString = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');


resourcestring

  RStrInvalidItemFmt = 'Invalid %s: %s';
  RStrMonthName = 'month name';
  RStrHour = 'hour';
  RStrMinute = 'minute';
  RStrSecond = 'second';
  RStrMilliSecond = 'millisecond';
  RStrDay = 'day';
  RStrMonth = 'month';
  RStrYear = 'year';
  RStrTimeZone = 'time zone';

  RStrWrongContentType = 'The server response is of type "%s" instead of "%s"';

  RStrUnsupportedINetProtocol = 'Unsupported network protocol: "%s"';
  RStrHeaderFieldNotFound = 'Header field "%s" not found';


implementation

uses SysUtils {$IFDEF JEDIAPI},jwaWinBase, jwaWinNT{$ENDIF};

//const
//
//cStrWinINetDLL = 'WinINet.dll';

//INTERNET_RFC1123_FORMAT   =  0;
//INTERNET_RFC1123_BUFSIZE  = 35;

{$IFDEF UNICODE}
//function InternetTimeToSystemTime(lpszTime: PWideChar; out pst: TSystemTime; dwReserved: DWORD): BOOL; stdcall; external cStrWinINetDLL name 'InternetTimeToSystemTimeW';
//function InternetTimeFromSystemTime(const pst: TSystemTime; dwRFC: DWORD; lpszTime: PWideChar; cbTime: DWORD): BOOL; stdcall; external cStrWinINetDLL name 'InternetTimeFromSystemTimeW';
{$ELSE}
//function InternetTimeToSystemTime(lpszTime: PAnsiChar; out pst: TSystemTime; dwReserved: DWORD): BOOL; stdcall; external cStrWinINetDLL name 'InternetTimeToSystemTimeA';
//function InternetTimeFromSystemTime(const pst: TSystemTime; dwRFC: DWORD; lpszTime: PAnsiChar; cbTime: DWORD): BOOL; stdcall; external cStrWinINetDLL name 'InternetTimeFromSystemTimeA';
{$ENDIF}


resourcestring

  //RStrInvalidHeaderSeparator = 'Invalid %s Header separator';
  RStrInvalidCommandTerm = 'Invalid %s command response terminator';
  RStrInvalidResponeCodeFmt = 'Invalid %s command response code: %s';
  RStrCmdError = '%s "%s" command error (%s): %s';
  RStrTransportLayerStream = 'The transport layer stream';
//RStrBadResponseCode = 'The %s command returned a bad code: %s';
  RStrNoResponseCode = 'No code returned for %s command "%s"';
  RStrResponse = 'Response';


{ ------------------------- }
{ ---- Global Routines ---- }
{ ------------------------- }

function Int16ToLittleEndian(AValue: SmallInt): SmallInt;
begin
  // To Do: Swap if meory layout ist not little endian
  Result := AValue;
end;

function UInt16ToLittleEndian(AValue: Word): Word;
begin
  // To Do: Swap if meory layout ist not little endian
  Result := AValue;
end;

function Int32ToLittleEndian(AValue: LongInt): LongInt;
begin
  // To Do: Swap if meory layout ist not little endian
  Result := AValue;
end;

function UInt32ToLittleEndian(AValue: LongWord): LongWord;
begin
  // To Do: Swap if meory layout ist not little endian
  Result := AValue;
end;

function Int64ToLittleEndian(AValue: Int64): Int64;
begin
  // To Do: Swap if meory layout ist not little endian
  Result := AValue;
end;


function Int16fromLittleEndian(AValue: SmallInt): SmallInt;
begin
  // To Do: Swap if meory layout ist not little endian
  Result := AValue;
end;

function UInt16FromLittleEndian(AValue: Word): Word;
begin
  // To Do: Swap if meory layout ist not little endian
  Result := AValue;
end;

function Int32FromLittleEndian(AValue: LongInt): LongInt;
begin
  // To Do: Swap if meory layout ist not little endian
  Result := AValue;
end;

function UInt32FromLittleEndian(AValue: LongWord): LongWord;
begin
  // To Do: Swap if meory layout ist not little endian
  Result := AValue;
end;

function Int64FromLittleEndian(AValue: Int64): Int64;
begin
  // To Do: Swap if meory layout ist not little endian
  Result := AValue;
end;


function GMTimeZoneBias: LongInt;
var tzInfo: TTimeZoneInformation;
begin
  Result := 0;
  FillChar(tzInfo, SizeOf(tzInfo), 0);
  case GetTimeZoneInformation(tzInfo) of
    TIME_ZONE_ID_UNKNOWN:  Result := tzInfo.Bias;
    TIME_ZONE_ID_STANDARD: Result := tzInfo.Bias + tzInfo.StandardBias;
    TIME_ZONE_ID_DAYLIGHT: Result := tzInfo.Bias + tzInfo.DaylightBias;
    TIME_ZONE_ID_INVALID: GMAPICheckObj('GetTimeZoneInformation', '', GetLastError, False);
  end;
end;

function GMINetTimeZoneOffsetFromUtc(const ATimeZone: TGMString; const ACaller: TObject): TDateTime;
type TTimeZoneDelta = record ZoneName: TGMString; DeltaHours: LongInt; end;
const cOneHour = 1 / 24; cOneMinute = cOneHour / 60;
      // see: http://www.timeanddate.com/library/abbreviations/timezones/
      cTimeZones: array [0..50] of TTimeZoneDelta = (
        (ZoneName: 'NZDT'; DeltaHours: 13), (ZoneName: 'IDLE'; DeltaHours: 12), (ZoneName: 'NZST'; DeltaHours: 12),
        (ZoneName: 'NZT'; DeltaHours: 12), (ZoneName: 'EADT'; DeltaHours: 11), (ZoneName: 'GST'; DeltaHours: 10),
        (ZoneName: 'JST'; DeltaHours: 9), (ZoneName: 'CCT'; DeltaHours: 8), (ZoneName: 'WADT'; DeltaHours: 8),
        (ZoneName: 'WAST'; DeltaHours: 7), (ZoneName: 'ZP6'; DeltaHours: 6), (ZoneName: 'ZP5'; DeltaHours: 5),
        (ZoneName: 'ZP4'; DeltaHours: 4), (ZoneName: 'BT'; DeltaHours: 3), (ZoneName: 'EET'; DeltaHours: 2),
        (ZoneName: 'MEST'; DeltaHours: 2), (ZoneName: 'MESZ'; DeltaHours: 2), (ZoneName: 'SST'; DeltaHours: 2),
        (ZoneName: 'FST'; DeltaHours: 2), (ZoneName: 'CEST'; DeltaHours: 2), (ZoneName: 'CET'; DeltaHours: 1),
        (ZoneName: 'FWT'; DeltaHours: 1), (ZoneName: 'MET'; DeltaHours: 1), (ZoneName: 'MEWT'; DeltaHours: 1),
        (ZoneName: 'SWT'; DeltaHours: 1), (ZoneName: 'UT'; DeltaHours: 0), (ZoneName: 'UTC'; DeltaHours: 0),
        (ZoneName: 'GMT'; DeltaHours: 0), (ZoneName: 'WET'; DeltaHours: 0), (ZoneName: 'WAT'; DeltaHours: -1),
        (ZoneName: 'BST'; DeltaHours: -1), (ZoneName: 'AT'; DeltaHours: -2), (ZoneName: 'ADT'; DeltaHours: -3),
        (ZoneName: 'AST'; DeltaHours: -4), (ZoneName: 'EDT'; DeltaHours: -4), (ZoneName: 'EST'; DeltaHours: -5),
        (ZoneName: 'CDT'; DeltaHours: -5), (ZoneName: 'CST'; DeltaHours: -6), (ZoneName: 'MDT'; DeltaHours: -6),
        (ZoneName: 'MST'; DeltaHours: -7), (ZoneName: 'PDT'; DeltaHours: -7), (ZoneName: 'PST'; DeltaHours: -8),
        (ZoneName: 'YDT'; DeltaHours: -8), (ZoneName: 'YST'; DeltaHours: -9), (ZoneName: 'HDT'; DeltaHours: -9),
        (ZoneName: 'AHST'; DeltaHours: -10), (ZoneName: 'CAT'; DeltaHours: -10), (ZoneName: 'HST'; DeltaHours: -10),
        (ZoneName: 'EAST'; DeltaHours: -10), (ZoneName: 'NT'; DeltaHours: -11), (ZoneName: 'IDLW'; DeltaHours: -12));

var i: LongInt;
begin
  if (Length(ATimeZone) <= 0) or ((Length(ATimeZone) = 1) and (GMUpCase(ATimeZone[1]) = 'Z')) then begin Result := 0; Exit; end;

  if (Length(ATimeZone) > 0) and GMIsDelimiter('+-', ATimeZone, 1) then
   begin
    Result := StrToIntDef(Copy(ATimeZone, 2, 2), 0) * cOneHour + StrToIntDef(Copy(ATimeZone, 4, 2), 0) * cOneMinute;
    if (ATimeZone[1] = '-') then
     if Result <> 0 then Result := Result * -1 else Result := -GMTimeZoneBias * cOneMinute;
   end
  else
   begin
    for i:=Low(cTimeZones) to High(cTimeZones) do
     if GMSameText(ATimeZone, cTimeZones[i].ZoneName) then
      begin Result := cTimeZones[i].DeltaHours * cOneHour; Exit; end;

    raise EGMINetException.ObjError(GMFormat(RStrInvalidItemFmt, [RStrTimeZone, ATimeZone]), ACaller);
   end;
end;

function GetINetMonthNo(const AMonthName: TGMString; const ACaller: TObject): Word;
begin
  for Result:=Low(vINetMonthNames) to High(vINetMonthNames) do if GMSameText(AMonthName, vINetMonthNames[Result]) then Exit;
  raise EGMINetException.ObjError(GMFormat(RStrInvalidItemFmt, [RStrMonthName, AMonthName]), ACaller);
end;

function GMNextDigitToken(var AChPos: LongInt; const AValue: TGMString; const ASkipLeadingNonDigits: Boolean = True): TGMString;
var startPos: Integer;
begin
  if ASkipLeadingNonDigits then while (AChPos <= Length(AValue)) and not GMIsDigit(AValue[AChPos]) do Inc(AChPos);
  startPos := AChPos;
  while (AChPos <= Length(AValue)) and GMIsDigit(AValue[AChPos]) do Inc(AChPos);
  if AChPos > startPos then Result := Copy(AValue, startPos, AChPos-startPos) else Result := '';
  {if SkipSeparators then} while (AChPos <= Length(AValue)) and GMIsDelimiter(cWhiteSpace, AValue, AChPos) do Inc(AChPos);
end;

function GMNextLetterToken(var AChPos: LongInt; const AValue: TGMString; const ASkipLeadingNonLetters: Boolean = True): TGMString;
var startPos: Integer;
begin
  if ASkipLeadingNonLetters then while (AChPos <= Length(AValue)) and not GMIsLetter(AValue[AChPos]) do Inc(AChPos);
  startPos := AChPos;
  while (AChPos <= Length(AValue)) and GMIsLetter(AValue[AChPos]) do Inc(AChPos);
  if AChPos > startPos then Result := Copy(AValue, startPos, AChPos-startPos) else Result := '';
  {if SkipSeparators then} while (AChPos <= Length(AValue)) and GMIsDelimiter(cWhiteSpace, AValue, AChPos) do Inc(AChPos);
end;

function GMAdjust2DigitYears(AYear: Integer): Integer;
const cOneCentury: array [Boolean] of Integer = (0, 1);
var year, month, day: Word; // negMul: Integer;
begin
  // NOTE: Apply this to positive years only!
//if AYear < 0 then begin AYear := -AYear; negMul := -1; end else negMul := 1;
  if (AYear >= 0) and (AYear < 100) then
   begin
    DecodeDate(Now, year, month, day);
    Result := ((((year div 100) - cOneCentury[AYear > 50]) * 100) + AYear); // * negMul;
   end
  else Result := AYear; // * negMul;
end;

procedure GMParseTime(const ATimeValue: TGMString; var AChPos: Integer; var AHour, AMinute, ASecond, AMilliSecond: Word; const ACaller: TObject);
var token: TGMString;
begin
  AHour := 0; AMinute := 0; ASecond := 0; AMilliSecond := 0;

  if (AChPos <= Length(ATimeValue)) and not GMIsDigit(ATimeValue[AChPos]) then Exit;
  token := GMNextDigitToken(AChPos, ATimeValue);
  AHour := GMStrToInt(GMMakeDezInt(token, -1));
  if not GMIsInRange(AHour, 0, 23) then raise EGMINetException.ObjError(GMFormat(RStrInvalidItemFmt, [RStrHour, token]), ACaller);

  if (AChPos <= Length(ATimeValue)) and (ATimeValue[AChPos] <> ':') then Exit;
  token := GMNextDigitToken(AChPos, ATimeValue);
  AMinute := GMStrToInt(GMMakeDezInt(token, -1));
  if not GMIsInRange(AMinute, 0, 59) then raise EGMINetException.ObjError(GMFormat(RStrInvalidItemFmt, [RStrMinute, token]), ACaller);

  if (AChPos <= Length(ATimeValue)) and (ATimeValue[AChPos] <> ':') then Exit;
  token := GMNextDigitToken(AChPos, ATimeValue);
  ASecond := GMStrToInt(GMMakeDezInt(token, -1));
  if not GMIsInRange(ASecond, 0, 59) then raise EGMINetException.ObjError(GMFormat(RStrInvalidItemFmt, [RStrSecond, token]), ACaller);

  if (AChPos <= Length(ATimeValue)) and (ATimeValue[AChPos] <> '.') then Exit;
  token := GMNextDigitToken(AChPos, ATimeValue);
  AMilliSecond := GMStrToInt(GMMakeDezInt(token, -1));
  if not GMIsInRange(ASecond, 0, 999) then raise EGMINetException.ObjError(GMFormat(RStrInvalidItemFmt, [RStrMilliSecond, token]), ACaller);
end;

function GMDecodeRfcINetTime(const ATimeValue: TGMString; var AChPos: Integer; const ACaller: TObject): TDateTime;
var token: TGMString; hour, min, sec, milliSec, month, day: Word; year: Integer;
begin
  token := GMNextDigitToken(AChPos, ATimeValue);
  day := GMStrToInt(GMMakeDezInt(token, -1));
  if not GMIsInRange(day, 1, 31) then raise EGMINetException.ObjError(GMFormat(RStrInvalidItemFmt, [RStrDay, token]), ACaller);

  token := GMNextLetterToken(AChPos, ATimeValue);
  month := GetINetMonthNo(token, ACaller);

  token := GMNextDigitToken(AChPos, ATimeValue);
  year := GMAdjust2DigitYears(GMStrToInt(GMMakeDezInt(token, Low(Integer))));
  if year = Low(Integer) then raise EGMINetException.ObjError(GMFormat(RStrInvalidItemFmt, [RStrYear, token]), ACaller);

  GMParseTime(ATimeValue, AChPos, hour, min, sec, milliSec, ACaller);

  Result := EncodeTime(hour, min, sec, milliSec) + EncodeDate(year, month, day) - GMINetTimeZoneOffsetFromUtc(Copy(ATimeValue, AChPos, Length(ATimeValue) - AChPos + 1), ACaller);
end;

function GMDecodeIsoINetTime(const ATimeValue: TGMString; var AChPos: Integer; const ACaller: TObject): TDateTime;
var token: TGMString; hour, min, sec, milliSec, month, day: Word; year: Integer;
begin
  day := 1; month := 1;

  token := GMNextDigitToken(AChPos, ATimeValue);
  year := GMAdjust2DigitYears(GMStrToInt(GMMakeDezInt(token, Low(Integer))));
  if year = Low(Integer) then raise EGMINetException.ObjError(GMFormat(RStrInvalidItemFmt, [RStrYear, token]), ACaller);

  if (AChPos <= Length(ATimeValue)) and (ATimeValue[AChPos] <> 'T') then
   begin
    token := GMNextDigitToken(AChPos, ATimeValue);
    month := GMStrToInt(GMMakeDezInt(token, -1));
    if not GMIsInRange(month, 1, 12) then raise EGMINetException.ObjError(GMFormat(RStrInvalidItemFmt, [RStrMonth, token]), ACaller);

    if (AChPos <= Length(ATimeValue)) and (ATimeValue[AChPos] <> 'T') then
     begin
      token := GMNextDigitToken(AChPos, ATimeValue);
      day := GMStrToInt(GMMakeDezInt(token, -1));
      if not GMIsInRange(day, 1, 31) then raise EGMINetException.ObjError(GMFormat(RStrInvalidItemFmt, [RStrDay, token]), ACaller);
     end;
   end;

  if (AChPos <= Length(ATimeValue)) and (ATimeValue[AChPos] = 'T') then Inc(AChPos);
  while (AChPos <= Length(ATimeValue)) and GMIsDelimiter(cWhiteSpace, ATimeValue, AChPos) do Inc(AChPos);

  GMParseTime(ATimeValue, AChPos, hour, min, sec, milliSec, ACaller);

  Result := EncodeTime(hour, min, sec, milliSec) + EncodeDate(year, month, day) - GMINetTimeZoneOffsetFromUtc(Copy(ATimeValue, AChPos, Length(ATimeValue) - AChPos + 1), ACaller);
end;

function GMDecodeINetTimeToUtc(const ATimeValue: TGMString; const ACaller: TObject): TDateTime;
var chPos: Integer; isRFCFmt: Boolean;
begin
//GMApiCheckObj(GetLastError, InternetTimeToSystemTime(PGMChar(ATimeValue), systemTime, 0), 'InternetTimeToSystemTime("'+ATimeValue+'")', ACaller);
//Result := SystemTimeToDateTime(systemTime);

  chPos := 1; isRFCFmt := False;
  while (chPos <= Length(ATimeValue)) and not GMIsDigit(ATimeValue[chPos]) do
   begin
//  isRFCFmt := isRFCFmt or GMIsInRange(Ord(GMUpCase(ATimeValue[chPos])), Ord('A'), Ord('Z'));
    if GMIsLetter(ATimeValue[chPos]) then isRFCFmt := True;
    Inc(chPos);
   end;

  if isRFCFmt then
   Result := GMDecodeRfcINetTime(ATimeValue, chPos, ACaller)
  else
   Result := GMDecodeIsoINetTime(ATimeValue, chPos, ACaller);
end;

function GMEncodeUtcToINetTime(const AUtcTime: TDateTime; const ACaller: TObject): TGMString;
var st: TSystemTime;
begin
   DateTimeToSystemTime(AUtcTime, st);
   Result := GMFormat('%s, %2d %s %4d %2d:%2d:%2d GMT', [vINetDayNames[st.wDayOfWeek], st.wDay,
                       vINetMonthNames[st.wMonth], st.wYear, st.wHour, st.wMinute, st.wSecond]);

// SetLength(bufStr, INTERNET_RFC1123_BUFSIZE);
// GMApiCheckObj(GetLastError, InternetTimeFromSystemTime(st, INTERNET_RFC1123_FORMAT, PGMChar(bufStr), (Length(bufStr)+1) * SizeOf(TGMChar)), 'InternetTimeFromSystemTime("'+DateTimeToStr(AUtcTime)+'")', ACaller);
// SetString(Result, PGMChar(bufStr), GMStrLen(PGMChar(bufStr), Length(bufStr)));
end;

function GMIso8601DateTimeToStr(const ALocalTime: TDateTime): TGMString;
//const cDiffSign: array [Boolean] of TGMString = ('+', '-');
//var DiffToUTC: TDateTime;
begin
//DiffToUTC := GMLocalToUTCTimeDiff;
//Result := FormatDateTime('yyyy"-"mm"-"dd"T"hh":"nn":"ss', ALocalTime) +
//          cDiffSign[DiffToUTC < 0] + FormatDateTime('hh":"nn', Abs(DiffToUTC));
  Result := FormatDateTime('yyyy"-"mm"-"dd"T"hh":"nn":"ss"Z"', GMLocalTimeToUTC(ALocalTime));
end;


function GMDeleteCharsA(const AValue, ADelChars: AnsiString; const NotDelChars: Boolean = False): AnsiString;
var i: LongInt;
begin
  Result := AValue;
  i:=1;
  if NotDelChars then
   while i<= Length(Result) do if not GMIsDelimiterA(ADelChars, Result, i) then System.Delete(Result, i, 1) else Inc(i)
  else
   while i<= Length(Result) do if GMIsDelimiterA(ADelChars, Result, i) then System.Delete(Result, i, 1) else Inc(i);
end;

function GMUriDecode(const AUrl: AnsiString): AnsiString;
var i: integer;
begin
  Result := AUrl;
  i := 1;
  while i <= Length(Result) do
   begin
    case Result[i] of
     '%': begin
           Result[i] := Chr(GMStrToInt('$' + Copy(Result, i+1, 2)));
           System.Delete(Result, i+1, 2);
          end;
     '+': Result[i] := ' ';
    end;

    //if Result[i] = '%' then
    // begin
    //  Result[i] := Chr(GMStrToInt('$' + Copy(Result, i+1, 2)));
    //  System.Delete(Result, i+1, 2);
    // end;
    Inc(i);
   end;
end;

function GMUriEncode(const AUrl: AnsiString; const AIgnorePercentChars: Boolean): AnsiString;
var i: Integer;
begin
  Result := AUrl;
  i:=1;
  while i <= Length(Result) do
   begin
    if ((Result[i] >= #48) and (Result[i] <= #57)) or ((Result[i] >= #65) and (Result[i] <= #90)) or
       ((Result[i] >= #97) and (Result[i] <= #122)) or (Result[i] in cUriNotPercentEncodeChars) or
       (AIgnorePercentChars and (Result[i] = '%')) then Inc(i) else
       //GMIsDelimiter(cUriReservedChars, Result, i) then Inc(i) else
     begin
      Insert(IntToHex(Ord(Result[i]), 2), Result, i+1);
      Result[i] := '%';
      Inc(i, 3);
     end;
   end;
end;

function GMInitUriComponents(const AScheme, AUser, APassword, AHost, APort, APath, AQuery, AFragment: TGMString): RGMUriComponents;
begin
  Result.Scheme := AScheme;
  Result.User := AUser;
  Result.Password := APassword;
  Result.Host := AHost;
  Result.Port := APort;
  Result.Path := APath;
  Result.Query := AQuery;
  Result.Fragment := AFragment;
end;

function GMBuildUri(const AScheme, AUser, APassword, AHost, APort, APath, AQuery, AFragment: TGMString): TGMString; overload;
var userInfo, hostInfo: TGMString;
begin
  if Length(AScheme) > 0 then Result := AScheme + ':' else Result := '';

  if (Length(AUser) > 0) or (Length(APassword) > 0) or
     (Length(AHost) > 0) or (Length(APort) > 0) then
   begin
    userInfo := AUser;
    if Length(APassword) > 0 then userInfo := userInfo + ':' + APassword;

    hostInfo := AHost;
    if Length(APort) > 0 then hostInfo := hostInfo + ':' + APort;

    Result := Result + '//' + GMStringJoin(userInfo, '@', hostInfo);
//  if (Length(AUriComponents.Path) <= 0) or (AUriComponents.Path[1] <> '/') then AUriComponents.Path := '/' + AUriComponents.Path;
   end;

  Result := Result + APath;

  Result := GMStringJoin(Result, '?', AQuery);
  Result := GMStringJoin(Result, '#', AFragment);
end;

function GMBuildUri(const AUriComponents: RGMUriComponents): TGMString;
begin
  Result := GMBuildUri(AUriComponents.Scheme, AUriComponents.User, AUriComponents.Password, AUriComponents.Host,
                       AUriComponents.Port, AUriComponents.Path, AUriComponents.Query, AUriComponents.Fragment);
end;

function NextUrlPart(const AValue: TGMString; var ApCh: PGMChar; ADelimChar: TGMChar): TGMString; // AResetIfNotFound: Boolean
var pCh: PGMChar; valLen: Integer;
begin
  Result := '';
  if ApCh = nil then Exit;
  pCh := ApCh; valLen := Length(AValue);
  ApCh := GMStrLScan(pCh, ADelimChar, PGMChar(AValue) + valLen - pCh);
  if ApCh = nil then Result := Copy(AValue, pCh - PGMChar(AValue) + 1, PGMChar(AValue) + valLen - pCh) else
   begin
    Result := Copy(AValue, pCh - PGMChar(AValue) + 1, ApCh - pCh);
    Inc(ApCh);
   end;
//else
// if AResetIfNotFound then ApCh := pCh else
//  Result := Copy(AValue, pCh - PGMChar(AValue) + 1, PGMChar(AValue) + valLen - pCh);
end;

//function NextUrlPart2(const AValue: AnsiString; var ApCh: PAnsiChar; ADelimChars: AnsiString): AnsiString;
//var i: Integer; pCh, pChStart: PAnsiChar; valLen: Integer;
//begin
//if ApCh = nil then begin Result := ''; Exit; end;
//pCh := ApCh; valLen := Length(AValue);
//for i:=1 to Length(ADelimChars) do
// begin
//  ApCh := GMStrLScanA(pCh, ADelimChars[i], PAnsiChar(AValue) + valLen - pCh);
//  if ApCh <> nil then
//    begin
//     Result := Copy(AValue, pCh - PAnsiChar(AValue) + 1, ApCh - pCh);
//     Inc(ApCh);
//     Exit;
//    end;
// end;
//
//Result := Copy(AValue, pCh - PAnsiChar(AValue) + 1, PAnsiChar(AValue) + valLen - pCh);
//end;


//function GMParseUri(const AUri: TGMString): RGMUriComponents;
//var hierPart: TGMString; pCh, pChStart: PGMChar;
//procedure ParseUserInfo(const AValue: TGMString);
//var pCh: PGMChar;
//begin
//  pCh := PGMChar(AValue);
//  Result.User := NextUrlPart(AValue, pCh, ':');
//  if pCh <> nil then Result.Password := Copy(AValue, pCh - PGMChar(AValue) + 1, PGMChar(AValue) + Length(AValue) - pCh);
//end;
//
//procedure ParseHostAndPort(const AValue: TGMString);
//var pCh: PGMChar;
//begin
//  pCh := PGMChar(AValue);
//  Result.Host := NextUrlPart(AValue, pCh, ':');
//  if pCh <> nil then Result.Port := Copy(AValue, pCh - PGMChar(AValue) + 1, PGMChar(AValue) + Length(AValue) - pCh);
//end;
//
//procedure ParseAuthority(const AValue: TGMString);
//var pCh: PGMChar; userInfo: TGMString;
//begin
//  pCh := PGMChar(AValue);
//  userInfo := NextUrlPart(AValue, pCh, '@');
//  if pCh <> nil then ParseUserInfo(userInfo) else pCh := PGMChar(AValue);
//  ParseHostAndPort(Copy(AValue, pCh - PGMChar(AValue) + 1, PGMChar(AValue) + Length(AValue) - pCh));
//end;
//
//procedure ParseHierPart(const AValue: TGMString);
//var pCh: PGMChar;
//begin
//  if Copy(AValue, 1, 2) <> '//' then Result.Path := AValue else
//   begin
//    pCh := PGMChar(AValue) + 2;
//    ParseAuthority(NextUrlPart(AValue, pCh, '/'));
//    Result.Path := Copy(AValue, pCh - PGMChar(AValue), PGMChar(AValue) + Length(AValue) - pCh + 1);
//   end;
//end;
//
//begin
//Result := GMInitUriComponents('', '', '', '', '', '', '', '');
//
//pCh := PGMChar(AUri);
//Result.Scheme := NextUrlPart(AUri, pCh, ':');
//if pCh = nil then Exit;
//
//pChStart := pCh;
//hierPart := NextUrlPart(AUri, pCh, '?');
//
//if pCh = nil then
// begin
//  Result.Query := '';
//  pCh := pChStart;
//  hierPart := NextUrlPart(AUri, pCh, '#');
// end
//else
// Result.Query := NextUrlPart(AUri, pCh, '#');
//
//ParseHierPart(hierPart);
//if pCh = nil then Exit;
//
//Result.Fragment := Copy(AUri, pCh - PGMChar(AUri) + 1, PGMChar(AUri) + Length(AUri) - pCh);
//end;


function GMParseUri(const AUri: TGMString): RGMUriComponents;
var hierPart: TGMString; pCh, pChStart: PGMChar; chPos: Integer;
  procedure ParseUserInfo(const AValue: TGMString);
  var pCh: PGMChar;
  begin
    pCh := PGMChar(AValue);
    Result.User := NextUrlPart(AValue, pCh, ':');
    if pCh <> nil then Result.Password := Copy(AValue, pCh - PGMChar(AValue) + 1, PGMChar(AValue) + Length(AValue) - pCh);
  end;

  procedure ParseHostAndPort(const AValue: TGMString);
  var pCh: PGMChar;
  begin
    pCh := PGMChar(AValue);
    Result.Host := NextUrlPart(AValue, pCh, ':');
    if pCh <> nil then Result.Port := Copy(AValue, pCh - PGMChar(AValue) + 1, PGMChar(AValue) + Length(AValue) - pCh);
  end;

  procedure ParseAuthority(const AValue: TGMString);
  var pCh: PGMChar; userInfo: TGMString;
  begin
    pCh := PGMChar(AValue);
    userInfo := NextUrlPart(AValue, pCh, '@');
    if pCh <> nil then ParseUserInfo(userInfo) else pCh := PGMChar(AValue);
    ParseHostAndPort(Copy(AValue, pCh - PGMChar(AValue) + 1, PGMChar(AValue) + Length(AValue) - pCh));
  end;

  procedure ParseHierPart(const AValue: TGMString);
  var pCh: PGMChar;
  begin
    if Copy(AValue, 1, 3) = '///' then Result.Path := Copy(AValue, 4, Length(AValue)-3)
    else
    if Copy(AValue, 1, 2) <> '//' then Result.Path := AValue else
     begin
      pCh := PGMChar(AValue) + 2;
      ParseAuthority(NextUrlPart(AValue, pCh, '/'));
      Result.Path := Copy(AValue, pCh - PGMChar(AValue), PGMChar(AValue) + Length(AValue) - pCh + 1);
      if Length(Result.Path) <= 0 then Result.Path := '/';
     end;
  end;

begin
  Result := GMInitUriComponents('', '', '', '', '', '', '', '');

//pCh := PGMChar(AUri);
//Result.Scheme := NextUrlPart(AUri, pCh, ':');
//if pCh = nil then Exit;

  chPos := Pos('://', AUri);
  if chPos > 0 then
   begin
    Result.Scheme := Copy(AUri, 1, chPos-1);
    pCh := PGMChar(AUri) + chPos;
   end
  else
   pCh := PGMChar(AUri); // Result.Scheme := '';

  pChStart := pCh;
  hierPart := NextUrlPart(AUri, pCh, '?');

  if pCh = nil then
   begin
    Result.Query := '';
    pCh := pChStart;
    hierPart := NextUrlPart(AUri, pCh, '#');
   end
  else
   Result.Query := NextUrlPart(AUri, pCh, '#');

  ParseHierPart(hierPart);
  if pCh = nil then Exit;

  Result.Fragment := Copy(AUri, pCh - PGMChar(AUri) + 1, PGMChar(AUri) + Length(AUri) - pCh);
end;

function GMMakeUriDefaultScheme(const AUri: TGMString; const ADefaultScheme: TGMString): TGMString;
var chPos: PtrInt;
begin
  chPos := 1;
  if GMFindToken(AUri, '://', chPos, '', False, False) then Result := AUri else Result := GMStripRight(ADefaultScheme, '/:') + '://' + AUri;
end;

function GMMergeUris(const AMergeFromUri, AMergeToUri: TGMString; const AComponents: EGMInitUriComponents): TGMString;
var srcUriComponents, dstUriComponents: RGMUriComponents;
begin
  srcUriComponents := GMParseUri(AMergeFromUri);
  dstUriComponents := GMParseUri(AMergeToUri);

  if (uriScheme in AComponents) and (Length(dstUriComponents.Scheme) <= 0) then dstUriComponents.Scheme := srcUriComponents.Scheme;
  if (uriUser in AComponents) and (Length(dstUriComponents.User) <= 0) then dstUriComponents.User := srcUriComponents.User;
  if (uriPassword in AComponents) and (Length(dstUriComponents.Password) <= 0) then dstUriComponents.Password := srcUriComponents.Password;
  if (uriHost in AComponents) and (Length(dstUriComponents.Host) <= 0) then dstUriComponents.Host := srcUriComponents.Host;
  if (uriPort in AComponents) and (Length(dstUriComponents.Port) <= 0) then dstUriComponents.Port := srcUriComponents.Port;

  if uriPath in AComponents then
   begin
    if (Length(dstUriComponents.Path) > 0) and GMIsRelativePath(dstUriComponents.Path) then
     begin
      if Length(srcUriComponents.Path) > 0 then
        dstUriComponents.Path := GMAppendPath(srcUriComponents.Path, dstUriComponents.Path, '/')
      else
       dstUriComponents.Path := '/' + dstUriComponents.Path;
     end
    else
     if Length(dstUriComponents.Path) <= 0 then dstUriComponents.Path := srcUriComponents.Path;
   end;

  if (uriQuery in AComponents) and (Length(dstUriComponents.Query) <= 0) then dstUriComponents.Query := srcUriComponents.Query;
  if (uriFragment in AComponents) and (Length(dstUriComponents.Fragment) <= 0) then dstUriComponents.Fragment := srcUriComponents.Fragment;

  Result := GMBuildUri(dstUriComponents);
end;

//function GMDecodeURLParams(const AUrlParams: AnsiString): AnsiString;
//var i: LongInt;
//begin
//  Result := AUrlParams;
//  for i:=1 to Length(Result) do if Result[i] = '+' then Result[i] := ' ';
//end;

//function GMEncodeURLParams(const AUrlParams: AnsiString): AnsiString;
//var i: LongInt;
//begin
//  Result := AUrlParams;
//  for i:=1 to Length(Result) do if Result[i] = ' ' then Result[i] := '+';
//end;

function CreateHeaderCollection: IGMIntfCollection;
begin
  Result := TGMIntfArrayCollection.Create(True, True, GMCompareByName, True); // <- Allow duplicate Headers!
end;

function GMGetINetHeaderStrValue(const AHttpHeaders: IGMIntfCollection; const AHeaderName, ADefaultValue: TGMString; const ACheckHeaderExists: Boolean; const ACaller: TObject): TGMString;
const cStrRoutineName = 'GMGetINetHeaderStrValue';
var searchName, foundEntry: IUnknown; strVal: IGMGetStringValue;
begin
  if AHttpHeaders = nil then begin Result := ADefaultValue; Exit; end;
  searchName := TGMNameObj.Create(AHeaderName, True);
  if not AHttpHeaders.Find(searchName, foundEntry) then
   begin
    if ACheckHeaderExists then raise EGMINetException.ObjError(GMFormat(RStrHeaderFieldNotFound, [AHeaderName]), ACaller, cStrRoutineName);
    Result := ADefaultValue;
   end
  else
   if GMQueryInterface(foundEntry, IGMGetStringValue, strVal) then Result := strVal.StringValue else Result := ADefaultValue;
end;

function GMGetINetHeaderIntValue(const AHttpHeaders: IGMIntfCollection; const AHeaderName: TGMString; const ADefaultValue: Int64 = 0): Int64;
var valStr: TGMString;
begin
  valStr := GMGetINetHeaderStrValue(AHttpHeaders, AHeaderName, GMIntToStr(ADefaultValue));
  Result := GMStrToInt64(GMMakeDezInt(valStr, ADefaultValue));
end;

procedure GMAddINetHeader(const AHeaders: IGMIntfCollection; const AName: TGMString; const AValue: RGMUnionValue; const AAddStrategy: TGMINetHeaderAddMode = hamReplaceIfExists);
var searchName, unkHeader: IUnknown; setHeaderValue: IGMGetSetUnionValue;
begin
  if AHeaders = nil then Exit;
  searchName := TGMNameObj.Create(AName, True);
  case AAddStrategy of
   hamAlwaysAdd: AHeaders.Add(TGMINetHeaderEntry.Create(AName, AValue.AsStringDflt, True));

   hamAddIfNew:
    if not AHeaders.Find(searchName, unkHeader) then AHeaders.Add(TGMINetHeaderEntry.Create(AName, AValue.AsStringDflt, True));

   hamReplaceIfExists:
    if not AHeaders.Find(searchName, unkHeader) or not GMQueryInterface(unkHeader, IGMGetSetUnionValue, setHeaderValue) then
     AHeaders.Add(TGMINetHeaderEntry.Create(AName, AValue.AsStringDflt, True))
    else
     setHeaderValue.Value := AValue;

   hamCoalesce:
    if not AHeaders.Find(searchName, unkHeader) or not GMQueryInterface(unkHeader, IGMGetSetUnionValue, setHeaderValue) then
     AHeaders.Add(TGMINetHeaderEntry.Create(AName, AValue.AsStringDflt, True))
    else
     setHeaderValue.Value := GMStringJoin(setHeaderValue.Value, '; ', AValue.AsStringDflt);
  end;
end;

function GMHeadersAsString(const AHeaders: IGMIntfCollection): TGMString;
var it: IGMIterator; unkHdr: IUnknown; name: IGMGetName; value: IGMGetStringValue;
begin
  Result := '';
  if AHeaders <> nil then
   begin
    it := AHeaders.CreateIterator;
    while it.NextEntry(unkHdr) do
     if GMQueryInterface(unkHdr, IGMGetName, name) and GMQueryInterface(unkHdr, IGMGetStringValue, value) then
      Result := GMStringJoin(Result, CRLF, name.Name + ': ' + value.StringValue);
   end;

//Result := GMStringJoin(AMethodHeader, CRLF, Result) + CRLF + CRLF;
//Result := GMStrArrayAsText(AHeaders, CRLF) + CRLF + CRLF;
end;

function GMSplitURIParams(const AURI: TGMString; const AParams: IGMIntfCollection): TGMString;
var paramStr, pair, name, value: TGMString; chPos, i, j: PtrInt;
begin
  chPos := 1;
  Result := GMNextWord(chPos, AURI, '?');
//Result := GMNextWord(chPos, AURI, '?', False);
  if AParams = nil then Exit;
  paramStr := Copy(AURI, chPos, Length(AURI) - chPos + 1);
  i := 1;
  repeat
   pair := GMNextWord(i, paramStr, '&');
   if Length(pair) > 0 then
    begin
     j := 1;
     name := GMStrip(GMNextWord(j, pair, '='));
     value := Copy(pair, j, Length(pair)-j+1);
     if Length(name) > 0 then AParams.Add(TGMNameAndStrValueObj.Create(name, value));
    end;
  until i > Length(paramStr);
end;

//function GMSplitURIParams(const AURL: TGMString; const AParams: IGMIntfCollection): TGMString;
//var params, pair, name, value: TGMString; i, j: LongInt;
//begin
//Result := GMFirstWord(AURL, '?', False);
//if AParams = nil then Exit;
//params := Copy(AURL, Length(Result)+2, Length(AUrl) - Length(Result) + 1);
//i := 1;
//repeat
// pair := GMNextWord(i, params, '&');
// if Length(pair) > 0 then
//  begin
//   j := 1;
//   name := GMStrip(GMNextWord(j, pair, '='));
//   value := Copy(pair, j, Length(pair)-j+1);
//   if Length(name) > 0 then AParams.Add(TGMNameAndStrValueObj.Create(name, value));
//  end;
//until i > Length(params);
//end;

function GMCharCodingOfContentType(const AContentType: TGMString; const ADefaultCharKind: TGMCharKind = ckUnknown): TGMCharKind;
var chPos, chPos2: PtrInt; token, valName, val: TGMString;
begin
  Result := ADefaultCharKind;
  chPos := 1;
  repeat
   token := GMStrip(GMNextWord(chPos, AContentType, ';'));
   if Length(token) > 0 then
    begin
     chPos2 := 1;
     valName := GMStrip(GMNextWord(chPos2, token, '='));
     if GMSameText(valName, 'charset') then
      begin
       val := GMStrip(Copy(token, chPos2, Length(token) - chPos2 + 1));
       if GMSameText(val, 'utf-8') then Result := ckUtf8
       else
       if GMSameText(val, 'ISO-8859-1') then Result := ckAnsi;
      end;
    end;
  until Length(token) <= 0;
end;


{ ---------------------------- }
{ ---- TGMINetHeaderEntry ---- }
{ ---------------------------- }

constructor TGMINetHeaderEntry.Create(const AHeaderLine: TGMString; const ARefLifeTime: Boolean);
var chPos: PtrInt; valName: TGMString;
begin
  chPos := 1;
  valName := GMNextWord(chPos, AHeaderLine, ':');
  inherited Create(valName, GMStripLeft(Copy(AHeaderLine, chPos, Length(AHeaderLine) - chPos + 1)), ARefLifeTime);
end;


{ ------------------------------- }
{ ---- TGMInetHeaderIterator ---- }
{ ------------------------------- }

constructor TGMInetHeaderIterator.Create(const ABaseIterator: IGMIterator; const AHeaderName: TGMString; const ARefLifeTime: Boolean);
begin
  inherited Create(ARefLifeTime);
  FBaseIterator := ABaseIterator;
  FHeaderName := AHeaderName;
end;

procedure TGMInetHeaderIterator.Reset;
begin                                                                                   
  if FBaseIterator <> nil then FBaseIterator.Reset;
end;

function TGMInetHeaderIterator.NextEntry(out AEntry): Boolean;
var unkHdr: IUnknown; hdrName: IGMGetName;
begin
  if (FBaseIterator = nil) or (Length(FHeaderName) <= 0) then Result := False else
   begin
    while FBaseIterator.NextEntry(unkHdr) do
     begin
      if GMQueryInterface(unkHdr, IGMGetName, hdrName) and GMSameText(hdrName.Name, FHeaderName) then
       begin
        IUnknown(AEntry) := unkHdr;
        Result := True;
        Exit; // <- NOTE: Exit Here!
       end;
     end;

    Result := False;
   end;
end;


{ ----------------------------- }
{ ---- TGMINetProtocolBase ---- }
{ ----------------------------- }

//constructor TGMINetProtocolBase.Create(const ATransportLayer: ISequentialStream; const ARefLifeTime: Boolean);
//begin
////inherited
//Create(ARefLifeTime);
//TransportLayer := ATransportLayer;
//end;

function TGMINetProtocolBase.Obj: TGMINetProtocolBase;
begin
  Result := Self;
end;

function TGMINetProtocolBase.HeadersToSend: IGMIntfCollection;
begin
  if FHeadersToSend = nil then FHeadersToSend := CreateHeaderCollection;
  Result := FHeadersToSend;
end;

function TGMINetProtocolBase.ReceivedHeaders: IGMIntfCollection;
begin
  if FReceivedHeaders = nil then FReceivedHeaders := CreateHeaderCollection;
  Result := FReceivedHeaders;
end;

function TGMINetProtocolBase.ProtocolDisplayName: TGMString;
begin
  Result := 'INet';
end;

function TGMINetProtocolBase.BuildErrorMsgPostfixFromResponseContent(const AResponseContent: ISequentialStream): TGMString;
begin
  Result := '';
end;

function TGMINetProtocolBase.ConsumeContent(const ATransportLayer: ISequentialStream): TGMString;
const cStrMethodName = 'ConsumeContent';
var stringStream: IStream; // ansiText: IGMGetAnsiText;
begin
  if ATransportLayer = nil then begin Result := ''; Exit; end;

  stringStream := TGMAnsiStringIStream.Create;
  GMCopyIStream(ATransportLayer, stringStream);
  GMSetIStreamAbsPos(stringStream, 0, cStrMethodName);

  Result := BuildErrorMsgPostfixFromResponseContent(stringStream);

  //GMSetIStreamAbsPos(stringStream, 0, cStrMethodName);
  //if vfGMDoTracing and GMIStreamContainsASCIIText(stringStream) then
  //   vfGMTrace(GMInsertXMLLineBreaks(GMGetIntfText(stringStream)), cStrContent);
end;

function TGMINetProtocolBase.ReadResponseLine(const ATransportLayer: ISequentialStream): AnsiString;
const cStrMethodName = 'ReadResponseLine';
var n, cb: LongWord; ch: AnsiChar; sepStr: AnsiString; hr: HResult;
begin
  Result := ''; // <- important when using fastMM!
  if ATransportLayer = nil then Exit;
  cb := SizeOf(ch); sepStr := '';
  repeat
   //GMSafeIStreamRead(ATransportLayer, @ch, SizeOf(ch), cStrMethodName);
   hr := ATransportLayer.Read(@ch, cb, Pointer(@n));
   if hr < 0 then GMHrCheckIntf(hr, ATransportLayer, cStrMethodName);
   if n <> cb then raise EGMException.IntfError(cStrMethodName + ': ' + GMFormat(RStrReadErrorFmt, [cb, n]), ATransportLayer, cStrMethodName);
   case ch of
    CR, LF:
     begin
      sepStr := sepStr + ch;
      if sepStr = CRLF then Break;
      if Length(sepStr) >= Length(CRLF) then raise EGMINetException.ObjError(GMFormat(RStrInvalidCommandTerm, [ProtocolDisplayName]), Self, cStrMethodName);
     end;

    else
     begin
      if Length(sepStr) > 0 then raise EGMINetException.ObjError(GMFormat(RStrInvalidCommandTerm, [ProtocolDisplayName]), Self, cStrMethodName);
      Result := Result + ch;
     end;
   end;
  until False;
end;

function TGMINetProtocolBase.IsHeaderTermLine(const ALine: AnsiString): Boolean;
begin
  Result := Length(Aline) <= 0;
end;

function TGMINetProtocolBase.ReceiveHeaders(const ATransportLayer: ISequentialStream; const AHeaders: IGMIntfCollection): TGMString;
var line, header: AnsiString;
  procedure AddHeader(const AHeader: TGMString);
  begin
    if Length(AHeader) <= 0 then Exit;
    vfGMTrace(AHeader, ProtocolDisplayName);
    //
    // First response line is returned (status line), other lines are added to headers
    //
    if Length(Result) = 0 then Result := AHeader else
       if (AHeaders <> nil) and (Length(AHeader) > 0) then AHeaders.Add(TGMINetHeaderEntry.Create(AHeader));
  end;
begin
  Result := ''; header := '';
  repeat
   line := ReadResponseLine(ATransportLayer); 
   if IsHeaderTermLine(line) then Break;

   if (Length(line) > 0) and (line[1] in [' ', #9]) then
    header := header + line // Copy(hdrToken, 2, Length(hdrToken)-1)
   else
    begin AddHeader(header); header := line; end; // <- add previous line, wrapping cannot be decided until next line has been read
  until False;
  AddHeader(header); // <- add last line
end;

function TGMINetProtocolBase.ReceiveCmdResponse(const ATransportLayer: ISequentialStream): TCmdResponse;
const cStrMethodName = 'ReceiveCmdResponse';
var line: AnsiString; firstLine, moreLines: Boolean;
  function IsNumber(const AValue: AnsiString): Boolean;
  var i: LongInt;
  begin
    for i:=1 to Length(AValue) do if not GMIsDigitA(AValue[i]) then begin Result := False; Exit; end;
    Result := Length(AValue) > 0;
  end;
begin
  firstLine := True;
  Result.Code := '';
  repeat
   line := ReadResponseLine(ATransportLayer); // , ProtocolDisplayName, Self);

   if not firstLine then moreLines := (Copy(line, 1, 4) <> Result.Code + ' ') else 
    begin
     Result.Code := Copy(line, 1, 3);
     if not IsNumber(Result.Code) then raise EGMINetException.ObjError(GMFormat(RStrInvalidResponeCodeFmt, [ProtocolDisplayName, Result.Code]), Self, cStrMethodName);
     moreLines := Copy(line, 4, 1) = '-';
    end;

   if firstLine or not moreLines then line := Copy(line, 5, Length(line) - 4);
   GMAddStrToArray(line, Result.Text);

   firstLine := False;
  until not moreLines;
  vfGMTrace(ProtocolDisplayName + ' ' + RStrResponse + ': ' + Result.Code + ' ' + GMStrArrayAsText(Result.Text, '<CRLF>'), ProtocolDisplayName);
end;

function TGMINetProtocolBase.ExceptClassForCode(const ACode: AnsiString): TGMINetExceptionClass;
begin
  Result := EGMINetException;
end;

function TGMINetProtocolBase.CheckCmdResponse(const ACommand: TGMString; const ACmdResponse: TCmdResponse; const ASuccessCodes: TGMString; const ACallingName: TGMString): TCmdResponse;
const cStrMethodName = 'CheckCmdResponse';
var exceptClass: EGMExceptionClass; //i: LongInt;
begin
  Result := ACmdResponse;

  exceptClass := ExceptClassForCode(Result.Code);
  if exceptClass = nil then exceptClass := EGMINetException;

  if Length(ACmdResponse.Code) <= 0 then raise exceptClass.ObjError(GMFormat(RStrNoResponseCode, [ProtocolDisplayName, ACommand]), Self, cStrMethodName);

//for i:=1 to Length(ACmdResponse.Code) do
// if not GMIsDelimiter(cStrDigits, ACmdResponse.Code, i) then
//    raise exceptClass.ObjError(GMFormat(RStrBadResponseCode, [ProtocolDisplayName, ACmdResponse.Code]), Self, cStrMethodName);

  if not GMIsdelimiter(ASuccessCodes, Result.Code, 1) then
     raise exceptClass.ObjError(GMFormat(RStrCmdError, [ProtocolDisplayName, ACommand, Result.code, GMStrArrayAsText(Result.Text)]), Self, ACallingName);
end;

function TGMINetProtocolBase.ExecCommandStr(const ATransportLayer: ISequentialStream; ACommand, ASuccessCodes: TGMString;
    ACallingName: TGMString; const AShowTrace: Boolean): TCmdResponse;
const cStrMethodName = 'ExecCommandStr';
var cmdWithTerm: AnsiString; cmdVerb: TGMString;
begin
  GMCheckPointerAssigned(Pointer(ATransportLayer), RStrTransportLayerStream);

  if Length(ACallingName) <= 0 then ACallingName := cStrMethodName;

  cmdVerb := GMFirstWord(ACommand, cWhiteSpace); // <- avoid showing password etc in error message
  ACommand := GMStripLeft(GMStripRight(ACommand, CRLF));
  cmdWithTerm := ACommand + CRLF;

  if Length(ACommand) > 0 then
   begin
    if AShowTrace then vfGMTrace(cStrCommand + ': ' + ACommand, ProtocolDisplayName);
    GMSafeIStreamWrite(ATransportLayer, PAnsiChar(cmdWithTerm), Length(cmdWithTerm), ACallingName);
   end;

   Result := CheckCmdResponse(cmdVerb, ReceiveCmdResponse(ATransportLayer), ASuccessCodes, ACallingName);

   if (Length(ASuccessCodes) > 1) and (Result.Code[1] = '1') then
    begin
     ASuccessCodes := GMDeleteChars(ASuccessCodes, '1');
     if Length(ASuccessCodes) <= 0 then ASuccessCodes := '2';
     Result := CheckCmdResponse(cmdVerb, ReceiveCmdResponse(ATransportLayer), ASuccessCodes, ACallingName);
    end;
end;


end.