Gadgets verschwinden

[edel]

http://www.purebasic.fr/english/viewtop ... 7261#37261

[ts-soft]

Hab mal schnell das Beispiel aus dem CodeArchiv PB4 tauglich gemacht:

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 

  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 
      WriteData(1,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, "Download with Progress", #PB_Window_SystemMenu | #PB_Window_TitleBar | #PB_Window_ScreenCentered ) 

  If CreateGadgetList(WindowID(#Window)) 
      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_Event_Gadget    
      Select EventGadget() 
        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_Event_CloseWindow 
EndIf 
End 

Download_with_Progressbar.pb heisst es im CodeArchiv, aber nur für PB 3.94

[mx03]

das kenn ich schon aber leider geht das nicht so wirklich:
Zeile 33: Invalid name: same as an external command

und das mit der filesize aus dem internet geht auch nicht weil ich nicht die version 4.x habe

[Kiffi]

und das mit der filesize aus dem internet geht auch nicht weil ich nicht die version 4.x habe

was spricht dagegen, dass Du Deine Version aktualisierst?

Grüße ... Kiffi

[ts-soft]

qmx03
Habs ja auch für PB4 abgeändert. Die Version aus dem CodeArchiv sollte für
PB 3.94 gehen. Was anderes als 3.3, 3.94 und 4.** wird ja keiner nutzen, es
sei denn ...

[Kaeru Gaman]

was spricht dagegen, dass Du Deine Version aktualisierst?

yo, was spricht dagegen?

[mx03]

ich weiß nicht so recht weil sich ziemlich viel bei 4.x geändert hat und neues ist nicht immer gut.

außerdem gehen die andwendungen dan auf meinem linux pb nicht mehr oder?

außerdem wäre es nicht einfach die dateigröße mit einem php script zu überprüfen?

[Kiffi]

> ich weiß nicht so recht weil sich ziemlich viel bei 4.x geändert hat

probier's doch einfach mal aus! PB 3.94 und PB 4 lassen sich parallel auf
einem Rechner installieren, ohne dass sie sich stören. Du musst halt nur
darauf achten, für beide Installationen separate Ordner zu verwenden. Also:
Auf keinen Fall die PB4-Installation im PB3.94-Ordner ausführen.

> und neues ist nicht immer gut.

schlechtes Argument. In diesem Fall ist der Umstieg auf PB4 wirklich
empfehlenswert.

Grüße ... Kiffi

[mx03]

ok du hast mich überredet
kann es eigentlich sein das
%UserProfile%\Eigene Dateien
nicht funktioniert?

Code: Alles auswählen

MyZIP.s = "%UserProfile%\Eigene Dateien\test.zip"
MyFilesToZIP.s = "%UserProfile%\Eigene Dateien\*.*"

PureZIP_AddFiles(MyZIP, MyFilesToZIP, #PureZIP_StorePathAbsolute, #PureZIP_Recursive)

[ts-soft]

>> kann es eigentlich sein das %UserProfile%\Eigene Dateien nicht funktioniert?
Steht in der Hilfe der Lib, das so etwas eingebaut wäre. Wenn nicht, dann
wirds wohl nicht so sein
Ist doch PureBasic Code und kein Batchskript

> > und neues ist nicht immer gut
oder nutzt du noch DOS

PS: In PB4 gehts so:

Code: Alles auswählen

Debug GetEnvironmentVariable("UserProfile")