lazarus-ccr/components/lazmapviewer/source/mvdlewin.pas

{ Map Viewer Download Engine Free Pascal HTTP Client

  License: modified LGPL with linking exception (like RTL, FCL and LCL)

  See the file COPYING.modifiedLGPL.txt, included in the Lazarus distribution,
  for details about the license.

  See also: https://wiki.lazarus.freepascal.org/FPC_modified_LGPL
}

unit mvDLEWin;

{$mode objfpc}{$H+}

interface

{$IFDEF MSWindows}

uses
  Classes, SysUtils,
  mvDownloadEngine;

type
  TMVDEWin = class(TMvCustomDownloadEngine)
  private
    FUseSystemProxy: Boolean;
    FUseProxy: Boolean;
    FProxyHost: string;
    FProxyPort: Word;
    FProxyUserName: String;
    FProxyPassWord: String;
  protected
    procedure InternalDownloadFile(const Url: string; AStream: TStream); override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure SetProxy(AUseSystemProxy, AUseProxy: Boolean; AProxyHost: String;
      AProxyPort: Word; AProxyUserName, AProxyPassword: String); override;
    property UseProxy: Boolean read FUseProxy write FUseProxy default false;
    property UseSystemProxy: Boolean read FUseSystemProxy write FUseSystemproxy default true;
    property ProxyHost: String read FProxyHost write FProxyHost;
    property ProxyPort: Word read FProxyPort write FProxyPort;
    property ProxyUsername: String read FProxyUserName write FProxyUserName;
    property ProxyPassword: String read FProxyPassword write FProxyPassword;
  end;

{$ENDIF}

implementation

{$IFDEF MSWindows}
uses
  windows, wininet;

constructor TMVDEWin.Create(AOwner: TComponent);
begin
  inherited;
  FProxySupport := true;
  FSystemProxySupport := true;
  FUseSystemProxy := true;
end;

procedure TMVDEWin.InternalDownloadFile(const Url: string; AStream: TStream);
const
  KB = 1024;
var
  netHandle: HInternet;
  urlHandle: HInternet;
  buffer: array[0..4*KB-1] of Char;
  bytesRead: dWord = 0;
  header: String;
  accessType: Integer;
  proxy: String = '';
  username: WideString = '';
  pwd: WideString = '';
begin
  if FUseSystemProxy then
    accessType := INTERNET_OPEN_TYPE_PRECONFIG
  else
  begin
    accessType := INTERNET_OPEN_TYPE_DIRECT;
    if FUseProxy then
    begin
      if FProxyPort <> 0 then
        proxy := Format('%s:%d', [FProxyHost, FProxyPort])
      else
        proxy := FProxyHost;
      if proxy <> '' then
        accessType := INTERNET_OPEN_TYPE_PROXY;
    end;
  end;
  netHandle := InternetOpen('Mozilla/5.0(compatible; WinInet)', accessType, PChar(proxy), nil, 0);

  // NetHandle valid?
  if netHandle = nil then
    exit;

  if FUseProxy then
  begin
    if FProxyUsername <> '' then
    begin
      userName := WideString(FProxyUsername);
      InternetSetOptionW(netHandle, INTERNET_OPTION_PROXY_USERNAME, PWideChar(userName), Length(userName));
    end;
    if FProxyPassword <> '' then
    begin
      pwd := WideString(FProxyPassword);
      InternetSetOptionW(netHandle, INTERNET_OPTION_PROXY_PASSWORD, PWideChar(pwd), Length(pwd));
    end;
  end;

  try
    header := '';
    urlHandle := InternetOpenUrl(netHandle, PChar(URL), PChar(header), Length(header), INTERNET_FLAG_RELOAD, 0);

    // UrlHandle valid?
    if urlHandle = nil then
      exit;

    try
      repeat
        InternetReadFile(urlHandle, @buffer, SizeOf(buffer), bytesRead);
        if bytesRead > 0 then
          AStream.Write(buffer, bytesRead);
      until bytesRead = 0;
      AStream.Position := 0;
    finally
      InternetCloseHandle(urlHandle);
    end
  finally
    InternetCloseHandle(netHandle);
  end;
end;

procedure TMvDEWin.SetProxy(AUseSystemProxy, AUseProxy: Boolean; AProxyHost: String;
  AProxyPort: Word; AProxyUserName, AProxyPassword: String);
begin
  FUseSystemProxy := AUseSystemProxy;
  FUseProxy := AUseProxy;
  FProxyHost := AProxyHost;
  FProxyPort := AProxyPort;
  FProxyUserName := AProxyUserName;
  FProxyPassword := AProxyPassword;
end;

{$ENDIF}

end.