Arrêter un ReceiveHTTPFile par un timeout ou un bouton

[Marc56]

Bonjour,

Dans un de mes programmes, j'utilise ReceiveHTTPFile
(ou parfois URLDownloadToFile_ pour contourner le bug référencé de cette fonction qui ne marche pas avec certaines pages web)

Problème: Lorsqu'un serveur est down, busy ou n'existe pas, ReceiveHTTPFile s'arrête bien, mais au bout de plusieurs secondes, parfois jusqu'à 30. Sachant que les serveurs que j'interroge sont toujours rapidement accessible, j'aimerais bien pouvoir mettre un timeout ou permettre à l'utilisateur d'arrêter la réception.

J'ai envisagé d'utiliser un thread et de faire un KillThread, mais cette fonction est déconseillée, dixit la doc: « ...Termine le thread spécifié, préalablement créé avec CreateThread(). Cette fonction est très, dangereuse, ne l'utilisez que si nécessaire, car quand un thread est tué, il n'a aucune chance de libérer ses propres ressources (comme sa pile par exemple). »

[nico]

Quelque chose comme ça, à testé avec un serveur lent:

Code : Tout sélectionner

#INTERNET_OPEN_TYPE_DIRECT = 1
#INTERNET_FLAG_RELOAD=$80000000
#INTERNET_OPTION_RECEIVE_TIMEOUT=6

Procedure.l DownloadURL(Url.s, File.s) 
  Protected HInternet.i, HUrl.i, *Buffer, IDFile.l
  Protected bytes_read.l, BufferLen.l = 1024
  Protected Agent.s = "Mozilla/5.0 (Windows NT 6.1; WOW64; rv:7.0.1) Gecko/20100101 Firefox/7.0.1"
  Protected Res.l = 0
  Protected dwTimeOut.l = 3000 ; = 3 secondes
  
  *Buffer = AllocateMemory(BufferLen)
  If *Buffer
    IDFile = OpenFile(#PB_Any, File)
    If IDFile
      HInternet = InternetOpen_(@Agent, #INTERNET_OPEN_TYPE_DIRECT, @"", @"", 0)
      If HInternet
        HUrl = InternetOpenUrl_(HInternet, @Url, #Null, 0, #INTERNET_FLAG_RELOAD, @dwContext) 
        If HUrl
          If InternetSetOption_(HUrl, #INTERNET_OPTION_RECEIVE_TIMEOUT, @dwTimeOut, SizeOf(dwTimeOut))
            While InternetReadFile_(HUrl, *buffer, BufferLen, @bytes_read) = 1
              If bytes_read=0
                Break
              EndIf 
              If WriteData(IDFile, *buffer, bytes_read) = bytes_read
                Res = 1
              Else
                Res = 0
                Break
              EndIf 
            Wend 
          EndIf 
          InternetCloseHandle_(HUrl) 
        EndIf
        InternetCloseHandle_(HInternet)  
      EndIf
      CloseFile(IDFile)
    EndIf
    FreeMemory(*Buffer)
  EndIf 
  
  
  If Res = 0
    If FileSize(File) > -1
      DeleteFile(File)
    EndIf
  EndIf
  
  ProcedureReturn Res 
EndProcedure

Debug DownloadURL("http://www.purearea.net/pb/CodeArchiv/Readme.txt", "C:\Readme.txt") 

[Marc56]

Merci Nico, je vais étudier et tester cela.