jvqftpgrabber.pas

East make Tray Icon in delphi

        FOnConnected(Self);
    INTERNET_STATUS_SENDING_REQUEST:
      if Assigned(FOnSending) then
        FOnSending(Self);
    INTERNET_STATUS_REQUEST_SENT:
      if Assigned(FOnSent) then
        FOnSent(Self);
    INTERNET_STATUS_RECEIVING_RESPONSE:
      if Assigned(FOnReceiving) then
        FOnReceiving(Self);
    INTERNET_STATUS_RESPONSE_RECEIVED:
      if Assigned(FOnReceived) then
        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 TJvFTPGrabber.ThreadFinished(Sender: TObject);
begin
  FThread := nil;
end;

//=== TJvFtpThread ===========================================================

constructor TJvFtpThread.Create(Url, UserName, FileName,
  Password: string; OutputMode: TJvOutputMode; PassiveFTP: Boolean; AOnError: TJvErrorEvent;
  AOnDoneFile: TJvDoneFileEvent; AOnDoneStream: TJvDoneStreamEvent;
  AOnProgress: TJvFTPProgressEvent; Mode: TJvDownloadMode; Agent: string;
  AOnStatus: TJvFTPProgressEvent; Sender: TObject; AOnClosedConnection: TNotifyEvent); // acp
begin
  inherited Create(True);
  FUrl := Url;
  FUserName := UserName;
  FFileName := FileName;
  FPassword := Password;
  FOutputMode := OutputMode;
  FPassiveFTP := PassiveFTP; 
  FOnError := AOnError;
  FOnDoneFile := AOnDoneFile;
  FOnDoneStream := AOnDoneStream;
  FOnProgress := AOnProgress;
  FOnStatus := AOnStatus;
  FMode := Mode;
  FAgent := Agent;
  FSender := Sender; // acp
  FOnClosed := AOnClosedConnection;
end;

procedure TJvFtpThread.Closed;
begin
  if Assigned(FOnClosed) then
    FOnClosed(Self);
end;

procedure TJvFtpThread.Ended;
begin
  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;
end;

procedure TJvFtpThread.Error;
begin
  if Assigned(FOnError) then
    FOnError(Self, FErrorText);
end;

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

procedure FtpDownloadCallBack(Handle: HInternet; Context: DWORD;
  Status: DWORD; Info: Pointer; StatLen: DWORD); stdcall;
begin
  with TJvFtpThread(Context) do
    if Assigned(FOnStatus) then
      FOnStatus(TJvFtpThread(Context), Status, FUrl);
end;

procedure TJvFtpThread.Execute;
const
  cPassive: array [Boolean] of DWORD = (0, INTERNET_FLAG_PASSIVE);
var
  hSession, hHostConnection, hDownload: HINTERNET;
  HostName, FileName: string;
  UserName, Password: PChar;
  BytesRead, TotalBytes: DWORD;
  Buf: array [0..1023] of Byte;
  dwFileSizeHigh: DWORD;
  Buffer: Pointer;
  dwBufLen, dwIndex: DWORD;

  procedure ParseUrl(Value: string);
  begin
    HostName := '';
    FileName := '';
    if Pos('FTP://', UpperCase(Value)) <> 0 then
      Value := Copy(Value, 7, 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
  // (rom) secure thread against exceptions
  FStream := nil;
  hSession := nil;
  hHostConnection := nil;
  hDownload := nil;
  try
    try
      FErrorText := '';
      ParseUrl(FUrl);

      //Connect to the web
      hSession := InternetOpen(PChar(FAgent), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
      if hSession = nil then
      begin
        FErrorText := GetLastErrorMsg;
        Synchronize(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_FTP_PORT,
        UserName, Password, INTERNET_SERVICE_FTP, cPassive[FPassiveFTP], 0);
      if hHostConnection = nil then
      begin
        dwIndex := 0;
        dwBufLen := 1024;
        GetMem(Buffer, dwBufLen);
        InternetGetLastResponseInfo(dwIndex, Buffer, dwBufLen);
        FErrorText := StrPas(Buffer);
        FreeMem(Buffer);

        Synchronize(Error);
        Exit;
      end;

      InternetSetStatusCallback(hHostConnection, PFNInternetStatusCallback(@FtpDownloadCallBack));

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

      if hDownload = nil then
      begin
        FErrorText := GetLastErrorMsg;
        Synchronize(Error);
        Exit;
      end;
      (FSender as TJvFTPGrabber).FSize := FtpGetFileSize(hDownload, @dwFileSizeHigh); // acp

      FStream := TMemoryStream.Create;

      TotalBytes := 0;
      BytesRead := 1;
      while (BytesRead <> 0) and (not Terminated) do // acp
      begin
        if not InternetReadFile(hDownload, @Buf, SizeOf(Buf), BytesRead) then
          BytesRead := 0
        else
        begin
          Inc(TotalBytes, BytesRead);
          FBytesRead := TotalBytes;
          FStream.Write(Buf, BytesRead);
          if Assigned(FOnProgress) then
            Synchronize(Progress);
        end;
      end;
      if not Terminated then // acp
        Synchronize(Ended);
    except
    end;
  finally
    //Free all stuff's
    FStream.Free;

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

procedure TJvFtpThread.Progress;
begin
  if Assigned(FOnProgress) then
    FOnProgress(Self, FBytesRead, FUrl);
end;

end.