jvhttpgrabber.pas

East make Tray Icon in delphi

        FOnReceived(Self);
    INTERNET_STATUS_CLOSING_CONNECTION:
      if Assigned(FOnClosing) then
        FOnClosing(Self);
    INTERNET_STATUS_CONNECTION_CLOSED:
      if Assigned(FOnClosed) then
        FOnClosed(Self);
    INTERNET_STATUS_REQUEST_COMPLETE:
      if Assigned(FOnRequest) then
        FOnRequest(Self);
    INTERNET_STATUS_REDIRECT:
      if Assigned(FOnRedirect) then
        FOnRedirect(Self);
    INTERNET_STATUS_STATE_CHANGE:
      if Assigned(FOnStateChange) then
        FOnStateChange(Self);
  end;
end;

procedure TJvHTTPGrabber.ThreadFinished(Sender: TObject);
begin
  FThread := nil;
end;

//=== TJvHttpThread ==========================================================

constructor TJvHttpThread.Create(Url, Referer, Username, FileName,
  Password: string; OutPutMode: TJvOutputMode; AOnError: TJvErrorEvent;
  AOnDoneFile: TJvDoneFileEvent; AOnDoneStream: TJvDoneStreamEvent;
  AOnProgress: TJvHTTPProgressEvent; Agent: string; AOnStatus: TJvFTPProgressEvent);
begin
  inherited Create(True);
  FUrl := Url;
  FReferer := Referer;
  FUsername := Username;
  FFileName := FileName;
  FPassword := Password;
  FOutputMode := OutPutMode;
  FOnError := AOnError;
  FOnDoneFile := AOnDoneFile;
  FOnDoneStream := AOnDoneStream;
  FOnProgress := AOnProgress;
  FAgent := Agent;
  FOnStatus := AOnStatus;
  FContinue := True;
  FCriticalSection := TCriticalSection.Create;
end;

destructor TJvHttpThread.Destroy;
begin
  FCriticalSection.Destroy;
  // (rom) added inherited Destroy 
  inherited Destroy;
end;

procedure TJvHttpThread.Ended;
begin
  FCriticalSection.Enter;
  FStream.Position := 0;
  if FOutputMode = omStream then
  begin
    if Assigned(FOnDoneStream) then
      FOnDoneStream(Self, FStream, FStream.Size, FUrl)
  end
  else
  begin
    FStream.SaveToFile(FFileName);
    if Assigned(FOnDoneFile) then
      FOnDoneFile(Self, FFileName, FStream.Size, FUrl);
  end;
  FCriticalSection.Leave;
end;

procedure TJvHttpThread.Error;
begin
  FCriticalSection.Enter;
  if Assigned(FOnError) then
    FOnError(Self, FErrorText);
  FCriticalSection.Leave;
end;

function TJvHttpThread.GetLastErrorMsg: string;
begin
  Result := SysErrorMessage(GetLastError);
end;

procedure DownloadCallBack(Handle: HInternet; Context: DWord;
  Status: DWord; Info: Pointer; StatLen: DWord); stdcall;
begin
  with TJvHttpThread(Context) do
    if Assigned(FOnStatus) then
      FOnStatus(TJvHttpThread(Context), Status, FUrl);
end;

procedure TJvHttpThread.Execute;
var
  hSession, hHostConnection, hDownload: HINTERNET;
  HostName, FileName: string;
  Username, Password: PChar;
  Buffer: PChar;
  dwBufLen, dwIndex, dwBytesRead, dwTotalBytes: DWORD;
  HasSize: Boolean;
  Buf: array [0..1024] of Byte;

  procedure ParseUrl(Value: string);
  begin
    HostName := '';
    FileName := '';
    if Pos('HTTP://', UpperCase(Value)) <> 0 then
      Value := Copy(Value, 8, Length(Value));
    if Pos('/', Value) <> 0 then
    begin
      HostName := Copy(Value, 1, Pos('/', Value) - 1);
      FileName := Copy(Value, Pos('/', Value) + 1, Length(Value));
    end
    else
      HostName := Value;
  end;

