PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

wer könnte diesen Code Fixen

https://www.purebasic.fr/german/viewtopic.php?t=5325

Seite 1 von 1

wer könnte diesen Code Fixen

Verfasst: 24.10.2005 18:42
von UpN
Hi ich hab nen Quellcode geladen und hab ein prob ich krieg imer eienn fehler in Zeile 68 Incorrect numbers of parameters

hier der code

Code: Alles auswählen

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

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 

  AllocateMemory(0,Buffer) 
  UseMemory(0) 

  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, MemoryID(), Buffer, @Bytes) 
    If Bytes = 0 
      isLoop=0 
    Else 
      fBytes=fBytes+Bytes 
        SetGadgetText(#Label2, "Received Bytes: " + Str(fBytes)) 
      If myMax >= fBytes: SetGadgetState(#progressbar, fBytes): EndIf 
      UseFile(1) 
      WriteData(MemoryID(), 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, #PB_Window_SystemMenu | #PB_Window_TitleBar | #PB_Window_ScreenCentered , "Download with Progress") 

  If CreateGadgetList(WindowID()) 
      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_EventGadget    
      Select EventGadgetID() 
        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_EventCloseWindow 
EndIf 
End 

; ExecutableFormat=Windows
; EnableXP
; EOF
ist von hier
http://www.purearea.net/pb/CodeArchiv/I ... ressBar.pb

Edit by NicTheQuick: Code-Tags gesetzt

Verfasst: 24.10.2005 18:48
von ts-soft
Versuchs mal hiermit:

Code: Alles auswählen

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 

  ;AllocateMemory(0,Buffer) 
  ;UseMemory(0) 
  Mem = 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, Mem, Buffer, @Bytes) 
    If Bytes = 0 
      isLoop=0 
    Else 
      fBytes=fBytes+Bytes 
        SetGadgetText(#Label2, "Received Bytes: " + Str(fBytes)) 
      If myMax >= fBytes: SetGadgetState(#progressbar, fBytes): EndIf 
      UseFile(1) 
      WriteData(Mem, Bytes) 
    EndIf 
      DOEVENTS() 
  Until isLoop=0 
  InternetCloseHandle_(hURL) 
  InternetCloseHandle_(hInet) 
  SetGadgetState(#progressbar, 0) 
  CloseFile(1)    
  FreeMemory(Mem) 
EndProcedure 



If OpenWindow(#Window, 0, 0, 400, 175, #PB_Window_SystemMenu | #PB_Window_TitleBar | #PB_Window_ScreenCentered , "Download with Progress") 

  If CreateGadgetList(WindowID()) 
      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_EventGadget    
      Select EventGadgetID() 
        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_EventCloseWindow 
EndIf 
End
Der AllocateMemory-Befehl wurde zwischendurch geändert, so das es nicht mehr funktoniert

Verfasst: 24.10.2005 18:49
von hardfalcon
@UpN: kennst du die Code-tags? Die sollen ja angeblich helfen, dass nicht die hälfte deines Codes zu Smileys verwurstelt wird... :wink:

Verfasst: 24.10.2005 18:52
von UpN
@ TS Soft jadanke das klappt nur kann ich es auch so einstellen das der eine vorher einprogrammierte Download URL nimmt?
Und noch ein Textabschnitt wo ich ein paar infos einprogrammieren kann

Wäre super nett

Verfasst: 24.10.2005 18:56
von MVXA
> kann ich es auch so einstellen das der eine vorher einprogrammierte Download URL nimmt?
Ja, kannst du. Nur du solltest auch etwas selbst schreiben. Wir sind
Programmierer und keine Code Generatoren für Anfänger. Außerdem
behaupte ich einfach mal, dass man mit selbst schreiben effektiver lernt <_<.

Verfasst: 24.10.2005 19:01
von UpN
okay ich habs schon selber gemacht hab einfach die größe in zeile 121 geändert
abertrotzdem danke

Verfasst: 24.10.2005 19:05
von MVXA
Du könntest dir auch Zeile 136 anschauen und überlegen was da
gemacht wird.
Alle Zeiten sind UTC+02:00
Seite 1 von 1

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de