[SOCPB 2006] Projet #4 : MAJ PB4 les codes de CodeArchiv

[Progi1984]

Projet #4

Leader : MegaNet

Membres :

Bon Code

Note :
Le Leader a pour but :
+ d'orienter le développement du projet
+ de regrouper les codes recus
+ de formater le code final (lisibilité, commentaire)
Donc ses paroles sont lettres d'évangiles

[Progi1984]

MegaNet, contacte Andre pour la MAJ des codes pour PB4 car une partie a déjà été faite, et je crois qu'il ya quelques impératifs lors de la traduction pour CodeArchiv.

[meganet]

Ok, je vais le contacter,.
Merci @+++

[Progi1984]

News au 10 Juillet ?

[poshu]

Ma modeste particicipation:

Mise à jour de Download_with_ProgressBar.pb

Code : Tout sélectionner

; English forum: http://purebasic.myforums.net/viewtopic.php?t=8331&highlight=
; Author: V2
; Date: 13. November 2003
; Update: 13 July 2006 SOCPB

Enumeration 
  #Window 
  #cmdStart 
  #progressbar 
  #Frame 
  #cmdExit 
  #Label 
  #Label2 
  #URL 
EndEnumeration 


Procedure.s Reverse(s.s) 
  O.s=Mid(s,Len(s),1) 
  P=Len(s)-1 
  While P>0 
    O.s=O+Mid(s,P,1) 
    P=P-1 
  Wend 
  ProcedureReturn O 
EndProcedure 

