{*******************************************************}
{                                                       }
{       Tocsg.Url                                       }
{                                                       }
{       Copyright (C) 2022 kku                          }
{                                                       }
{*******************************************************}

unit Tocsg.Url;

interface

uses
  System.SysUtils, System.Classes;

function GetDomainFromUrl(const sUrl: String): String;
function ExtractUrlPath(const sUrl: String): String;

function IncludeTrailingSlash(const sUrl: String): String;
function ExcludeTrailingSlash(const sUrl: String): String;

function RefineUrl(sHomeUrl, sSubUrl: String): String;

function ExtractIPsFromUrl(sUrl: String; bIncIPv6: Boolean = false; sDm: String = ','): String;
function IsUrlValid(const url: string; nTmSec : Integer = 0): boolean;
function UrlEncodeUTF8(const sText: String): String;
function UrlDecodeUTF8(const sText: String): String;

implementation

uses
  Tocsg.Exception, Tocsg.Process, Tocsg.Safe, Tocsg.Strings, Tocsg.Network,
  Winapi.WinInet, Winapi.Windows;

function GetDomainFromUrl(const sUrl: String): String;
var
  nPos, b: Integer;
begin
  nPos := Pos('://', sUrl);
  if nPos > 0 then
    Inc(nPos, 3);

  nPos := FindDelimiter('/', sUrl, nPos);
  if nPos > 0 then
    Result := Copy(sUrl, 1, nPos - 1)
  else
    Result := sUrl;
end;

function ExtractUrlPath(const sUrl: String): String;
var
  nPos: Integer;
begin
  nPos := LastDelimiter('/', sUrl);
  if nPos > 0 then
    Result := Copy(sUrl, 1, nPos)
  else
    Result := sUrl;
end;

function IncludeTrailingSlash(const sUrl: String): String;
var
  nLen: Integer;
begin
  nLen := Length(sUrl);
  if (nLen = 0) or (sUrl[nLen] <> '/') then
    Result := sUrl + '/'
  else
    Result := sUrl;
end;

function ExcludeTrailingSlash(const sUrl: String): String;
var
  nLen: Integer;
begin
  Result := sUrl;
  nLen := Length(Result);
  if (nLen > 0) and (sUrl[nLen] = '/') then
    SetLength(Result, nLen - 1);
end;

function RefineUrl(sHomeUrl, sSubUrl: String): String;
var
  nPos, nSubLen: Integer;
begin
  nSubLen := Length(sSubUrl);
  if Pos('://', sSubUrl) > 0 then
  begin
    Result := sSubUrl;
    exit;
  end else
  if nSubLen = 0 then
  begin
    Result := '';
    exit;
  end else
  if sSubUrl[1] = '/' then
  begin
    Result := GetDomainFromUrl(sHomeUrl) + sSubUrl;
  end else
  if sSubUrl[1] = '?' then
  begin
    nPos := Pos('?', sHomeUrl);
    if nPos > 0 then
      Delete(sHomeUrl, nPos, Length(sHomeUrl) - nPos + 1);
    Result := sHomeUrl + sSubUrl;
  end else
  if Pos('./', sSubUrl) = 1 then
  begin
    Result := ExtractUrlPath(sHomeUrl) + Copy(sSubUrl, 3, nSubLen - 2);
  end else
  if Pos('../', sSubUrl) = 1 then
  begin
    Result := ExtractUrlPath(sHomeUrl);
    Result := ExcludeTrailingSlash(Result);
    Result := ExtractUrlPath(Result) + Copy(sSubUrl, 4, nSubLen - 3);
  end else
    Result := ExtractUrlPath(sHomeUrl) + sSubUrl;
end;

function ExtractIPsFromUrl(sUrl: String; bIncIPv6: Boolean = false; sDm: String = ','): String;
var
  ss: TStringStream;
  sIp, sData: String;
  IpList,
  ExtrIpList: TStringList;
  nPos, c: Integer;
