nur wissen wie. Leider ist das doch ziemlich komplex, desshalb kann man das nicht
in ein paar Sätzen erklären.
Ich dachte eigentlich ich hätte sowas schonmal irgendwo gepostet,
aber ich denke das hier sollte dir helfen:
Code: Alles auswählen
DataSection
IID_IHTMLDocument2: ; {332C4425-26CB-11D0-B483-00C04FD90119}
Data.l $332C4425
Data.w $26CB, $11D0
Data.b $B4, $83, $00, $C0, $4F, $D9, $01, $19
IID_IHTMLDocument3: ; {3050F485-98B5-11CF-BB82-00AA00BDCE0B}
Data.l $3050F485
Data.w $98B5, $11CF
Data.b $BB, $82, $00, $AA, $00, $BD, $CE, $0B
IID_NULL: ; {00000000-0000-0000-0000-000000000000}
Data.l $00000000
Data.w $0000, $0000
Data.b $00, $00, $00, $00, $00, $00, $00, $00
EndDataSection
; Nur eine Hilfsfunktion
;
Procedure WebGadget_Document(Gadget, *IID)
Document = 0
Browser.IWebBrowser2 = GetWindowLong_(GadgetID(Gadget), #GWL_USERDATA)
If Browser
If Browser\get_Document(@DocumentDispatch.IDispatch) = #S_OK And DocumentDispatch
DocumentDispatch\QueryInterface(*IID, @Document)
DocumentDispatch\Release()
EndIf
EndIf
ProcedureReturn Document
EndProcedure
; Gibt den markierten Text zurück
;
Procedure.s WebGadget_Selection(Gadget)
Result$ = ""
Document.IHTMLDocument2 = WebGadget_Document(Gadget, ?IID_IHTMLDocument2)
If Document
If Document\get_selection(@Selection.IHTMLSelectionObject) = #S_OK
If Selection\get_type(@bstr_type) = #S_OK And bstr_type
If LCase(PeekS(bstr_type, -1, #PB_Unicode)) = "text"
If Selection\createRange(@TextRange.IDispatch) = #S_OK And TextRange
UnicodeText$ = Space(10)
PokeS(@UnicodeText$, "text", -1, #PB_Unicode)
pUnicodeText = @UnicodeText$
If TextRange\GetIDsOfNames(?IID_NULL, @pUnicodeText, 1, #LOCALE_SYSTEM_DEFAULT, @dispid_text) = #S_OK
params.DISPPARAMS\cArgs = 0
params\cNamedArgs = 0
If TextRange\Invoke(dispid_text, ?IID_NULL, #LOCALE_SYSTEM_DEFAULT, #DISPATCH_PROPERTYGET, @params, @varResult.VARIANT, #Null, #Null) = #S_OK
If varResult\vt <> #VT_BSTR
VariantChangeType_(@varResult, @varResult, 0, #VT_BSTR)
EndIf
If varResult\vt = #VT_BSTR
Result$ = PeekS(varResult\bstrVal, -1, #PB_Unicode)
EndIf
VariantClear_(@varResult)
EndIf
EndIf
TextRange\Release()
EndIf
EndIf
SysFreeString_(bstr_type)
EndIf
Selection\Release()
EndIf
Document\Release()
EndIf
ProcedureReturn Result$
EndProcedure
; Gibt alles was innerhalb des <BODY> tags an reinem Text vorhanden ist zurück,
; also im Prinzip den ganzen Text der angezeigt wird
;
Procedure.s WebGadget_PageText(Gadget)
Result$ = ""
Document.IHTMLDocument2 = WebGadget_Document(Gadget, ?IID_IHTMLDocument2)
If Document
If Document\get_body(@Body.IHTMLElement) = #S_OK
If Body\get_innerText(@bstr_text) = #S_OK And bstr_text
Result$ = PeekS(bstr_text, -1, #PB_Unicode)
SysFreeString_(bstr_text)
EndIf
Body\Release()
EndIf
Document\Release()
EndIf
ProcedureReturn Result$
EndProcedure
; Gibt den kompletten HTML code zurück
;
Procedure.s WebGadget_PageHtml(Gadget)
Result$ = ""
Document.IHTMLDocument3 = WebGadget_Document(Gadget, ?IID_IHTMLDocument3)
If Document
If Document\get_documentElement(@Root.IHTMLElement) = #S_OK
If Root\get_outerHTML(@bstr_html) = #S_OK And bstr_html
Result$ = PeekS(bstr_html, -1, #PB_Unicode)
SysFreeString_(bstr_html)
EndIf
Root\Release()
EndIf
Document\Release()
EndIf
ProcedureReturn Result$
EndProcedure
; ===================================================================
; Beispiel
; ===================================================================
Enumeration
#Web
#Editor
#Button1
#Button2
#Button3
EndEnumeration
If OpenWindow(0, 0, 0, 500, 600, "Web", #PB_Window_ScreenCentered|#PB_Window_SystemMenu)
CreateGadgetList(WindowID(0))
WebGadget(#Web, 10, 10, 480, 300, "www.purebasic.com")
ButtonGadget(#Button1, 10, 320, 120, 25, "Text")
ButtonGadget(#Button2, 140, 320, 120, 25, "Html")
ButtonGadget(#Button3, 270, 320, 120, 25, "Selection")
EditorGadget(#Editor, 10, 355, 480, 235)
Repeat
Event = WaitWindowEvent()
If Event = #PB_Event_Gadget
Select EventGadget()
Case #Button1: SetGadgetText(#Editor, WebGadget_PageText(#Web))
Case #Button2: SetGadgetText(#Editor, WebGadget_PageHtml(#Web))
Case #Button3: SetGadgetText(#Editor, WebGadget_Selection(#Web))
EndSelect
EndIf
Until Event = #PB_Event_CloseWindow
EndIf
Endmir dann doch zu lange.
.
