unit WinInetGet;

interface

uses Wininet,Windows,Forms,SysUtils,Classes,StrUtils,uLog;
//+------------------------------------------------------------------+
type
    THttpGet = class(TThread)
    private
        url:string;
        fn :string;
        busy:Boolean;

    protected

    public


end;
//+------------------------------------------------------------------+
type THttpMethod = (GET,POST);
//---
var
icLogin:AnsiString='';
icPassword:AnsiString='';
//---
function GetHost(url:string):string;
function GetPage(Url:string):string;
function GetParams(url:string):string;
//+------------------------------------------------------------------+
function WininetGetString(Metod:THttpMethod; var Url:AnsiString; Params:AnsiString=''; RetErrCode:Boolean=false):Boolean; overload;
function WininetGetString(Metod:THttpMethod; Header:string; var Url:AnsiString; Params:AnsiString=''; RetErrCode:Boolean=false):Boolean; overload;
function WininetToString(Metod:THttpMethod; Header:string; var Url:AnsiString; Params:AnsiString=''):Cardinal;
function GetInetString(const fileURL:AnsiString; Header:AnsiString=''): AnsiString;
function GetInetFile(const fileURL:string; FileName:string='http.txt'): boolean;
//+------------------------------------------------------------------+
implementation
//+----------------------------------------------------------------------------+
//| Извлекает имя хоста из строки запроса
//+----------------------------------------------------------------------------+
function GetHost(Url:string):string;
var pos:integer;
begin
    pos:=AnsiPos('://',url);
    if(Pos > 0)then url:=AnsiMidStr(url,pos+3,Length(url));
    Result:=AnsiLeftStr(url,AnsiPos('/',url)-1);
end;
//+----------------------------------------------------------------------------+
//| Извлекает имя скрипта , или страницы к которой мы обращаемся с путями от корня
//+----------------------------------------------------------------------------+
function GetPage(Url:string):string;
var pos:integer;
begin
    Result:='';
    url:=AnsiReplaceStr(url,'://',':||');
    pos:=AnsiPos('/',url);
    if(pos > 0)then Result:= AnsiMidStr(url,Pos,Length(url));
end;
//+----------------------------------------------------------------------------+
//| Извлекает параметры GET запроса из строки запроса если они есть
//+----------------------------------------------------------------------------+
function GetParams(Url:string):string;
var pos:integer;
begin
    Result:='';
    url:=AnsiReplaceStr(url,'://',':||');
    pos:=AnsiPos('?',url);
    if(pos > 0)then Result:= AnsiMidStr(url,Pos,Length(url));
