FileSize auf eine Datei im Internet ermitteln

Fragen und Bugreports zur PureBasic 4.0-Beta.
Benutzeravatar
RSBasic
Admin
Beiträge: 8022
Registriert: 05.10.2006 18:55
Wohnort: Gernsbach
Kontaktdaten:

FileSize auf eine Datei im Internet ermitteln

Beitrag von RSBasic »

Hi ihr, ich habe ein kleines Problem, wo ich eure Hilfe brauche.
Ich arbeite mit dem Befehl FileSize. Ich möchte die Größe einer Datei im Internet ermitteln, aber weis net wie man das macht. Könnt ihr mir helfen?

Code: Alles auswählen

Debug FileSize("http://aktuell.de.selfhtml.org/cgi-bin/selfdown/download.pl?url=http%3A%2F%2Fwww.mcwiwa.de%2Fselfhtml%2Fselfhtml811.zip")
PS: Habe so versucht, aber als Wert nur -1. Bitte ich brauch eure Hilfe.
Aus privaten Gründen habe ich leider nicht mehr so viel Zeit wie früher. Bitte habt Verständnis dafür.
Bild
Bild
a14xerus
Beiträge: 1440
Registriert: 14.12.2005 15:51
Wohnort: Aachen

Beitrag von a14xerus »

ich würde mit den network befehle eine verbindung zum server herstellen dun die datei anfordern, dann kriegste einen network event vom server ..
am anfang sendet der server imemr einen header mit den angaben zum server, ob php da is, dateityp und auch die größe in byte

Code: Alles auswählen

;(C) Alexander N
; PB 4.0
#http = 80
#ftp = 21
#server = 10
#site = 20
#http11 = "HTTP/1.1"
#http10 = "HTTP/1.0"
InitNetwork()

