Опытный
Профиль
Группа: Участник
Сообщений: 598
Регистрация: 17.2.2008
Репутация: нет Всего: 6
|
Уже, наверное, неактуально, но может кто-то будет искать ответ. Можно использовать WinInet, читая настройки прокси из IE. Надо только убрать много лишнего и подстроить под себя: Код | { Если логин с паролем не указывать (в конструкторе или после создания), то , при необходимости будет выскакивать окно с запросом }
unit UnitWinInet;
interface
uses System.SysUtils, System.Types, WinInet, Winapi.Windows;
type
TWinInet = class private FHWND: THandle; // Хэндл вызывающего приложения FClientName, // Имя клиента FParam, // параметры запроса (которые после ?) FMethod, // GET, POST и др. FType_Access, // mime type и проч, если установлен в '', то используется по умолчанию FLogin, // логин FPass: string; // пароль FPostData: boolean; //True - передача параметров запроса через post data, False - через строку запроса procedure SetMethod(AMethod: string); public property HWND: THandle read FHWND write FHWND; property ClientName: string read FClientName write FClientName; property Param: string read FParam write FParam; property Method: string read FMethod write SetMethod; property Type_Access: string read FType_Access write FType_Access; property Login: string read FLogin write FLogin; property Pass: string read FPass write FPass; property PostData: boolean read FPostData write FPostData; function GetHTTP(AURL: string): AnsiString; constructor Create(AHWND: THandle); end;
implementation
constructor TWinInet.Create(AHWND: THandle); begin FHWND:= AHWND; FClientName:= 'WinInet'; FMethod:= 'GET'; FType_Access:= 'Content-Type: application/x-www-form-urlenDELPHId' + #13#10 + 'Content-Length:' + IntToStr(length(FParam)); FPostData:= False; end;
procedure TWinInet.SetMethod(AMethod: string); begin FMethod:= UpperCase(AMethod); end;
function TWinInet.GetHTTP(AURL: string): AnsiString;
function GetHostName(AUrl: string): string; var s: string; begin // Имя хоста if Pos('https://', AUrl) > 0 then s:= 'https://' else if Pos('http://', AUrl) > 0 then s:= 'http://' else s:= EmptyStr; if s <> EmptyStr then if Pos(s, AUrl) > 0 then Delete(AUrl, 1, Length(s)); if Pos('/', AUrl) > 0 then SetLength(AUrl, Pos('/', AUrl) - 1); Result:= AUrl; end;
function GetScriptName(AUrl, AHostname: string): string; begin // URL после имени хоста Result:= EmptyStr; Delete(AUrl, 1, Pos(AHostname, AUrl) + Length(AHostname)); Result:= AUrl; end;
procedure SetFlags(AUrl: string; out Flags_connection, Flags_Request: Cardinal); begin // Определяем https или http if Pos('https', AUrl) > 0 then begin Flags_connection:= INTERNET_DEFAULT_HTTPS_PORT; Flags_Request:= INTERNET_FLAG_RELOAD or INTERNET_FLAG_NO_CACHE_WRITE or INTERNET_FLAG_SECURE or INTERNET_FLAG_IGNORE_CERT_CN_INVALID or INTERNET_FLAG_IGNORE_CERT_DATE_INVALID or INTERNET_FLAG_KEEP_CONNECTION end else begin Flags_connection:= INTERNET_DEFAULT_HTTP_PORT; Flags_Request:= INTERNET_FLAG_RELOAD or INTERNET_FLAG_IGNORE_CERT_CN_INVALID or INTERNET_FLAG_NO_CACHE_WRITE or INTERNET_FLAG_PRAGMA_NOCACHE or INTERNET_FLAG_KEEP_CONNECTION; end; end;
function GetResponseHeader(const hRequest: Pointer): string; var dwSize, Index: DWORD; szBuff: array [0..1024] of Char; begin // Возвращает заголовок ответа сервера в виде строк с CR/LF Index:= 0; dwSize:= SizeOf(szBuff); HttpQueryInfo(hRequest, HTTP_QUERY_RAW_HEADERS_CRLF, @szBuff, dwSize, Index); Result:= PChar(@szBuff); end;
function GetStatus(const hRequest: Pointer): DWORD; var dwSize, dwStatus, Index: DWORD; begin // Возвращает заголовок ответа сервера в виде строк с CR/LF // Возвращает код статуса HTTP из заголовка ответа Index:= 0; dwSize:= SizeOf(dwStatus); HttpQueryInfo(hRequest, HTTP_QUERY_STATUS_CODE or HTTP_QUERY_FLAG_NUMBER, @dwStatus, dwSize, Index); Result:= dwStatus; end;
function AddSecurityFlags(httpReq: Pointer): Boolean; var dwSize, dwFlags: DWORD; begin Result:= False; dwSize:= SizeOf(dwFlags); // Get the current security flags if (InternetQueryOption(httpReq, INTERNET_OPTION_SECURITY_FLAGS, @dwFlags, dwSize)) then begin // Add desired flags dwFlags:= dwFlags or SECURITY_FLAG_IGNORE_UNKNOWN_CA or SECURITY_FLAG_IGNORE_CERT_CN_INVALID or SECURITY_FLAG_IGNORE_CERT_DATE_INVALID or SECURITY_FLAG_IGNORE_REVOCATION; Result:= (InternetSetOption(httpReq, INTERNET_OPTION_SECURITY_FLAGS, @dwFlags, dwSize)); end end;
function SendRequest(httpRequest: Pointer; AType_Access, AParam: string): boolean; begin case FPostData of False: Result:= HttpSendRequest(httpRequest, nil, 0, nil, 0); True: Result:= HttpSendRequest(httpRequest, PChar(AType_Access), Length(AType_Access), PChar(AParam), Length(AParam)); end; end;
var httpSession, httpConnect, httpRequest: HINTERNET; bytes, b, pos: Cardinal; hostname, script: string; Flags_connection, Flags_Request: Cardinal; DlgError: DWORD; begin Result:= EmptyAnsiStr; hostname:= GetHostName(AURL); // имя хоста script:= GetScriptName(AURL, hostname); // скрипт // установка доп. параметров if not FPostData then // если передаем параметры через строку запроса, то if FParam <> EmptyStr then // дополняем скрипт if script[Length(script)] = '?' then script:= script + FParam else script:= script + '?' + FParam; try SetFlags(AURL, Flags_connection, Flags_Request); // Устанавливаем флаги (http или https) // Открываем сессию (инициализируем WinInet) httpSession:= InternetOpen(PChar(FClientName), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0); if Assigned(httpSession) then // Проверяем хэндл try // Открываем соединение httpConnect:= InternetConnect(httpSession, PChar(hostname), Flags_connection, nil, nil, INTERNET_SERVICE_HTTP, 0, 0); if Assigned(httpConnect) then // Проверяем хэндл try // Открываем запрос (передаем остаток URL (скрипт GetScriptName) в ф-ю HttpOpenRequest под параметром lpszObjectName) httpRequest:= HttpOpenRequest(httpConnect, PChar(FMethod), PChar(script), HTTP_VERSION, nil, nil, Flags_Request, 0); if Assigned(httpRequest) then try AddSecurityFlags(httpRequest); SendRequest(httpRequest, FType_Access, FParam); // Отправляем запрос if GetStatus(httpRequest) = HTTP_STATUS_DENIED then begin // Если необходима авторизация if FLogin <> EmptyStr then begin InternetSetOption(httpRequest, INTERNET_OPTION_USERNAME, PChar(FLogin), SizeOf(FLogin)); InternetSetOption(httpRequest, INTERNET_OPTION_PASSWORD, PChar(FPass), SizeOf(FPass)); end else begin DlgError:= InternetErrorDlg(FHWND, httpRequest, ERROR_INTERNET_CLIENT_AUTH_CERT_NEEDED, FLAGS_ERROR_UI_FILTER_FOR_ERRORS or FLAGS_ERROR_UI_FLAGS_GENERATE_DATA //or FLAGS_ERROR_UI_SERIALIZE_DIALOGS or FLAGS_ERROR_UI_FLAGS_CHANGE_OPTIONS, PPointer(nil)^ ); if DlgError = 0 then begin Result:= AnsiString('Доступ запрещен! Ввод учетных данных отменен.' + sLineBreak + SysErrorMessage(GetLastError)); Exit; end; end; SendRequest(httpRequest, FType_Access, FParam); end; if GetStatus(httpRequest) = HTTP_STATUS_OK then begin pos:= 1; b:= 1; while b > 0 do begin // Если количество данных 0 - генерируем исключение if not InternetQueryDataAvailable(httpRequest, bytes, 0, 0) then Result:= AnsiString('Сервер не вернул данные! (функция InternetQueryDataAvailable)' + sLineBreak + SysErrorMessage(GetLastError)); SetLength(Result, Cardinal(Length(Result)) + bytes); // Получаем данные с сервера InternetReadFile(httpRequest, @Result[Pos], bytes, b); Inc(Pos, b); end; Result:= Result + AnsiString(sLineBreak + SysErrorMessage(GetLastError)); end else Result:= AnsiString('ОШИБКА ' + IntToStr(GetStatus(httpRequest)) + sLineBreak + SysErrorMessage(GetLastError)); finally InternetCloseHandle(httpRequest); // закрываем запрос end else Result:= AnsiString('Ошибка формирования запроса (функция HttpOpenRequest)' + sLineBreak + SysErrorMessage(GetLastError)); finally InternetCloseHandle(httpConnect); // закрываем соединение end else Result:= AnsiString('Ошибка открытия сессии (функция InternetConnect)' + sLineBreak + SysErrorMessage(GetLastError)); finally InternetCloseHandle(httpSession); // закрываем сессию end else Result:= AnsiString('Отсутствует подключение к сети (функция InternetOpen)' + sLineBreak + SysErrorMessage(GetLastError)); except On E: Exception do Result:= AnsiString('Ошибка! ' + E.ClassName + ': ' + E.Message); end; end;
end.
|
Использование: Код | uses ..., UnitWinInet; ... Client:= TWinInet.Create(FrmTesting.Handle); with Client do try if FrmTesting.CheckBox1.Checked then begin Login:= 'Domen\login'; Pass:= 'Password'; end; FHTTPResult:= GetHTTP(FrmTesting.Edt1.Text); finally FreeAndNil(Client); end;
|
--------------------
Кто ищет, тот всегда найдет.
|