end;
//+----------------------------------------------------------------------------+
//|
//+----------------------------------------------------------------------------+
function WininetGetString(Metod:THttpMethod; var Url:AnsiString; Params:AnsiString=''; RetErrCode:Boolean=false):Boolean;
var
hSession, hConnect, hRequest , hURL : HInternet;
sMetod,Header,Host,sAppName,HttpPort:AnsiString;
Buffer: array[1..1024] of Char;
BufferLen, IPort, IFlags: DWORD;
Status, StatusSize,Index: DWORD;
hRead:Boolean;
begin
    Index := 0;
    StatusSize:=SizeOf(Status);
    Result:=false;
    sAppName := ExtractFileName(Application.ExeName);
    //---
    if(Metod = GET)then begin
        sMetod := 'GET';
        Header := Header + 'Accept: */*'#13#10;
        Header := Header + 'Accept-Language: en-US;q=0.8,en;q=0.7,es;q=0.6,uk;q=0.5'#13#10#13#10;
    end;
    if(Metod = POST)then begin
        sMetod := 'POST';
        Header := Header + 'Accept: */*;q=0.9'#13#10;
        Header := Header + 'Accept-Language: en-US;q=0.8,en;q=0.7,es;q=0.6,uk;q=0.5'#13#10;
        Header := Header + 'Content-Length: '+Inttostr(length(Params))+#13#10;
        Header := Header + 'Content-Type: application/json'#13#10#13#10;
    end;
    //---
    if(AnsiPos('https',LowerCase(url)) > 0)then begin
        IPort := INTERNET_DEFAULT_HTTPS_PORT;//443
        IFlags:= INTERNET_FLAG_SECURE;// and INTERNET_FLAG_IGNORE_CERT_CN_INVALID and INTERNET_FLAG_IGNORE_CERT_DATE_INVALID;
    end else begin
        IPort := INTERNET_DEFAULT_HTTP_PORT;// 80
        IFlags:= INTERNET_FLAG_IGNORE_REDIRECT_TO_HTTPS;
    end;
    //---
    hSession := InternetOpen(PChar(sAppName),INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
    if not Assigned(hSession)then begin
        Url:='InternetOpen ERROR:'+IntToStr(GetLastError);
        Exit;
    end;
    try
        Application.ProcessMessages;
        //--- Конектимся к интернету
        hConnect := InternetConnect(hSession,PChar(GetHost(Url)),IPort,nil,nil,INTERNET_SERVICE_HTTP,0,0);
        if not Assigned(hConnect)then begin
            Url:='InternetConnect ERROR:'+IntToStr(GetLastError);
            InternetCloseHandle(hSession);
            Exit;
        end;
        try
            Application.ProcessMessages;
            //--- Открываем запрос к серверу
            hRequest := HttpOpenRequest(hConnect,PChar(sMetod),PChar(GetPage(Url)),nil,nil,nil,IFlags,0);
            if not Assigned(hRequest)then begin
                Url:='HttpOpenRequest ERROR:'+IntToStr(GetLastError);
                InternetCloseHandle(hConnect);
                InternetCloseHandle(hSession);
                Exit;
            end;
            try
                Application.ProcessMessages;
                //--- Отправляем запрос серверу, заголовки и параметры POST запроса
                if(HttpSendRequest(hRequest,PAnsiChar(Header),Length(Header),PAnsiChar(Params),Length(Params)))then begin
                    //--- проверяем ответ сервера и если ответ ошибочный закрываем все и выходим
                    HttpQueryInfo(hRequest, HTTP_QUERY_FLAG_NUMBER or HTTP_QUERY_STATUS_CODE, @Status, StatusSize, Index);
                    if( RetErrCode )then begin
						if(Status < 200 )or(Status > 204)then begin
							Url:=IntToStr(Status);
							InternetCloseHandle(hRequest);
							InternetCloseHandle(hConnect);
							InternetCloseHandle(hSession);
							Exit;
						end;
                    end;
                    //--- Грузим ответ сервера в строку Урла
					Url:='';
					repeat
                        Application.ProcessMessages;
						ZeroMemory(@Buffer,SizeOf(Buffer));
						hRead := InternetReadFile(hRequest,@Buffer,SizeOf(Buffer),BufferLen);
						Url:= Url + Buffer;
						Result:=True;
					until
                        (not hRead) or (BufferLen = 0);
                end else begin
                    Url:=IntToStr(GetLastError);
                    InternetCloseHandle(hRequest);
                    InternetCloseHandle(hConnect);
                    InternetCloseHandle(hSession);
                    Exit;
                end;
            finally
                InternetCloseHandle(hRequest);
            end;
        finally
            InternetCloseHandle(hConnect);
        end;
    finally
        InternetCloseHandle(hSession);
    end;
end;
//+----------------------------------------------------------------------------+
//|
//+----------------------------------------------------------------------------+
function WininetGetString(Metod:THttpMethod; Header:string; var Url:AnsiString; Params:AnsiString=''; RetErrCode:Boolean=false):Boolean;
var
hSession, hConnect, hRequest , hURL : HInternet;
sMetod,Host,sAppName,HttpPort:AnsiString;
Buffer: array[1..1024] of Char;
BufferLen, IPort, IFlags: DWORD;
Status, StatusSize,Index: DWORD;
hRead:Boolean;
begin
    Index := 0;
    StatusSize:=SizeOf(Status);
    Result:=false;
    sAppName := ExtractFileName(Application.ExeName);
    //---
    if(Metod = GET)then begin
        sMetod := 'GET';
        if( Length(Header) = 0 )then begin
            Header := Header + 'Accept: text/html,application/xhtml+xml,application/xml;q=0.9'#13#10;
            Header := Header + 'Accept-Language: en-US;q=0.8,en;q=0.7,es;q=0.6,uk;q=0.5'#13#10#13#10;
        end;
    end;
    if(Metod = POST)then begin
        sMetod := 'POST';
        if( Length(Header) = 0 )then begin
            Header := Header + 'Accept: text/html,application/xhtml+xml,application/xml;q=0.9'#13#10;
            Header := Header + 'Accept-Language: en-US;q=0.8,en;q=0.7,es;q=0.6,uk;q=0.5'#13#10;
            Header := Header + 'Content-Length: '+Inttostr(length(Params))+#13#10;
            Header := Header + 'Content-Type: application/json'#13#10#13#10;
        end;
    end;
    //---
    if(AnsiPos('https',LowerCase(url)) > 0)then begin
        IPort := INTERNET_DEFAULT_HTTPS_PORT;//443
        IFlags:= INTERNET_FLAG_SECURE and INTERNET_FLAG_IGNORE_CERT_CN_INVALID and INTERNET_FLAG_IGNORE_CERT_DATE_INVALID;
    end else begin
        IPort := INTERNET_DEFAULT_HTTP_PORT;// 80
        IFlags:= INTERNET_FLAG_IGNORE_REDIRECT_TO_HTTPS;
    end;
    //---
    hSession := InternetOpen(PChar(sAppName),INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
    if not Assigned(hSession)then begin
        Url:=IntToStr(GetLastError);
        Exit;
    end;
    try
        Application.ProcessMessages;
        //--- Конектимся к интернету
        hConnect := InternetConnect(hSession,PChar(GetHost(Url)),IPort,nil,nil,INTERNET_SERVICE_HTTP,0,0);
        if not Assigned(hConnect)then begin
            Url:=IntToStr(GetLastError);
            InternetCloseHandle(hSession);
            Exit;
        end;
        try
            Application.ProcessMessages;
            //--- Открываем запрос к серверу
            hRequest := HttpOpenRequest(hConnect,PChar(sMetod),PChar(GetPage(Url)),nil,nil,nil,IFlags,0);
            if not Assigned(hRequest)then begin
                Url:=IntToStr(GetLastError);
                InternetCloseHandle(hConnect);
                InternetCloseHandle(hSession);
                Exit;
            end;
            try
                Url:='';
                Application.ProcessMessages;
                //--- Отправляем запрос серверу, заголовки и параметры POST запроса
                if(HttpSendRequest(hRequest,PAnsiChar(Header),Length(Header),PAnsiChar(Params),Length(Params)))then begin   GetLog('HEADER : '+#13#10+header); GetLog('REQUEST : '+#13#10+params);
                    //--- проверяем ответ сервера и если ответ ошибочный закрываем все и выходим
                    HttpQueryInfo(hRequest, HTTP_QUERY_FLAG_NUMBER or HTTP_QUERY_STATUS_CODE, @Status, StatusSize, Index);
                    if( RetErrCode )then begin
						if(Status <> HTTP_STATUS_OK)then begin
							Url:=IntToStr(Status);
							InternetCloseHandle(hRequest);
							InternetCloseHandle(hConnect);
							InternetCloseHandle(hSession);
							Exit;
						end;
                    end;
                    //--- Грузим ответ сервера в строку Урла
					repeat
                        Application.ProcessMessages;
						ZeroMemory(@Buffer,SizeOf(Buffer));
						hRead := InternetReadFile(hRequest,@Buffer,SizeOf(Buffer),BufferLen);
						Url:= Url + Buffer;
						Result:=True;
					until
                        (not hRead) or (BufferLen = 0);                         GetLog('WIN : '+Url);
                end else begin
                    Url:=IntToStr(GetLastError);
                    InternetCloseHandle(hRequest);
                    InternetCloseHandle(hConnect);
                    InternetCloseHandle(hSession);
                    Exit;
                end;
            finally
                InternetCloseHandle(hRequest);
            end;
        finally
            InternetCloseHandle(hConnect);
        end;
    finally
        InternetCloseHandle(hSession);
    end;
end;
//+----------------------------------------------------------------------------+
function WininetToString(Metod:THttpMethod; Header:string; var Url:AnsiString; Params:AnsiString=''):Cardinal;
var
hSession, hConnect, hRequest , hURL : HInternet;
sMetod,Host,sAppName,HttpPort:AnsiString;
Buffer: array[1..1024] of Char;
BufferLen, IPort, IFlags: DWORD;
Status, StatusSize,Index: DWORD;
hRead:Boolean;
begin
    Index := 0;
    StatusSize:=SizeOf(Status);
    Result:=200;
    sAppName := ExtractFileName(Application.ExeName);
    //---
    if(Metod = GET)then begin
        sMetod := 'GET';
        if( Length(Header) = 0 )then begin
            Header := Header + 'Accept: text/html,application/xhtml+xml,application/xml;q=0.9'#13#10;
            Header := Header + 'Accept-Language: en-US;q=0.8,en;q=0.7,es;q=0.6,uk;q=0.5'#13#10#13#10;
        end;
    end;
    if(Metod = POST)then begin
        sMetod := 'POST';
        if( Length(Header) = 0 )then begin
            Header := Header + 'Accept: text/html,application/xhtml+xml,application/xml;q=0.9'#13#10;
            Header := Header + 'Accept-Language: en-US;q=0.8,en;q=0.7,es;q=0.6,uk;q=0.5'#13#10;
            Header := Header + 'Content-Length: '+Inttostr(length(Params))+#13#10;
            Header := Header + 'Content-Type: application/x-www-form-urlencoded'#13#10#13#10;
        end;
    end;
    //---
    if(AnsiPos('https',LowerCase(url)) > 0)then begin
        IPort := INTERNET_DEFAULT_HTTPS_PORT;//443
        IFlags:= INTERNET_FLAG_SECURE and INTERNET_FLAG_IGNORE_CERT_CN_INVALID and INTERNET_FLAG_IGNORE_CERT_DATE_INVALID;
    end else begin
        IPort := INTERNET_DEFAULT_HTTP_PORT;// 80
        IFlags:= INTERNET_FLAG_IGNORE_REDIRECT_TO_HTTPS;
    end;                                                                        //GetLog('CNT 1');
    //---
    hSession := InternetOpen(PChar(sAppName),INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
    if not Assigned(hSession)then begin
        Result:=GetLastError;
        Exit;
    end;                                                                        //GetLog('CNT 2');
    try
        //GetLog('CNT 21');
        //Application.ProcessMessages;
        //GetLog('CNT 22');
        //--- Конектимся к интернету
        hConnect := InternetConnect(hSession,PChar(GetHost(Url)),IPort,nil,nil,INTERNET_SERVICE_HTTP,0,0);  //GetLog('CNT 23');
        if not Assigned(hConnect)then begin
            Result:=GetLastError;
            InternetCloseHandle(hSession);
            Exit;
        end;                                                                    //GetLog('CNT 3');
        try
            //Application.ProcessMessages;
            //--- Открываем запрос к серверу
            hRequest := HttpOpenRequest(hConnect,PChar(sMetod),PChar(GetPage(Url)),nil,nil,nil,IFlags,0);
            if not Assigned(hRequest)then begin
                Result:=GetLastError;
                InternetCloseHandle(hConnect);
                InternetCloseHandle(hSession);
                Exit;
            end;                                                                //GetLog('CNT 4');
            try
                Url:='';
                //Application.ProcessMessages;
                //--- Отправляем запрос серверу, заголовки и параметры POST запроса
                if(HttpSendRequest(hRequest,PAnsiChar(Header),Length(Header),PAnsiChar(Params),Length(Params)))then begin
                    //--- проверяем ответ сервера и если ответ ошибочный закрываем все и выходим
                    HttpQueryInfo(hRequest, HTTP_QUERY_FLAG_NUMBER or HTTP_QUERY_STATUS_CODE, @Status, StatusSize, Index);
                    if(Status <> HTTP_STATUS_OK)then Result:=Status;
                    //--- Грузим ответ сервера в строку Урла
					repeat
                        //Application.ProcessMessages;
						ZeroMemory(@Buffer,SizeOf(Buffer));
						hRead := InternetReadFile(hRequest,@Buffer,SizeOf(Buffer),BufferLen);
						Url:= Url + Buffer;                                     
					until (not hRead) or (BufferLen = 0);                       //GetLog('CNT 5');
                end else begin
                    Result:=GetLastError;
                    InternetCloseHandle(hRequest);
                    InternetCloseHandle(hConnect);
                    InternetCloseHandle(hSession);
                    Exit;
                end;
            finally
                InternetCloseHandle(hRequest);
            end;
        finally
            InternetCloseHandle(hConnect);
        end;
    finally
        InternetCloseHandle(hSession);
    end;
end;
//+----------------------------------------------------------------------------+
//| Читаем данные по HTTPS с сайта, пишем в буферный файл
//+----------------------------------------------------------------------------+
function GetInetString(const fileURL:AnsiString; Header:AnsiString=''): AnsiString;
const
  BufferSize = 1024;
var
  hSession, hURL: HInternet;
  Buffer: array[1..BufferSize] of Char;
  BufferLen: DWORD;
  f: file;
  sAppName: string;
  hRead:Boolean;
begin
    //---
    //GetLog('Get Data from : '+PChar(fileURL));
    Application.ProcessMessages;
    //---
	Result := '';
	sAppName := ExtractFileName(Application.ExeName);
	hSession := InternetOpen(PChar(sAppName),
	INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
	try
        Application.ProcessMessages;
		hURL := InternetOpenURL(hSession, PChar(fileURL), PChar(Header), Length(Header) , INTERNET_FLAG_NO_CACHE_WRITE+INTERNET_FLAG_PRAGMA_NOCACHE, 0);
		try
			repeat
                Application.ProcessMessages;
                ZeroMemory(@Buffer,SizeOf(Buffer));
				hRead := InternetReadFile(hURL, @Buffer, SizeOf(Buffer), BufferLen);
				Result:= Result + Buffer;
			until
				not hRead or (BufferLen = 0);
		finally
			InternetCloseHandle(hURL);
		end;
	finally
		InternetCloseHandle(hSession);
	end;
end;
//+----------------------------------------------------------------------------+
//| Читаем данные по HTTPS с сайта, пишем в буферный файл
//+----------------------------------------------------------------------------+
function GetInetFile(const fileURL:string; FileName:string='http.txt'): boolean;
const
  BufferSize = 1024;
var
  hSession, hURL: HInternet;
  Buffer: array[1..BufferSize] of Byte;
  BufferLen: DWORD;
  f: file;
  sAppName: string;
begin
    //---
    GetLog('Get Data from : '+PChar(fileURL));
    Application.ProcessMessages;
    //---
	Result := False;
	sAppName := ExtractFileName(Application.ExeName);
	hSession := InternetOpen(PChar(sAppName),
	INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
	try
		hURL := InternetOpenURL(hSession, PChar(fileURL), nil, 0, INTERNET_FLAG_PRAGMA_NOCACHE, 0);
		try
			AssignFile(f, FileName);
			Rewrite(f,1);
			repeat
                Application.ProcessMessages;
				InternetReadFile(hURL, @Buffer, SizeOf(Buffer), BufferLen);
				BlockWrite(f, Buffer, BufferLen);
			until
				BufferLen = 0;
				CloseFile(f);
				Result := True;
		finally
			InternetCloseHandle(hURL);
		end;
	finally
		InternetCloseHandle(hSession);
	end;
end;
//+----------------------------------------------------------------------------+
end.