Procedure connect(server.s,port = #http)
  tmp = OpenNetworkConnection(server.s,port)
  Debug "Conection To "+server+" at port "+Str(port)+": "+Str(tmp)
  If tmp
    Return_ = tmp
  Else
    Return_ = #False
  EndIf
  ProcedureReturn Return_
EndProcedure

Procedure close(id.l)
  Debug "start close "+Str(id)
  Debug "closeconnection: "+Str(CloseNetworkConnection(id))
  Debug "closed: "+Str(id)
  Debug ""
EndProcedure

Procedure mainwindow()
  Global window = OpenWindow(#PB_Any, 0, 0, 800, 540, "Network", #PB_Window_Invisible|#PB_Window_ScreenCentered|#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget|#PB_Window_SizeGadget)
  Global hwnd = WindowID(window)
  If window
    If CreateGadgetList(hwnd)
      Global gadget_editor = EditorGadget(#PB_Any, 1, 1, 1, 1, #PB_Editor_ReadOnly)
      Global gadget_info = EditorGadget(#PB_Any, 1, 1,1, 1,#PB_Editor_ReadOnly)
      Global gadget_split = SplitterGadget(#PB_Any,5,35,790,500,gadget_editor,gadget_info,#PB_Splitter_Separator)
      SetGadgetState(gadget_split,450)
      SetGadgetAttribute(gadget_split,#PB_Splitter_FirstMinimumSize,100)
      SetGadgetAttribute(gadget_split,#PB_Splitter_SecondMinimumSize,20)
      Global gadget_ok = ButtonGadget(#PB_Any, 720, 5, 70, 20, "Go")
      Global gadget_input = StringGadget(#PB_Any, 5, 5, 700, 20, "http://www.alexander-n.de/")
      
      PureRESIZE_SetGadgetResize(gadget_split,1,1,1,1)
      PureRESIZE_SetGadgetResize(gadget_ok,0,1,1,0)
      PureRESIZE_SetGadgetResize(gadget_input,1,1,1,0)
      PureRESIZE_SetWindowMinimumSize(window,400,400)
      
      SetWindowState(window,#PB_Window_Maximize)
      HideWindow(window,0)
      
    EndIf
  EndIf
EndProcedure

Procedure ende()
  End 
EndProcedure

Procedure.s parse1(tmp$) ; parse http:// ... /
  Debug"" : Debug tmp$
  tmp$ = Trim(tmp$)
  If Not tmp$
    ProcedureReturn ""
  EndIf
  Debug tmp$
  If LCase(Left(tmp$,7)) = "http://"
    tmp$ = Trim(Mid(tmp$,8,Len(tmp$)-7))
  EndIf
  Debug tmp$
  If Right(tmp$,1) = "/"
    tmp$ = LSet(tmp$,Len(tmp$)-1)
  EndIf
  Debug tmp$
  ProcedureReturn tmp$
EndProcedure

Procedure.s parse2(tmp$,mode.l) ; parse server and site txt
  tmp$ = Trim(tmp$)
  pos = FindString(tmp$,"/",0)
  If pos
    server.s = Mid(tmp$,1,pos-1)
    Debug "server : "+server
    site.s = Mid(tmp$,pos+1,Len(tmp$)-pos)
    Debug "site : "+site
  Else
    server.s = tmp$
    site.s = ""
  EndIf
  If mode = #server
    ProcedureReturn server
  ElseIf mode = #site 
    ProcedureReturn site 
  EndIf
  ProcedureReturn ""
EndProcedure

Procedure startsite(tmp$) ;send network string
  tmp$ = parse1(tmp$)
  server.s = parse2(tmp$,#server)
  site.s = parse2(tmp$,#site)
  If server
    Global id = connect(server)
    If Not id 
      ProcedureReturn
    EndIf
  Else
    ProcedureReturn
  EndIf
  site.s = "http://"+server+"/"+site
  
  Header.s = "GET "+site+" "+#http10+#CRLF$ 
  Header   + "Host: "+server+#CRLF$
  Header   + "User-Agent: Alexander-N.de Browser"+#CRLF$ 
  
  Header   + #CRLF$
  Debug Header
  SetGadgetText(gadget_info,"Gesendet:"+#CRLF$+Header)
  SendNetworkString(id,Header)
EndProcedure

Procedure.s empfang(text.s,output_gadget.l)
  tmp$ = text.s : text = ""
  
  header_ende = FindString(tmp$,#CRLF$+#CRLF$,0)
  Header$ = Mid(tmp$,1,header_ende)
  txt$ = Mid(tmp$,header_ende,(Len(tmp$)-header_ende)-4)
  tmp$ = ""
  SetGadgetText(gadget_info,GetGadgetText(gadget_info)+#CRLF$+"Empfangen:"+#CRLF$+Header$)
  
  
  
  tmp$ = txt$ : txt$ = ""
  head_start = FindString(LCase(tmp$),LCase("<head>"),0)
  If head_start
    head_end = FindString(LCase(tmp$),LCase("</head>"),head_start) + Len("</head>")
    If head_end
      head$ = Mid(tmp$,head_start,head_end-head_start)
      tmp$ = Trim(Mid(tmp$,head_end,Len(tmp$)))
    EndIf
  EndIf
  
  txt$ = ""
  txt$ + "Head-Teil:" + #CRLF$
  txt$ + head$
  txt$ + #CRLF$ + #CRLF$
  For i = 1 To 300
    txt$ + "-"
  Next
  txt$ + #CRLF$
  txt$ + "HTML:" + #CRLF$
  txt$ + tmp$
  txt$ + #CRLF$
  SetGadgetText(output_gadget,txt$)
EndProcedure




mainwindow()
Repeat
  Delay(1)
  If zeit
    If zeit < ElapsedMilliseconds() - 1500
      DisableGadget(gadget_ok,0)
      zeit = 0
    EndIf
  EndIf
  Select WindowEvent()
    Case #PB_Event_CloseWindow
      ende()
    Case #PB_Event_Gadget
      Select EventGadget()
        Case gadget_ok
          startsite(GetGadgetText(gadget_input))
          DisableGadget(gadget_ok,1)
          zeit = ElapsedMilliseconds()
      EndSelect
  EndSelect
  If id
    Select NetworkClientEvent(id)
      Case 2
        len = 2
        FreeMemory(*mem)
        *mem = AllocateMemory(len)
        tmp$ = ""
        Repeat
          erg = ReceiveNetworkData(id,*mem,len)
          t.s = PeekS(*mem,len)
          ;Debug t
          tmp$ + t
          FreeMemory(*mem)
          *mem = AllocateMemory(len)
        Until erg <> len
        Debug tmp$
        empfang(tmp$,gadget_editor)
        tmp$ = ""
    EndSelect
  EndIf 
ForEver
Benutzeravatar
AND51
Beiträge: 5220
Registriert: 01.10.2005 13:15

Beitrag von AND51 »

NEIIIIIIIIIIIN!
[i]a14xerus[/i] hat geschrieben:

Code: Alles auswählen

Header.s = "GET "+site+" "+#http10+#CRLF$ 
Ich predige doch immer, man soll HEAD statt GET benutzen, wenn man nur die Informationen über die Datei, nicht aber die Datei selbst haben will! :allright:

HEAD => man bekommt Infos über die Datei
GET => man bekommt Infos über die Datei + die Datei selbst
PB 4.30

Code: Alles auswählen

Macro Happy
 ;-)
EndMacro

Happy End
Benutzeravatar
tobe
Beiträge: 146
Registriert: 14.09.2006 17:33
Wohnort: Oktoberfest

Beitrag von tobe »

hi RSBasic,

ich hab dir ein beispiel gebastelt ;)

Code: Alles auswählen

EnableExplicit
Procedure.s GetHEAD(Ip$, Path$, Port=80, user$ = "", pass$ = "")
  Protected tmp$, output$, length, ConnectionID, DataLen, Timeout
  If pass$
    tmp$ = user$ + ":" + pass$
    length = Len(tmp$)<<1
    output$ = Space(length)
    Base64Encoder(@tmp$, Len(tmp$), @output$, length)
  EndIf
  ;Debug "Verbinde mit " + Ip$
  ConnectionID = OpenNetworkConnection(Ip$, Port)
  If ConnectionID
    tmp$ = "HEAD " + Path$ + " HTTP/1.1" + #CRLF$
    tmp$ + "Host: " + Ip$ + #CRLF$
    tmp$ + "User-agent: GetHEAD" + #CRLF$
    If pass$
      tmp$ + "Authorization: Basic " + output$ + #CRLF$
    EndIf
    tmp$ + #CRLF$
    ;Debug "sende Datenanforderung für " + Path$
    SendNetworkString(ConnectionID, tmp$)
    length = 1024
    output$ = Space(length)
    Timeout = ElapsedMilliseconds() + 3000
    ;Debug "Warte auf Anwort"
    Repeat
      If NetworkClientEvent(ConnectionID) = #PB_NetworkEvent_Data
        DataLen = ReceiveNetworkData(ConnectionID, @output$, length)
        If DataLen > 0
          Break
        EndIf
      EndIf
      If ElapsedMilliseconds() > Timeout
        ;Debug "Timeout"
        Break
      EndIf
      Delay(1)
    ForEver
    CloseNetworkConnection(ConnectionID)
  EndIf
  ProcedureReturn Trim(output$)
EndProcedure

Procedure GetContentLength(url$)
  Protected Ip$, Position, EndPos, html$, tmp$
  Position = FindString(url$, "//", 0)
  If Position
    Position + 2
    EndPos = FindString(url$, "/", Position)
    If EndPos
      Ip$ = Mid(url$, Position, EndPos - Position)
      html$ = GetHEAD(Ip$, Right(url$, Len(url$) - EndPos + 1))
    EndIf
  EndIf
  ;Debug html$
  ;Debug StringField(html$,1,#CRLF$)
  ;Select Left(StringField(html$,1,#CRLF$),12)
  Select Left(html$, 12)
    Case "HTTP/1.1 200"
      Position = FindString(LCase(html$), "content-length:", 17)
      If Position
        Position + 16
        EndPos = FindString(html$, #CRLF$, Position)
        If EndPos
          ProcedureReturn Val(Mid(html$, Position, EndPos - Position))
        EndIf
      EndIf
    Case "HTTP/1.1 302"
      Position = FindString(LCase(html$), "location:", 20)
      If Position
        Position + 10
        EndPos = FindString(html$, #CRLF$, Position)
        If EndPos
          tmp$ = Mid(html$, Position, EndPos - Position)
          ;Debug "Umleitung nach " + tmp$
          If FindString(tmp$, "//", 0)
            ProcedureReturn GetContentLength(tmp$)
          Else
            ProcedureReturn GetContentLength("http://" + Ip$ + "/" + tmp$)
          EndIf
        EndIf
      EndIf
  EndSelect
  ProcedureReturn -1
EndProcedure

InitNetwork()
Debug GetContentLength( "http://aktuell.de.selfhtml.org/cgi-bin/selfdown/download.pl?url=http%3A%2F%2Fwww.mcwiwa.de%2Fselfhtml%2Fselfhtml811.zip")
Zuletzt geändert von tobe am 11.11.2006 16:21, insgesamt 1-mal geändert.
PureBasic 4.40 (Windows - x86)
Benutzeravatar
RSBasic
Admin
Beiträge: 8022
Registriert: 05.10.2006 18:55
Wohnort: Gernsbach
Kontaktdaten:

Beitrag von RSBasic »

@tobe
Vielen Dank für dein Code-Beispiel. :allright:
Aus privaten Gründen habe ich leider nicht mehr so viel Zeit wie früher. Bitte habt Verständnis dafür.
Bild
Bild
Benutzeravatar
HeX0R
Beiträge: 2954
Registriert: 10.09.2004 09:59
Computerausstattung: AMD Ryzen 7 5800X
96Gig Ram
NVIDIA GEFORCE RTX 3060TI/8Gig
Win10 64Bit
G19 Tastatur
2x 24" + 1x27" Monitore
Glorious O Wireless Maus
PB 3.x-PB 6.x
Oculus Quest 2
Kontaktdaten:

Beitrag von HeX0R »

Code: Alles auswählen

...
StringField(html$,1,#CRLF$)
...
Das macht übrigens keinen Sinn, da Stringfield nur ein Trennzeichen benutzt.
In diesem Fall aber egal, wird eben nur das CR genommen.
Wollte das nur mal anmerken.
Benutzeravatar
tobe
Beiträge: 146
Registriert: 14.09.2006 17:33
Wohnort: Oktoberfest

Beitrag von tobe »

@HeX0R
da hast du völlig recht, danke für den hinweis.
eigentlich kann man das StringField auch weglassen :)
werd ich gleich noch oben im code ändern.
PureBasic 4.40 (Windows - x86)
Gesperrt