begin
  Result := '';
  try
    Guard(ss, TStringStream.Create('', TEncoding.UTF8));
    Guard(IpList, TStringList.Create);
    Guard(ExtrIpList, TStringList.Create);
    if GetCmdTextToStream('cmd.exe', Format('/c nslookup %s', [sUrl]), ss) then
    begin
      sData := ss.DataString.ToLower;
      nPos := Pos('addresses:', sData);
      if nPos <> 0 then
      begin
        Delete(sData, 1, nPos + 9);
      end else begin
        nPos := Pos('address:', sData);
        if nPos <> 0 then
        begin
          Delete(sData, 1, nPos + 9);
          nPos := Pos('address:', sData);
            Delete(sData, 1, nPos + 8);
        end;
      end;

      sData := StringReplace(sData, #9, '', [rfReplaceAll]);
      SplitString(sData, #13#10, IpList);
      for c := 0 to IpList.Count - 1 do
      begin
        sIp := IpList[c];
        if IsValidIP(sIp, true, bIncIPv6) and (ExtrIpList.IndexOf(sIp) = -1) then
        begin
          ExtrIpList.Add(sIp);
          SumString(Result, sIp, sDm);
        end;
      end;
    end;
  except
    on E: Exception do
      ETgException.TraceException(E, 'Fail .. ExtractIPsFromUrl()');
  end;
end;

// https://niceit.tistory.com/264 여기서 가져옴 23_0517 16:54:28 kku
function IsUrlValid(const url: string; nTmSec : Integer = 0): boolean;
var
  hInet: HINTERNET;
  hConnect: HINTERNET;
  infoBuffer: array [0..512] of char;
  dummy: DWORD;
  bufLen: DWORD;
  okay: LongBool;
  sReply: String;
begin
  Result := false;
  try
    if pos('://-', url) > 0 then
      exit;

    hConnect := nil;
    hInet := InternetOpen(PChar('EYECOMA'),
      INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY, nil, nil, 0);

    if hInet = nil then
      exit;

    try
      //타임아웃을 지정할 수 있음
      //간혹 지정하지 않는 경우 무한루프에 빠질 수도 있으니 지정하기를 권장
      //적어도 1~2초 이내에는 반환 하는 것이 정상이므로 2초 정도 권장
      if nTmSec > 0 then
        InternetSetOption(hInet, INTERNET_OPTION_CONNECT_TIMEOUT,
                        @nTmSec, SizeOf(nTmSec));

      //연결해 본다..
      hConnect := InternetOpenUrl(hInet,PChar(url), nil, 0,
                            INTERNET_FLAG_NO_UI, 0);

      if Assigned(hConnect) then
      begin
        // Wininet을 이용해 호출할 URL 정보를 만든다.
        dummy := 0;
        bufLen := Length(infoBuffer);
        okay := HttpQueryInfo(hConnect, HTTP_QUERY_STATUS_CODE, @infoBuffer[0], bufLen, dummy);
        if okay then
        begin
          sReply := infoBuffer;
          if (sReply = '200') or (sReply = '401') or (sReply = '500') then
            Result := true;

//          if sReply = '200' then
//            // 네비게이션 웹페이지가 존재 한다
//            Result := true
//          else if sReply = '401' then
//            // 대부분 페이지는 존재하지만 인증 문제가 있다.
//            // 어떤 인증문제인지는 체크 불가함
//            Result := true;
  //        else if sReply = '404' then
  //          // 호출 대상 파일을 찾을 수 없다.
  //          exit;
  //        else if sReply = '500' then
  //          // 대부분 웹서버 내부 오류
  //          exit;
  //        else
  //          {TODO:HTTP프로토콜의 다른 응답 코드에 대해 이 부분에서 추가 처리할것}
  //          Result := False;
        end;
      end;
    finally
      if hConnect <> nil then
        InternetCloseHandle(hConnect);
      if hInet <> nil then
        InternetCloseHandle(hInet);
    end;
  except
    on E: Exception do
      ETgException.TraceException(E, 'Fail .. IsUrlValid()');
  end;
end;

function UrlEncodeUTF8(const sText: String): String;
var
  i: Integer;
  c: AnsiChar;
  sUtf8: UTF8String;
begin
  Result := '';
  sUtf8 := UTF8Encode(sText); // UTF-8 변환

  for i := 1 to Length(sUtf8) do
  begin
    c := sUtf8[i];

    // URL-safe 문자
    if (c in ['A'..'Z', 'a'..'z', '0'..'9', '-', '_', '.', '~']) then
      Result := Result + Char(c)
    else
      Result := Result + '%' + IntToHex(Ord(c), 2); // %XX 형태로 인코딩
  end;
end;

function UrlDecodeUTF8(const sText: String): String;
var
  i, nLen: Integer;
  sHex: String;
  pBuf: TBytes;
  uc: Byte;
begin
  SetLength(pBuf, 0);
  i := 1;
  nLen := Length(sText);
  while i <= nLen do
  begin
    if sText[i] = '%' then
    begin
      // %XX 형태인지 확인
      if (i + 2 <= nLen) then
      begin
        sHex := Copy(sText, i + 1, 2);
        uc := Byte(StrToInt('$' + sHex));
        pBuf := pBuf + [uc];
        Inc(i, 3); // %XX 건너뛰기
        Continue;
      end;
    end else
    if sText[i] = '+' then
    begin
      // 보통 URL 인코딩에서는 + 를 공백으로 처리하는 경우도 있음
      pBuf := pBuf + [Ord(' ')];
      Inc(i);
      Continue;
    end;

    // 일반 ASCII 문자
    pBuf := pBuf + [Ord(sText[i])];
    Inc(i);
  end;

  // UTF-8 → Unicode string 변환
  Result := TEncoding.UTF8.GetString(pBuf);
end;

end.