Procedure SetProgressbarRange(Gadget.l, Minimum.l, Maximum.l) 
  ;? SetProgressbarRange(#progressbar, 0, 100) 
  PBM_SETRANGE32 = $400 + 6 
  SendMessage_(GadgetID(Gadget), PBM_SETRANGE32, Minimum, Maximum) 
EndProcedure 

Procedure DoEvents() 
  msg.MSG 
  If PeekMessage_(msg,0,0,0,1) 
    TranslateMessage_(msg) 
    DispatchMessage_(msg) 
  Else 
    Sleep_(1) 
  EndIf 
EndProcedure 

Procedure.s GetQueryInfo(hHttpRequest.l, iInfoLevel.l) 
  lBufferLength.l=0 
  lBufferLength = 1024 
  sBuffer.s=Space(lBufferLength) 
  HttpQueryInfo_(hHttpRequest, iInfoLevel, sBuffer, @lBufferLength, 0) 
  ProcedureReturn Left(sBuffer, lBufferLength) 
EndProcedure 

Procedure UrlToFileWithProgress(myFile.s, URL.s) 
  isLoop.b=1 
  Bytes.l=0 
  fBytes.l=0 
  Buffer.l=4096 
  res.s="" 
  tmp.s="" 
  
  OpenType.b=1 
  INTERNET_FLAG_RELOAD.l = $80000000 
  INTERNET_DEFAULT_HTTP_PORT.l = 80 
  INTERNET_SERVICE_HTTP.l = 3 
  HTTP_QUERY_STATUS_CODE.l = 19 
  HTTP_QUERY_STATUS_TEXT.l = 20 
  HTTP_QUERY_RAW_HEADERS.l = 21 
  HTTP_QUERY_RAW_HEADERS_CRLF.l = 22 
  
  *memorybuffer = AllocateMemory(Buffer) 
  
  
  Result = CreateFile(1, myFile) 
  hInet = InternetOpen_("", OpenType, #Null, #Null, 0) 
  hURL = InternetOpenUrl_(hInet, URL, #Null, 0, INTERNET_FLAG_RELOAD, 0) 
  
  ;get Filesize 
  domain.s = ReplaceString(Left(URL,(FindString(URL, "/",8) - 1)),"http://","") 
  hInetCon = InternetConnect_(hInet,domain, INTERNET_DEFAULT_HTTP_PORT, #Null, #Null, INTERNET_SERVICE_HTTP, 0, 0) 
  If hInetCon > 0 
    hHttpOpenRequest = HttpOpenRequest_(hInetCon, "HEAD", ReplaceString(URL,"http://"+domain+"/",""), "http/1.1", #Null, 0, INTERNET_FLAG_RELOAD, 0) 
    If hHttpOpenRequest > 0 
      iretval = HttpSendRequest_(hHttpOpenRequest, #Null, 0, 0, 0) 
      If iretval > 0 
        tmp = GetQueryInfo(hHttpOpenRequest, HTTP_QUERY_STATUS_CODE) 
        If Trim(tmp) = "200" 
          tmp = GetQueryInfo(hHttpOpenRequest, HTTP_QUERY_RAW_HEADERS_CRLF) 
          If FindString(tmp,"Content-Length:",1)>0 
            ii.l=FindString(tmp, "Content-Length:",1) + Len("Content-Length:") 
            tmp = Mid(tmp, ii, Len(tmp)-ii) 
            myMax = Val(Trim(tmp)) 
          EndIf 
        EndIf 
      EndIf 
    EndIf 
  EndIf 
  
  SetGadgetText(#Label, "Filesize: " + Str(myMax)) 
  SetProgressbarRange(#progressbar,0,myMax) 
  
  ;start downloading 
  Repeat 
    InternetReadFile_(hURL, *memorybuffer, Buffer, @Bytes) 
    If Bytes = 0 
      isLoop=0 
    Else 
      fBytes=fBytes+Bytes 
      SetGadgetText(#Label2, "Received Bytes: " + Str(fBytes)) 
      If myMax >= fBytes: SetGadgetState(#progressbar, fBytes): EndIf 
      WriteData(1,*memorybuffer, Bytes) 
    EndIf 
    DoEvents() 
  Until isLoop=0 
  InternetCloseHandle_(hURL) 
  InternetCloseHandle_(hInet) 
  SetGadgetState(#progressbar, 0) 
  CloseFile(1)    
  FreeMemory(0) 
EndProcedure 



If OpenWindow(#Window, 0, 0, 400, 175 , "Download with Progress", #PB_Window_SystemMenu | #PB_Window_TitleBar | #PB_Window_ScreenCentered) 
  
  If CreateGadgetList(WindowID(#Window)) 
    StringGadget(#URL, 10, 10, 380, 20, "http://www.largeformatphotography.info/qtluong/sequoias.big.jpeg") 
    ProgressBarGadget(#progressbar, 10, 40, 380, 30, 0,100 , #PB_ProgressBar_Smooth) 
    TextGadget(#Label, 10, 80,300,20,"Filesize:") 
    TextGadget(#Label2, 10, 100,300,20,"Bytes received:") 
    Frame3DGadget(#Frame, -10, 120, 420, 110, "") 
    ButtonGadget(#cmdExit, 160, 140, 110, 25, "Exit") 
    ButtonGadget(#cmdStart, 280, 140, 110, 25, "Start", #PB_Button_Default) 
  EndIf 
  
  Repeat 
    EventID.l = WaitWindowEvent() 
    If EventID = #PB_Event_Gadget
      Select EventGadget()
        Case #cmdStart 
          
          URL.s = GetGadgetText(#URL) 
          
          ;get filename (checking /) 
          myFile.s= Right(URL, FindString(Reverse(URL),"/",1)-1) 
          ;request path 
          myFolder.s = PathRequester ("Where do you want to save '" + myFile + "'?", "C:\") 
          
          UrlToFileWithProgress(myFolder + myFile, URL) 
        Case #cmdExit 
          End 
      EndSelect 
    EndIf               
  Until EventID = #PB_Event_CloseWindow 
EndIf 
End

Je sais pas si ca avait déjà été fait, mais comme j'en avais besoin, autant partager.

[Progi1984]

Slt, je viens au news...

Où en êtes vous ?
Abandonné ?
Etat du projet ?
Roadmap ?