PureBoard

Verfasst: **22.01.2006 00:22**

Ich hab grad das problem, das ich meinen eigenen code nicht wirklich testen kann (56k Modem...), aber er sollte schon funktionieren, er müsste jetzt auch mit (fast) allen Seiten funktionieren.

Code: Alles auswählen

Enumeration 
  #Window 
  #cmdStart 
  #progressbar 
  #Frame 
  #cmdExit 
  #Label 
  #Label2 
  #URL 
  #state
  #bytesAtAll
  #debug
  #icon
  #restore
  #hide
  #end
EndEnumeration 

NewList Visited.s()
NewList to_download.s()

Global TempDir.s
TempDir=Space(256)
GetTempPath_(256,@TempDir)

Global bytesAtAll.l, Close.b

Declare DO_EVENTS(status.b)
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 openURL(URL.s, OpenType.b, file$) 
  ;Debug file$
  isLoop.b=1 
  INET_RELOAD.l=$80000000 
  hInet.l=0: hURL.l=0: Bytes.l=0 
  Buffer.s=Space(2048) 
  
  hInet = InternetOpen_("PB@INET", OpenType, #Null, #Null, 0) 
  hURL = InternetOpenUrl_(hInet, URL, #Null, 0, INET_RELOAD, 0) 
  ;filename$=TempDir+GetURLFilePart(url$)
  hFile=CreateFile(#PB_Any,file$)
  ;Debug hURL
  If hURL=0
    failed=1
  EndIf
  Repeat 
    
    Delay(1) 
    InternetReadFile_(hURL, @Buffer, Len(Buffer), @Bytes) 
    If Bytes = 0 
      isLoop=0 
    Else 
      WriteString(Left(Buffer, Bytes)) 
    EndIf 
  Until isLoop=0 
  InternetCloseHandle_(hURL) 
  InternetCloseHandle_(hInet) 
  CloseFile(hFile)
  ProcedureReturn failed
EndProcedure 

Procedure.s GetMainURL(url$)
  Count=FindString(url$,"//",0)+1
  Count+FindString(Right(url$,Len(url$)-Count),"/",0)
  ProcedureReturn Left(url$,Count)
EndProcedure
Procedure.s GetURLFilePart(url$)
  Len=Len(url$)
  Repeat
    Count+1
  Until PeekB(@url$+Len-Count)=47
  ProcedureReturn Right(url$,Count-1)
EndProcedure
Procedure AddDebug(string$)
  AddGadgetItem(#debug,0,string$)
EndProcedure
Procedure.l SearchFile(file$,string$)
  Protected hFile.l
  ;Debug file$
  string$=LCase(string$)
  position=-1
  hFile=ReadFile(#PB_Any,file$)
  If hFile
  stringLen=Len(string$)
  lenght=Lof()
  *pMem=AllocateMemory(lenght)
  If *pMem
    If lenght<>ReadData(*pMem,lenght)
      Debug "Memory Exeption!"
    EndIf
    For x=0 To lenght-stringLen
      If string$=LCase(PeekS(*pMem+x,stringLen))
        position=x
        Break
      EndIf
    Next
  EndIf
  CloseFile(hFile)
  EndIf
  ProcedureReturn position
EndProcedure
Procedure isNewUrl(url$)
  ForEach Visited()
    If Visited()=url$
      ProcedureReturn 0
    EndIf
  Next
  ProcedureReturn 1
EndProcedure
Procedure isNewFile(url$)
  ForEach to_download()
    If to_download()=url$
      ProcedureReturn 0
    EndIf
  Next
  ProcedureReturn 1
EndProcedure
Procedure Searchpage(url$)
  Protected  pos.l
  Static hFile.l
  Debug url$
  AddDebug("Searching Page: "+url$)
  AddElement(Visited())
  Visited()=url$
  file$=TempDir+Str(ElapsedMilliseconds())+".txt"
  ;file$=ReplaceString(TempDir+"_"+url$,"/","_",2)
  ;file$=ReplaceString(file$,":","_",2)
  ;file$=file$+".txt"
 If URLDownloadToFile_(0, url$,file$, 0, 0) =#S_OK 
    ;hFile+1
    Debug "page downloaded"
    Repeat
      DO_EVENTS(0)
      pos=SearchFile(file$,"<a ")
      If pos>-1  
        newURL$=""
        test$=""
        hFile=OpenFile(#PB_Any,file$)
        ;OpenFile(hFile,TempDir+GetURLFilePart(url$))
        FileSeek(pos)
        WriteString("xxx")
        Repeat
          test$+Chr(ReadByte())
        Until FindString(LCase(test$),"href="+Chr(34),0)
        byte.b=ReadByte()
        Repeat
          newURL$+Chr(byte)
          byte.b=ReadByte()
        Until byte=34
        CloseFile(hFile)
        ;Debug newURL$
        ;If Right(url$,Len(newURL$))<>newURL$
        If Left(newURL$,1)="/"
          newURL$=GetMainURL(url$)+Right(newURL$,Len(newURL$)-1)
        ElseIf FindString(newURL$,"//",0) = 0
          NOUrl$=Left(url$,Len(url$)-Len(GetURLFilePart(url$)))
          If Right(NOUrl$,1)<>"/"
            NOUrl$+"/"
          EndIf
          newURL$=NOUrl$+newURL$
        EndIf
        If FindString(newURL$,"#",0)
          newURL$=Left(newURL$,FindString(newURL$,"#",0)-1)
        EndIf
          extension$=LCase(GetExtensionPart(GetURLFilePart(newURL$)))
          If (extension$="htm" Or extension$="html" Or extension$="php" Or extension$="") And GetMainURL(newURL$)=GetMainURL(url$)
            If isNewUrl(newURL$)
              ;Debug newURL$
              Searchpage(newURL$)
              ;UseFile(hFile-1)
            EndIf
          ElseIf extension$="mp3" Or extension$="wma" 
            If isNewFile(newURL$)
              Debug "Gefunden: "+newURL$
              AddDebug("File found: "+newURL$)
              AddElement(to_download())
              to_download()=newURL$
            EndIf
          EndIf
        EndIf
       Until pos=-1
    ;hFile-1
  Else
    Debug "Fehler beim Download von "+url$
    AddDebug("Fehler beim Download von "+url$)
  EndIf
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.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)) 
            sucsess=1
          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 
      bytesAtAll+Bytes
      SetGadgetText(#Label2, "Received Bytes: " + Str(fBytes)) 
      SetGadgetText(#bytesAtAll, "bytes recived: " + Str(bytesAtAll)) 
      If myMax >= fBytes: SetGadgetState(#progressbar, fBytes): EndIf 
      UseFile(1) 
      WriteData(Mem, Bytes) 
    EndIf 
    DO_EVENTS(0) 
  Until isLoop=0 
  InternetCloseHandle_(hURL) 
  InternetCloseHandle_(hInet) 
  SetGadgetState(#progressbar, 0) 
  CloseFile(1)    
  FreeMemory(Mem) 
  ProcedureReturn sucsess
EndProcedure 
Procedure DO_EVENTS(status.b) 
    EventID.l = WindowEvent() 
    If EventID=0
      Delay(status)
    EndIf
    If EventID = #PB_EventGadget    
      Select EventGadgetID() 
        Case #hide
          Hide=1
          AddSysTrayIcon(#icon, WindowID(), UseImage(#icon))
          HideWindow(#Window,1) 
          Goto start
        Case #cmdStart 
          start:
          URL.s = GetGadgetText(#URL) 
          If URL
            ;get filename (checking /) 
            myFile.s= Right(URL, FindString(Reverse(URL),"/",1)-1) 
            ;request path 
            myFolder.s = PathRequester ("Where do you want to save music from '" + myFile + "'?", "C:\") 
            If myFolder
              DisableGadget(#URL,1)
              DisableGadget(#cmdStart,1)
              SetGadgetText(#state,"Reading webpages...")
              Searchpage(URL)
              Debug "suche beendet"
              ForEach to_download()
                SetGadgetText(#state,"File "+Str(ListIndex(to_download()))+" of "+Str(CountList(to_download())))
                SetGadgetText(#URL,to_download())
                If Hide
                  If URLDownloadToFile_(0,myFolder +GetURLFilePart(to_download()), to_download(),0, 0) =#S_OK 
                    Count+1
                  EndIf
                Else
                If UrlToFileWithProgress(myFolder +GetURLFilePart(to_download()), to_download())
                  Count+1
                EndIf
                EndIf
              Next
              MessageRequester("Succsess", Str(Count)+" Dateien wurden erfolgreich heruntergeladen." + Chr(10) + Str(CountList(to_download())-Count)+" Dateien konnten nicht erfolgreich heruntergeladen werden.", #MB_OK|#MB_ICONINFORMATION)
              DisableGadget(#URL,0)
              DisableGadget(#cmdStart,0)
            EndIf
          EndIf
        Case #cmdExit 
          End 
      EndSelect 
    EndIf
    If EventID=#PB_Event_CloseWindow
      AddSysTrayIcon(#icon, WindowID(), UseImage(#icon))
      HideWindow(#Window,1)        
      MessageRequester("Information", "MusicLoader is still running." + Chr(10) + "Right click on the trayicon to close it.", #MB_OK|#MB_ICONINFORMATION)
    ElseIf EventID= #PB_EventSysTray 
      type=EventType()
      If type=#PB_EventType_LeftClick
        RemoveSysTrayIcon(#icon)
        HideWindow(#Window,0)
      ElseIf type=#PB_EventType_RightClick
        DisplayPopupMenu(#icon,WindowID())
      EndIf
    ElseIf EventID=#PB_Event_Menu
      Select EventMenuID()     
        Case #end
          Close=1
        Case #restore
          RemoveSysTrayIcon(#icon)
          HideWindow(#Window,0) 
      EndSelect
    EndIf
EndProcedure 

CatchImage(#icon,?icon)

;http://artists.iuma.com/Genre//index/A-1.html
If OpenWindow(#Window, 0, 0, 400, 213, #PB_Window_SystemMenu | #PB_Window_TitleBar | #PB_Window_ScreenCentered | #PB_Window_MinimizeGadget , "Musicloader") 
   If CreateGadgetList(WindowID()) 
    StringGadget(#URL, 10, 10, 380, 20, "http://www.mp3.de/") 
    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) 
    TextGadget(#state,5,130,150,15,"File 0 of 0")
    TextGadget(#bytesAtAll,5,147,150,15,"bytes recived:")
    ListViewGadget(#debug,2,170,395,40)
    ButtonGadget(#hide,280,125,110,15,"start hided")
  EndIf 
  CreatePopupMenu(#icon)
  MenuItem(#restore,"restore")
  MenuItem(#end,"close")
  Repeat
  DO_EVENTS(1)
Until Close
EndIf 
End 

DataSection
icon:IncludeBinary "icon.ico"
EndDataSection

Edit: Ich hab mal den Progressbardownload aus dem codearchiv eingebaut

Verfasst: **22.01.2006 01:06**

Also, ich habe dein Programm mal getestet, und dann nach 15 Min wieder
beendet, es war immer noch bei der ersten Datei.
Indem ich den Pfad bei Firefox eingegeben habe, fand ich Heraus, dass diese
13.3 MB hat.
Also, folgende Vorschläge:

Dass Programm nutzt bei weitem nicht die Geschwindigkeit meiner Verbindung.
Progressbar für Download

edit:
Hab über Nacht laufen lassen (Flatrate

), pünktlich, als ich heute
morgen aufgestanden bin kam eine Meldung :
35 Dateien erfolgreich heruntergeladen.
Ich hab dann nachgeschaut, die sind insgesamt 319 MB groß.
Also laufen tut´s

Verfasst: **23.01.2006 14:41**

Macros hat geschrieben:
Dass Programm nutzt bei weitem nicht die Geschwindigkeit meiner Verbindung.

Hmm, das muss wohl am urldownloadtofile liegen (deswegen musste ich schonmal in nem Programm einen splashsreen einbauen, nur um eine datei <1kb ruterzuladen, in der die Version stand, das dauerte nämlich fast ne halbe minute...), das ist aber seltsam, ich dachte diese Funktion nutzt auch der IE, der jedoch läd ja mit voller Geschwindigkeit...

Verfasst: **23.01.2006 15:57**

Schau dir doch mal die Internetfunktionen in der API an die helfen dir vieleicht weiter.
Da kannst du z.b. mit InternetReadFile_() daten in den speicher lesen und dann mit writedata wieder in eine datei schreiben.

Ich weiss nich ob das das geschwindigkeitsproblem bei dir löst doch geht das in meinem project mit DSL so schnell wie es gehen sollte.

edit: schau dir am besten mal folgendes beispiel aus dem codearchiv an
http://www.purearea.net/pb/CodeArchiv/I ... ressBar.pb

Verfasst: **23.01.2006 22:35**

Ok, ich hab jetzt mal den code aus dem Archiv eingebaut, es sieht gleich viel hübscher aus

Verfasst: **24.01.2006 18:57**

Ich darf leider nicht mehr testen,

hat meine Mutter verboten, weil ja angeblich dein (dafür zu winziges)
Programm irgendwelche Server ansteuern könnte, von denen man nicht
downloaden darf. Oder kostenpflichtiges Zeug runterladen oder ...

.
Das ich den Quellcode durchsehen kann interessiert sie nicht.

Verfasst: **24.01.2006 20:44**

@Macros: Selbst Schuld, wenn du das deiner Mutter sagst. Aber meine
würde das eh nicht kapieren.

Verfasst: **26.01.2006 22:35**

Wow!
Respect vor deiner Mum!
Hat die wirklich soviel Ahnung? Also meine sind da absolut ein anderes Kaliber ^^

Verfasst: **26.01.2006 22:53**

Die hat selbst mal programmiert,
und kennt sich auch halbwegs gut mit
Computern aus.

Verfasst: **28.01.2006 20:00**

OK, das bringt dich noch weniger in die Position deiner Mum zu widersprechen. Bei meinen kann ich sagen "Sry, aber ich weiß was ich tue und soviel Ahnung hast du davon ja eh nicht".
Wenn deine davon ausgeht, dass sie Ahnung hat (und das ja auch wirklich ein wenig) , solltest du vielleicht so einige Projekte lieber verschweigen...

Wer ist das eigentlch in deinem Avatar-Bild?

Gr33tz
Tafkadasom2k5

PureBoard

Musicloader - kann das bitte mal jemand mit dsl testen...

Musicloader - kann das bitte mal jemand mit dsl testen...