begin
  if FUrl = '' then
  begin
    FErrorText := SURLIsEmpty;
    Error;
    Exit;
  end;

  // (rom) secure thread against exceptions
  Buffer := nil;

  FStream := nil;
  hSession := nil;
  hHostConnection := nil;
  hDownload := nil;
  try
    try
      ParseUrl(FUrl);
      FErrorText := '';

      //Connect to the web
      hSession := InternetOpen(PChar(FAgent), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
      if hSession = nil then
      begin
        FErrorText := GetLastErrorMsg;
        Error;
        Exit;
      end;

      //Connect to the hostname
      if FUsername = '' then
        Username := nil
      else
        Username := PChar(FUsername);
      if FPassword = '' then
        Password := nil
      else
        Password := PChar(FPassword);
      hHostConnection := InternetConnect(hSession, PChar(HostName), INTERNET_DEFAULT_HTTP_PORT,
        Username, Password, INTERNET_SERVICE_HTTP, 0, DWORD(Self));
      if hHostConnection = nil then
      begin
        dwIndex := 0;
        dwBufLen := 1024;
        GetMem(Buffer, dwBufLen);
        InternetGetLastResponseInfo(dwIndex, Buffer, dwBufLen);
        FErrorText := Buffer;
        FreeMem(Buffer);
        Error;
        Exit;
      end;

      FCriticalSection.Enter;
      InternetSetStatusCallback(hHostConnection, PFNInternetStatusCallback(@DownloadCallBack));
      //Request the file
      // (rom) any difference here?
      hDownload := HttpOpenRequest(hHostConnection, 'GET', PChar(FileName), 'HTTP/1.0', PChar(FReferer),
        nil, INTERNET_FLAG_RELOAD, 0);
      FCriticalSection.Leave;

      if hDownload = nil then
      begin
        FErrorText := GetLastErrorMsg;
        Error;
        Exit;
      end;

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

      FStream := TMemoryStream.Create;

      dwIndex := 0;
      dwBufLen := 1024;
      GetMem(Buffer, dwBufLen);
      HasSize := HttpQueryInfo(hDownload, HTTP_QUERY_CONTENT_LENGTH, Buffer, dwBufLen, dwIndex);
      if HasSize then
        FTotalBytes := StrToInt(StrPas(Buffer))
      else
        FTotalBytes := 0;

      dwTotalBytes := 0;
      if HasSize then
      begin
        dwBytesRead := 1;
        while dwBytesRead > 0 do
        begin
          if not InternetReadFile(hDownload, @Buf, SizeOf(Buf), dwBytesRead) then
            dwBytesRead := 0
          else
          begin
            Inc(dwTotalBytes, dwBytesRead);
            FBytesRead := dwTotalBytes;
            FStream.Write(Buf, dwBytesRead);
            Progress;
          end;
        end;
        if FContinue then
          Ended;
        FCriticalSection.Leave;
      end
      else
      begin
        FCriticalSection.Enter;
        while InternetReadFile(hDownload, @Buf, SizeOf(Buf), dwBytesRead) do
        begin
          if dwBytesRead = 0 then Break;
//          Inc(dwTotalBytes,dwBytesRead);
          FStream.Write(Buf, dwBytesRead);
          Progress;
        end;
        if FContinue then
          Ended;
        FCriticalSection.Leave;
      end;
    except
    end;
  finally
    //Free all stuff's
    if Buffer <> nil then
    FreeMem(Buffer);
    FStream.Free;

    //Release all handles
    if hDownload <> nil then
      InternetCloseHandle(hDownload);
    if hHostConnection <> nil then
      InternetCloseHandle(hHostConnection);
    if hSession <> nil then
      InternetCloseHandle(hSession);
  end;
end;

procedure TJvHttpThread.Progress;
begin
  FCriticalSection.Enter;
  if Assigned(FOnProgress) then
    FOnProgress(Self, 0, FBytesRead, FTotalBytes, FUrl, FContinue);
  FCriticalSection.Leave;
end;

end.