jvqurlgrabbers.pas

East make Tray Icon in delphi

    try
      ErrorText := '';
      Grabber.ParseUrl(Grabber.Url, Grabber.GetSupportedProtocolMarker,
        HostName, FileName, strUserName, strPassword, Port);
      if strUserName = '' then
        strUserName := Grabber.UserName;
      if strPassword = '' then
        strPassword := Grabber.Password;
      if Port = 0 then
        Port := Grabber.Port;
        
      // Setup the PChars for the call to InternetConnect
      if strUserName = '' then
        UserName := nil
      else
        UserName := PChar(strUserName);
      if strPassword = '' then
        Password := nil
      else
        Password := PChar(strPassword);

      // Connect to the web
      SetGrabberStatus(gsConnecting);
      hSession := InternetOpen(PChar(Grabber.Agent), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
      if hSession = nil then
      begin
        ErrorText := GetLastInternetError;
        Synchronize(Error);
        Exit;
      end;
//      InternetSetStatusCallback(hSession, PFNInternetStatusCallback(@DownloadCallBack));

      // Connect to the hostname
      hHostConnection := InternetConnect(hSession, PChar(HostName), Port,
        UserName, Password, INTERNET_SERVICE_FTP, cPassive[Grabber.Passive], 0);
      if hHostConnection = nil then
      begin
        ErrorText := GetLastInternetError;
        Synchronize(Error);
        Exit;
      end;

      InternetSetStatusCallback(hHostConnection, PFNInternetStatusCallback(@DownloadCallBack));

      // Request the file
      if Grabber.FMode = hmBinary then
        hDownload := FtpOpenFile(hHostConnection, PChar(FileName), GENERIC_READ,
          FTP_TRANSFER_TYPE_BINARY or INTERNET_FLAG_DONT_CACHE or INTERNET_FLAG_RELOAD, 0)
      else
        hDownload := FtpOpenFile(hHostConnection, PChar(FileName), GENERIC_READ,
          FTP_TRANSFER_TYPE_ASCII or INTERNET_FLAG_DONT_CACHE or INTERNET_FLAG_RELOAD, 0);

      if Terminated then
        Exit;

      if hDownload = nil then
      begin
        ErrorText := GetLastInternetError;
        Synchronize(Error);
        Exit;
      end;
      Grabber.SetSize(FtpGetFileSize(hDownload, @dwFileSizeHigh)); // acp

      if Terminated then
        Exit;

      Grabber.Stream := TMemoryStream.Create;

      TotalBytes := 0;
      LocalBytesRead := 1;
      SetGrabberStatus(gsGrabbing);
      while (LocalBytesRead <> 0) and not Terminated and Continue do // acp
      begin
        if not InternetReadFile(hDownload, @Buf, SizeOf(Buf), LocalBytesRead) then
          LocalBytesRead := 0
        else
        begin
          Inc(TotalBytes, LocalBytesRead);
          Grabber.SetBytesRead(TotalBytes);
          Grabber.Stream.Write(Buf, LocalBytesRead);
          DoProgress;
        end;
      end;

      SetGrabberStatus(gsStopping);
      if not Terminated and Continue then // acp
        Synchronize(Ended);
    except
    end;
  finally
    //Free all stuff's
    Grabber.Stream.Free;
    Grabber.Stream := nil;

    //Release all handles
    // (rom) now all connections get closed and Closed is always signalled
    if (hDownload <> nil) and not InternetCloseHandle(hDownload) then
    begin
      ErrorText := GetLastInternetError;
      Synchronize(Error);
    end;
    if (hHostConnection <> nil) and not InternetCloseHandle(hHostConnection) then
    begin
      ErrorText := GetLastInternetError;
      Synchronize(Error);
    end;
    if (hSession <> nil) and not InternetCloseHandle(hSession) then
    begin
      ErrorText := GetLastInternetError;
      Synchronize(Error);
    end;
    Synchronize(Closed);
    SetGrabberStatus(gsStopped);
  end;
end;

function TJvFtpUrlGrabberThread.GetGrabber: TJvFtpUrlGrabber;
begin
  Result := TJvFtpUrlGrabber(FGrabber);
end;

//=== { TJvHttpUrlGrabberThread } ============================================

procedure TJvHttpUrlGrabberThread.Closed;
begin
  Grabber.DoClosed;
end;

constructor TJvHttpUrlGrabberThread.Create(Grabber: TJvCustomUrlGrabber);
begin
  inherited Create(Grabber);
end;

procedure TJvHttpUrlGrabberThread.Execute;
var
  hSession, hHostConnection, hDownload: HINTERNET;
  HostName, FileName, strUserName, strPassword: string;
  UserName, Password: PChar;
  Port: Cardinal;
  Buffer: PChar;
  dwBufLen, dwIndex, dwBytesRead, dwTotalBytes: DWORD;
  HasSize: Boolean;
  Buf: array [0..1024] of Byte;
begin
  Buffer := nil;

  FContinue := True;
  SetGrabberStatus(gsStopped);
  Grabber.Stream := nil;
  hSession := nil;
  hHostConnection := nil;
  hDownload := nil;
  try
    try
      Grabber.ParseUrl(Grabber.Url, Grabber.GetSupportedProtocolMarker,
        HostName, FileName, strUserName, strPassword, Port);
      if strUserName = '' then
        strUserName := Grabber.UserName;
      if strPassword = '' then
        strPassword := Grabber.Password;
      if Port = 0 then
        Port := Grabber.Port;
        
      // Setup the PChars for the call to InternetConnect
      if strUserName = '' then
        UserName := nil
      else
        UserName := PChar(strUserName);
      if strPassword = '' then
        Password := nil
      else
        Password := PChar(strPassword);
      
      ErrorText := '';

      //Connect to the web
      SetGrabberStatus(gsConnecting);
      hSession := InternetOpen(PChar(Grabber.Agent), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
      if hSession = nil then
      begin
        ErrorText := SysErrorMessage(GetLastError);
        Synchronize(Error);
        Exit;
      end;
      InternetSetStatusCallback(hSession, PFNInternetStatusCallback(@DownloadCallBack));


      // Connect to the host
      hHostConnection := InternetConnect(hSession, PChar(HostName), Port,
        UserName, Password, INTERNET_SERVICE_HTTP, 0, DWORD(Self));

      if Terminated then
        Exit;

      if hHostConnection = nil then
      begin
        ErrorText := GetLastInternetError;
        Buffer := nil;
        Synchronize(Error);
        Exit;
      end;

//      InternetSetStatusCallback(hHostConnection, PFNInternetStatusCallback(@DownloadCallBack));
      //Request the file
      hDownload := HttpOpenRequest(hHostConnection, 'GET', PChar(FileName), 'HTTP/1.0',
        PChar(Grabber.Referer), nil, INTERNET_FLAG_RELOAD or INTERNET_FLAG_PRAGMA_NOCACHE, 0);

      if hDownload = nil then
      begin
        ErrorText := GetLastInternetError;
        Synchronize(Error);
        Exit;
      end;
//      InternetSetStatusCallback(hDownload, PFNInternetStatusCallback(@DownloadCallBack));

      //Send the request
      HttpSendRequest(hDownload, nil, 0, nil, 0);

      if Terminated then
        Exit;

      Grabber.Stream := TMemoryStream.Create;

      dwIndex := 0;
      dwBufLen := 1024;
      GetMem(Buffer, dwBufLen);
      HasSize := HttpQueryInfo(hDownload, HTTP_QUERY_CONTENT_LENGTH, Buffer, dwBufLen, dwIndex);
      if Terminated then
        Exit;

      if HasSize then
        Grabber.SetSize(StrToInt(StrPas(Buffer)))
      else
        Grabber.SetSize(0);

      dwTotalBytes := 0;
      SetGrabberStatus(gsGrabbing);
      if HasSize then
      begin
        dwBytesRead := 1;
        while (dwBytesRead > 0) and not Terminated and FContinue do
        begin
          if not InternetReadFile(hDownload, @Buf, SizeOf(Buf), dwBytesRead) then
            dwBytesRead := 0
          else
          begin
            Inc(dwTotalBytes, dwBytesRead);
            Grabber.SetBytesRead(dwTotalBytes);
            Grabber.Stream.Write(Buf, dwBytesRead);
            DoProgress;
          end;
        end;

        SetGrabberStatus(gsStopping);
        if FContinue and not Terminated then
          Synchronize(Ended);
      end
      else
      begin
        while InternetReadFile(hDownload, @Buf, SizeOf(Buf), dwBytesRead) and not Terminated do
        begin
          if dwBytesRead = 0 then
            Break;
          Grabber.Stream.Write(Buf, dwBytesRead);
          Synchronize(UpdateGrabberProgress);
        end;

        SetGrabberStatus(gsStopping);
        if FContinue and not Terminated then
          Synchronize(Ended);
      end;
    except
    end;
  finally
    // Free all stuff's
    if Buffer <> nil then
      FreeMem(Buffer);
    Grabber.Stream.Free;
    Grabber.Stream := nil;

    // Release all handles
    if (hDownload <> nil) and not InternetCloseHandle(hDownload) then
    begin
      ErrorText := GetLastInternetError;
      Synchronize(Error);
    end;
    if (hHostConnection <> nil) and not InternetCloseHandle(hHostConnection) then
    begin
      ErrorText := GetLastInternetError;
      Synchronize(Error);
    end;
    if (hSession <> nil) and not InternetCloseHandle(hSession) then
    begin
      ErrorText := GetLastInternetError;
      Synchronize(Error);
    end;
    Synchronize(Closed);
    SetGrabberStatus(gsStopped);
  end;
end;

function TJvHttpUrlGrabberThread.GetGrabber: TJvHttpUrlGrabber;
begin
  Result := TJvHttpUrlGrabber(FGrabber);
end;

//=== { TJvHttpUrlGrabberDefaultProperties } =================================

constructor TJvHttpUrlGrabberDefaultProperties.Create(AOwner: TJvUrlGrabberDefaultPropertiesList);
begin
  inherited Create(AOwner);
  Port := 80;
end;

function TJvHttpUrlGrabberDefaultProperties.GetSupportedURLName: string;
begin
  Result := TJvHttpUrlGrabber.GetSupportedURLName;
end;

//=== { TJvLocalFileUrlGrabber } =============================================

constructor TJvLocalFileUrlGrabber.Create(AOwner: TComponent; AUrl: string;
  DefaultProperties: TJvCustomUrlGrabberDefaultProperties);
begin
  inherited Create(AOwner, AUrl, DefaultProperties);
  FPreserveAttributes := TJvLocalFileUrlGrabberProperties(DefaultProperties).PreserveAttributes;
end;

constructor TJvLocalFileUrlGrabber.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FPreserveAttributes := True;
end;

class function TJvLocalFileUrlGrabber.CanGrab(const Url: string): Boolean;
begin
  // accepts "file://", UNC and local path and existing files
  Result := (LowerCase(Copy(Url, 1, 7)) = cFilePrefix) or (Copy(Url,1,2) = '//') or
    (Copy(Url, 2,2) = ':\') or FileExists(Url);
end;

class function TJvLocalFileUrlGrabber.GetDefaultPropertiesClass: TJvCustomUrlGrabberDefaultPropertiesClass;
begin
  Result := TJvLocalFileUrlGrabberProperties;
end;

function TJvLocalFileUrlGrabber.GetGrabberThreadClass: TJvCustomUrlGrabberThreadClass;
begin
  Result := TJvLocalFileUrlGrabberThread;
end;

class function TJvLocalFileUrlGrabber.GetSupportedProtocolMarker: string;
begin
  Result := cFilePrefix;
end;

class function TJvLocalFileUrlGrabber.GetSupportedURLName: string;
begin
  Result := 'LocalFile';
end;

procedure TJvLocalFileUrlGrabber.ParseUrl(Url, Protocol: string;
  var Host, FileName, UserName, Password: string; var Port: Cardinal);
begin
  ParseUrl(Url, FileName);
end;

procedure TJvLocalFileUrlGrabber.ParseUrl(const Url: string;
  var FileName: string);
begin
  FileName := StringReplace(Url, '/', '\', [rfReplaceAll]);
  if AnsiSameText(Copy(Url, 1, 7), cFilePrefix) then
    FileName := Copy(FileName, 8, MaxInt)
  else
    FileName := ExpandUNCFilename(FileName);
end;

//=== { TJvLocalFileUrlGrabberThread } =======================================

procedure TJvLocalFileUrlGrabberThread.Execute;
var
  FileName: string;
  BytesRead, TotalBytes: DWORD;
  Buf: array [0..1023] of Byte;
  AFileStream: TFileStream;
  Attrs: Integer;
begin
  SetGrabberStatus(gsStopped);
  Grabber.Stream := nil;
  Grabber.ParseUrl(Grabber.Url, FileName);
  if not FileExists(FileName) then
  begin
    ErrorText := Format(RsFileNotFoundFmt, [FileName]);
    Synchronize(Error);
    Exit;
  end;

  if Grabber.PreserveAttributes then
    Attrs := GetFileAttributes(PChar(FileName))
  else
    Attrs := 0;
  try
    ErrorText := '';
    SetGrabberStatus(gsConnecting);
    Grabber.Stream := TMemoryStream.Create;
    AFileStream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyNone);
    try
      Grabber.SetSize(AFileStream.Size);
      Grabber.SetBytesRead(0);
      Status := 0;
      DoProgress;
      TotalBytes := 0;
      BytesRead := 1;
      SetGrabberStatus(gsGrabbing);
      while (BytesRead <> 0) and not Terminated and Continue do
      begin
        BytesRead := AFileStream.Read(Buf, SizeOf(Buf));
        Inc(TotalBytes, BytesRead);
        Grabber.SetBytesRead(TotalBytes);
        Status := Grabber.BytesRead;
        if BytesRead > 0 then
          Grabber.Stream.Write(Buf, BytesRead);
        DoProgress;
      end;
      SetGrabberStatus(gsStopping);
      if not Terminated and Continue then // acp
        Synchronize(Ended);
      if Grabber.PreserveAttributes and FileExists(Grabber.FileName) then
        SetFileAttributes(PChar(Grabber.FileName), Attrs);
    finally
      AFileStream.Free;
      Grabber.Stream.Free;
      Grabber.Stream := nil;
      SetGrabberStatus(gsStopped);
    end;
  except
//    Application.HandleException(Self);
  end;
end;

function TJvLocalFileUrlGrabberThread.GetGrabber: TJvLocalFileUrlGrabber;
begin
  Result := TJvLocalFileUrlGrabber(FGrabber);
end;

//=== { TJvLocalFileUrlGrabberProperties } ===================================

constructor TJvLocalFileUrlGrabberProperties.Create(AOwner: TJvUrlGrabberDefaultPropertiesList);
begin
  inherited Create(AOwner);
  FPreserveAttributes := True;
end;

procedure TJvLocalFileUrlGrabberProperties.Assign(Source: TPersistent);
begin
  inherited Assign(Source);
  if Source is TJvLocalFileUrlGrabberProperties then
    with Source as TJvLocalFileUrlGrabberProperties do
      Self.PreserveAttributes := PreserveAttributes;
end;

function TJvLocalFileUrlGrabberProperties.GetSupportedURLName: string;
begin
  Result := TJvLocalFileUrlGrabber.GetSupportedURLName;
end;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvQUrlGrabbers.pas,v $';
    Revision: '$Revision: 1.23 $';
    Date: '$Date: 2005/02/06 14:06:32 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

initialization
  {$IFDEF UNITVERSIONING}
  RegisterUnitVersion(HInstance, UnitVersioning);
  {$ENDIF UNITVERSIONING}

  RegisterUrlGrabberClasses;

finalization
  {$IFDEF UNITVERSIONING}
  UnregisterUnitVersion(HInstance);
  {$ENDIF UNITVERSIONING}

end.