* * *    
Главная » Статьи » Код PB

Просмотров: 2710 | Дата: 09.05.2024 | Коментарии (0)

Прогресс бар загрузки




Code
Enumeration  
  #Window  
  #cmdStart  
  #progressbar  
  #Frame  
  #cmdExit  
  #Label  
  #Label2  
  #URL
  #HTTP_QUERY_CONTENT_LENGTH=5  
EndEnumeration  

Global Name.s

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.q GetContentLength(Url$) ; узнать вес скачиваемого файла
  Protected FileSizet.s=Space(20),FileSize.q, Size,hINET,hURL  
  hINET=InternetOpen_("PureBasic",0,0,0,0)  
  If hINET  
  hURL =InternetOpenUrl_(hINET,Url$,0,0,$80000000,0)  
  If hURL  
  Size=Len(FileSizet)  
  HttpQueryInfo_(hURL,#HTTP_QUERY_CONTENT_LENGTH,@FileSizet,@Size,#Null)  
  FileSize=Val(FileSizet)  
  InternetCloseHandle_(hURL)  
  InternetCloseHandle_(hINET)  
  Else  
  InternetCloseHandle_(hINET)  
  EndIf  
  EndIf  
  ProcedureReturn FileSize  
EndProcedure  

Procedure UrlToFileWithProgress(*x)  
  isLoop.b=1  
  Bytes.l=0  
  fBytes.l=0  
  Buffer.l=40960  
  INTERNET_FLAG_RELOAD.l = $80000000  
  URL.s= PeekS(*x)

  memID=AllocateMemory(Buffer)  

  Result = CreateFile(1, Name)  
  hInet = InternetOpen_("", 1, #Null, #Null, 0)  
  hURL = InternetOpenUrl_(hInet, URL, #Null, 0, INTERNET_FLAG_RELOAD, 0)  

  myMax=GetContentLength(URL)
   
  SetGadgetText(#Label, "Размер файла : " + StrF(myMax/1048576)+" Мбайт")
  SendMessage_(GadgetID(#progressbar), $400 + 6, 0, myMax) ; ; прогрес бар  
   
  Repeat ;начать загрузку
  InternetReadFile_(hURL, memID, Buffer, @Bytes)  
  If Bytes = 0  
  isLoop=0  
  Else  
  fBytes=fBytes+Bytes
  SetGadgetText(#Label2, "Получено байт : " + StrF(fBytes/1048576)+" Мбайт")  
  If myMax >= fBytes: SetGadgetState(#progressbar, fBytes): EndIf  
  WriteData(1,memID, Bytes)  
  EndIf  
  Until isLoop=0  
  InternetCloseHandle_(hURL)  
  InternetCloseHandle_(hInet)  
  SetGadgetState(#progressbar, 0)  
  CloseFile(1)  
  FreeMemory(memID)  
EndProcedure  

If OpenWindow(#Window, 0, 0, 400, 175, "Скачать с Прогресс-Бар", #PB_Window_SystemMenu | #PB_Window_TitleBar | #PB_Window_ScreenCentered )  

  StringGadget(#URL, 10, 10, 380, 20, "http://cs12649.vkontakte.ru/u84123874/video/bde0ec0f3e.240.mp4")  
  ProgressBarGadget(#progressbar, 10, 40, 380, 30, 0,100 , #PB_ProgressBar_Smooth)  
  TextGadget(#Label, 10, 80,300,20,"Размер файла : ")  
  TextGadget(#Label2, 10, 100,300,20,"Получено байт : ")  
  Frame3DGadget(#Frame, -10, 120, 420, 110, "")  
  ButtonGadget(#cmdExit, 160, 140, 110, 25, "Выход")  
  ButtonGadget(#cmdStart, 280, 140, 110, 25, "Старт", #PB_Button_Default)  

   
  Repeat  
  Event = WaitWindowEvent()  
  If Event = #PB_Event_Gadget  
  Select EventGadget()  
  Case #cmdStart  
  URL.s = GetGadgetText(#URL)  
  Name.s= Right(URL, FindString(Reverse(URL),"/",1)-1) ;получить имя файла (проверка /)  
  If IsThread(ThreadID)=0  
  ThreadID=CreateThread(@UrlToFileWithProgress(), @URL)
  Else
  MessageRequester("", "Программа занята!", #MB_OK|#MB_ICONWARNING)
  EndIf  
  Case #cmdExit  
  End  
  EndSelect  
  EndIf  
  Until Event = #PB_Event_CloseWindow  
EndIf  
End










Сайт посвящён языку программирования PureBasic — коммерческий компилятор языка программирования, использующего синтаксис BASIC. Предназначен для создания кроссплатформенных приложений для AmigaOS, Linux, Microsoft Windows, Windows NT и Mac OS X. Разработан компанией Fantaisie Software.