310 lines
8.1 KiB
Plaintext
310 lines
8.1 KiB
Plaintext
{*******************************************************}
|
|
{ }
|
|
{ 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.
|
|
|