bei dem Code aus dem Code-Archiv, den ts-soft zitiert hat, habe ich das Problem, dass das offensichtlich nicht stabil mit allen Bildern/Websites ohne Absturz des Programms funktioniert.
Ich benötige den Bilder-Download und die Bild-Weiterbehandlung für ein Firmen-internes Programm, das auf Intranet-Seiten zugreift. Dort ist es so, dass ich die betreffenden Bilder durch einen Workaround doch heruntergeladen bekomme, indem ich eine MessageBoxTimeout() vor der InternetOpenUrl_()-Funktion einbaue. Dann läuft es seltsamerweise stabil.
Leider kann ich die entsprechenden Intranet-Links nicht weitergeben (würden ja auch nicht funktionieren).
Ich habe daher nach Beispielen im Internet gesucht. Beim Reichelt-Logo beispielsweise kachelt die Prozedur ab, bei den meisten anderen Bildern klappt's problemlos.
Code: Alles auswählen
EnableExplicit
;****************************************** enumerierte Konstanten ************************************************************************************************
;***Fenster ***
Enumeration
#Haupt_Fenster
EndEnumeration
;***Gadgets ***
Enumeration
#ImageGadget_Test1
#Textgadget_Test_Bild1
#WebGadget_Test_Bild1
#ImageGadget_Test2
#Textgadget_Test_Bild2
#WebGadget_Test_Bild2
EndEnumeration
;***Bilder ***
Enumeration
#Test_Bild1
#Test_Bild2
#Leer_Bild
EndEnumeration
;****************************************** Variablen *************************************************************************************************************
Global URL_Test_Bild1$ = ""
Global URL_Test_Bild2$ = ""
Global Test_Bildbreite = 128
Global Test_Bildhoehe = 128
Global Event.l = 0
Global i.l = 0
Global *Mem
Global *ReadMem
Global Bytes_Downloaded_ToMem.l = 0
Global MemString$ = ""
;****************************************** Prozeduren ************************************************************************************************************
#MB_TIMEDOUT = $7D00 ;########################################################################### gehört zu MessageBoxTimeout() dazu
Prototype.i MBTimeOut(hwnd.i, lpText.s, lpCaption.s, uType.l, wLanguageId.w, dwMilliseconds.l);### gehört zu MessageBoxTimeout() dazu
Procedure MessageBoxTimeout(hwnd.i, lpText.s, lpCaption.s, uType.l, dwMilliseconds.l)
Protected hDLL = GetModuleHandle_("user32")
Protected FuncString.s
Protected MBTimeOut.MBTimeOut
CompilerIf #PB_Compiler_Unicode
FuncString.s = Space(17)
PokeS(@FuncString, "MessageBoxTimeoutW", -1, #PB_Ascii)
CompilerElse
FuncString.s = "MessageBoxTimeoutA"
CompilerEndIf
If hDLL
MBTimeOut = GetProcAddress_(hDLL, @FuncString)
If MBTimeOut
ProcedureReturn MBTimeOut(hwnd, lpText, lpCaption, uType, 0, dwMilliseconds)
EndIf
Else
Debug "Error: MessageBoxTimeout"
EndIf
EndProcedure
Procedure.l DownloadToMem(url.s, *lpRam, ramsize.l)
Protected agent.s, hINet.l, hFile.l, hData.l, bytes.l
; #INTERNET_OPEN_TYPE_DIRECT = 1
; #INTERNET_DEFAULT_HTTP_PORT = 80
; #INTERNET_SERVICE_HTTP = 3
; #INTERNET_FLAG_NO_CACHE_WRITE = $4000000
; #INTERNET_FLAG_RELOAD = $8000000
;agent.s = "Mozilla/4.0 (compatible; ST)"
;agent.s = "Microsoft Internet Explorer Mozilla/4.0"
agent.s = "Netscape Mozilla/5.0"
;MessageRequester("Info", "Vor InternetOpen_()-Funktion...", #PB_MessageRequester_Ok)
hINet.l = InternetOpen_( @agent.s,0,0,0,0 )
;MessageRequester("Info", "Nach InternetOpen_()-Funktion...", #PB_MessageRequester_Ok)
If hINet > 0
MessageRequester("Info", "Vor InternetOpenUrl_()-Funktion...", #PB_MessageRequester_Ok)
;MessageBoxTimeout(#Haupt_Fenster, "Vor InternetOpenUrl_()-Funktion...", "MessageTimeOut-Box", #MB_OK, 1000)
hData.l = InternetOpenUrl_( hINet, @url.s, "", 0, $8000000, 0 )
If hData > 0
;MessageRequester("Info", "Vor InternetReadFile_()-Funktion...", #PB_MessageRequester_Ok)
InternetReadFile_( hData, *lpRam, ramsize.l, @bytes.l )
Else
bytes = -1
EndIf
InternetCloseHandle_(hINet)
InternetCloseHandle_(hFile)
InternetCloseHandle_(hData)
Else
MessageRequester("Info", "Konnte InternetOpen_()-Funktion nicht erfolgreich ausführen!!!", #PB_MessageRequester_Ok)
bytes = -2
EndIf
ProcedureReturn bytes.l
EndProcedure
;****************************************** Hauptprogramm **********************************************************************************************************
If OpenWindow(#Haupt_Fenster, 0, 0, 800, 800, "Test", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget)
UseJPEGImageDecoder()
UsePNGImageDecoder()
InitNetwork()
If CreateImage(#Leer_Bild, 128, 128, 24, RGB($FF, $FF, $FF))
ImageGadget(#ImageGadget_Test1, 10, 10, 128, 128, ImageID(#Leer_Bild), #PB_Image_Border)
GadgetToolTip(#ImageGadget_Test1, "Gadget initialisiert, aber noch kein Bild geladen!")
TextGadget(#Textgadget_Test_Bild1, 10, 140, 128, 16, "Test-Bild", #PB_Text_Center)
WebGadget(#WebGadget_Test_Bild1, 150, 10, 400, 400,"")
ImageGadget(#ImageGadget_Test2, 10, 420, 128, 128, ImageID(#Leer_Bild), #PB_Image_Border)
GadgetToolTip(#ImageGadget_Test2, "Gadget initialisiert, aber noch kein Bild geladen!")
TextGadget(#Textgadget_Test_Bild2, 10, 550, 128, 16, "Test-Bild", #PB_Text_Center)
WebGadget(#WebGadget_Test_Bild2, 150, 420, 400, 400,"")
URL_Test_Bild1$ = "https://shop.aswo.com/upload/Image/2015_CCDame2_web.jpg" ;funktioniert problemlos...
URL_Test_Bild2$ = "https://www.reichelt.de/bilder/elements/header/logo_2016/reichelt-logo.png" ;funktioniert nicht, Programm endet unerwartet...
;URL_Test_Bild2$ = "https://cdn-reichelt.de/bilder/web/awo_ws/D300/WERA6147_06.jpg" ;funktioniert problemlos...
;Workaround für die Intranet-Bilder bislang durch MessageRequester VOR InternetOpenUrl_()
;bei der Reichelt-Logo funktioniert auch das nicht!
URL_Test_Bild1$ = URLEncoder(URL_Test_Bild1$, #PB_UTF8)
;MessageRequester("Info", "URL_Test_Bild$ = "+URL_Test_Bild$, #PB_MessageRequester_Ok)
SetGadgetText(#WebGadget_Test_Bild1, URL_Test_Bild1$)
*Mem = AllocateMemory(1048576) ;1MB
Bytes_Downloaded_ToMem = DownloadToMem(URL_Test_Bild1$, *Mem, 1048576)
;MessageRequester("Info", "Bytes_Downloaded_ToMem = "+Str(Bytes_Downloaded_ToMem)+" Bytes", #PB_MessageRequester_Ok)
;MessageRequester("Info", "Mem$ = "+URLDecoder(Mem$), #PB_MessageRequester_Ok)
If Bytes_Downloaded_ToMem > 0
If CatchImage(#Test_Bild1, *Mem)
ResizeImage(#Test_Bild1, Test_Bildbreite, Test_Bildhoehe, #PB_Image_Smooth)
SetGadgetState(#ImageGadget_Test1, ImageID(#Test_Bild1))
GadgetToolTip(#ImageGadget_Test1, URL_Test_Bild1$)
Else
;MessageRequester("Info", "Konnte Test-Bild nicht extrahieren!", #PB_MessageRequester_Ok)
SetGadgetState(#ImageGadget_Test1, ImageID(#Leer_Bild))
GadgetToolTip(#ImageGadget_Test1, "Konnte Bild von Test-URL nicht extrahieren!")
EndIf
FreeMemory(*Mem)
ElseIf Bytes_Downloaded_ToMem = -1 ;URL-Connection erfolgreich, aber kein Bild...
SetGadgetState(#ImageGadget_Test1, ImageID(#Leer_Bild))
GadgetToolTip(#ImageGadget_Test1, "Kein Bild in Test-URL gefunden!")
ElseIf Bytes_Downloaded_ToMem = -2 ;schon URL-Connection war nicht erfolgreich!!!
SetGadgetState(#ImageGadget_Test1, ImageID(#Leer_Bild))
GadgetToolTip(#ImageGadget_Test1, "Verbindung zur Test-Seite per InternetOpen_()-Funktion nicht erfolgreich!")
Else
SetGadgetState(#ImageGadget_Test1, ImageID(#Leer_Bild))
GadgetToolTip(#ImageGadget_Test1, "Nicht definierter Fehler!")
EndIf
URL_Test_Bild2$ = URLEncoder(URL_Test_Bild2$, #PB_UTF8)
;MessageRequester("Info", "URL_Test_Bild$ = "+URL_Test_Bild$, #PB_MessageRequester_Ok)
SetGadgetText(#WebGadget_Test_Bild2, URL_Test_Bild2$)
*Mem = AllocateMemory(1048576) ;1MB
Bytes_Downloaded_ToMem = DownloadToMem(URL_Test_Bild2$, *Mem, 1048576)
;MessageRequester("Info", "Bytes_Downloaded_ToMem = "+Str(Bytes_Downloaded_ToMem)+" Bytes", #PB_MessageRequester_Ok)
;MessageRequester("Info", "Mem$ = "+URLDecoder(Mem$), #PB_MessageRequester_Ok)
If Bytes_Downloaded_ToMem > 0
If CatchImage(#Test_Bild2, *Mem)
ResizeImage(#Test_Bild2, Test_Bildbreite, Test_Bildhoehe, #PB_Image_Smooth)
SetGadgetState(#ImageGadget_Test2, ImageID(#Test_Bild2))
GadgetToolTip(#ImageGadget_Test2, URL_Test_Bild2$)
Else
;MessageRequester("Info", "Konnte Test-Bild nicht extrahieren!", #PB_MessageRequester_Ok)
SetGadgetState(#ImageGadget_Test2, ImageID(#Leer_Bild))
GadgetToolTip(#ImageGadget_Test2, "Konnte Bild von Test-URL nicht extrahieren!")
EndIf
FreeMemory(*Mem)
ElseIf Bytes_Downloaded_ToMem = -1 ;URL-Connection erfolgreich, aber kein Bild...
SetGadgetState(#ImageGadget_Test2, ImageID(#Leer_Bild))
GadgetToolTip(#ImageGadget_Test2, "Kein Bild in Test-URL gefunden!")
ElseIf Bytes_Downloaded_ToMem = -2 ;schon URL-Connection war nicht erfolgreich!!!
SetGadgetState(#ImageGadget_Test2, ImageID(#Leer_Bild))
GadgetToolTip(#ImageGadget_Test2, "Verbindung zur Test-Seite per InternetOpen_()-Funktion nicht erfolgreich!")
Else
SetGadgetState(#ImageGadget_Test2, ImageID(#Leer_Bild))
GadgetToolTip(#ImageGadget_Test2, "Nicht definierter Fehler!")
EndIf
EndIf
Repeat
Event = WindowEvent()
If Event <> 0 ; Alle Ereignisse werden behandelt, so dass wir die Koordinaten der Maus anzeigen können
SetWindowTitle(#Haupt_Fenster, "Maus-Koordinaten: " + Str(WindowMouseX(0)) + "," + Str(WindowMouseY(0)))
Else
Delay(1) ; Ohne ein FlipBuffers(), Delay() gibt die CPU für das Multitasking frei
EndIf
Until Event = #PB_Event_CloseWindow
EndIf
Hat jemand eine Idee, woran das liegt und wie man die Prozedur DownloadToMem() "kugelsicher" bekommt, zumindest kein Absturz, wenn Bild nicht geladen wird, kann man ja evtl. damit umgehen.