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
), pünktlich, als ich heute
.
