Beispiel:
Code: Alles auswählen
<html>
<title>HAllo</title>
</html>
Code: Alles auswählen
<html>
<title>HAllo</title>
</html>
Code: Alles auswählen
If FindString(string$, "<title>", 1)
titel$=Mid(string$, FindString(string$, "<title>", 1) + 7, FindString(string$, "</title>", 1)
EndIf
Code: Alles auswählen
<script language="JavaScript">
document.title="Meine homepage";
</script>
Code: Alles auswählen
Macro Happy
;-)
EndMacro
Happy End
Code: Alles auswählen
Procedure.s GetHtmlTitleVbs(URL$)
Dummy$ = "Set myIE= CreateObject(" + Chr(34) + "InternetExplorer.Application" + Chr(34) + ")" + #crlf$
Dummy$ + "Do While myIE.Busy" + #crlf$
Dummy$ + "Loop" + #crlf$
Dummy$ + "myIE.Visible = 0" + #crlf$
Dummy$ + "myIE.Navigate " + Chr(34) + URL$ + Chr(34) + #crlf$
Dummy$ + "Do While myIE.ReadyState <> 4" + #crlf$
Dummy$ + "Loop" + #crlf$
Dummy$ + "Set oDoc = myIE.Document" + #crlf$
Dummy$ + "myTitle = oDoc.title" + #crlf$
Dummy$ + "Set oDoc = Nothing" + #crlf$
Dummy$ + "Set myIE = Nothing" + #crlf$
ProcedureReturn Dummy$
EndProcedure
Structure xVARIANT
Type.w
Reserved1.w
Reserved2.w
Reserved3.w
String.l
EndStructure
#VT_BSTR = 8
x.xVARIANT\Type = #VT_BSTR
Procedure.l Ansi2Uni(ansi.s)
Size.l=MultiByteToWideChar_(#CP_ACP,0,ansi,-1,0,0)
Dim unicode.w(Size)
MultiByteToWideChar_(#CP_ACP, 0, ansi, Len(ansi), unicode(), Size)
ProcedureReturn @unicode()
EndProcedure
Procedure.s Uni2Ansi(*Unicode.l)
Size.l = WideCharToMultiByte_(#CP_ACP, 0, *Unicode, -1, #Null, #Null, #Null, #Null)
ansi.s=Space(Size)
WideCharToMultiByte_(#CP_ACP, 0, *Unicode, -1, @ansi, Size, #Null, #Null)
ProcedureReturn ansi
EndProcedure
Enumeration ; ScriptControlStates
#Initialized = 0
#Connected = 1
EndEnumeration
; DispInterfaces
Interface IScriptProcedure Extends IDispatch
get_Name(a)
get_NumArgs(a)
get_HasReturnValue(a)
EndInterface
Interface IScriptProcedureCollection Extends IDispatch
get__NewEnum(a)
get_Item(a,b,c,d,e)
get_Count(a)
EndInterface
Interface IScriptModule Extends IDispatch
get_Name(a)
get_CodeObject(a)
get_Procedures(a)
AddCode(a)
Eval(a,b)
ExecuteStatement(a)
Run(a,b,c)
EndInterface
Interface IScriptModuleCollection Extends IDispatch
get__NewEnum(a)
get_Item(a,b,c,d,e)
get_Count(a)
Add(a,b,c)
EndInterface
Interface IScriptError Extends IDispatch
get_Number(a)
get_Source(a)
get_Description(a)
get_HelpFile(a)
get_HelpContext(a)
get_Text(a)
get_Line(a)
get_Column(a)
Clear()
EndInterface
Interface IScriptControl Extends IDispatch
get_Language(a)
put_Language(a)
get_State(a)
put_State(a)
put_SitehWnd(a)
get_SitehWnd(a)
get_Timeout(a)
put_Timeout(a)
get_AllowUI(a)
put_AllowUI(a)
get_UseSafeSubset(a)
put_UseSafeSubset(a)
get_Modules(a)
get_Error(a)
get_CodeObject(a)
get_Procedures(a)
_AboutBox()
AddObject(a,b,c)
Reset()
AddCode(a)
Eval(a,b)
ExecuteStatement(a)
Run(a,b,c)
EndInterface
CoInitialize_(0)
If CoCreateInstance_(?CLSID_ScriptControl,0,1,?IID_IScriptControl,@Object.IScriptControl) = 0
Object\Reset()
Object\put_Language(Ansi2Uni("vbscript"))
Object\AddCode(Ansi2Uni(GetHtmlTitleVbs("http://www.purebasic.fr/german/index.php"))) ; !!! URL anpassen
Object\Eval(Ansi2Uni("myTitle"),@x)
myTitle.s = Uni2Ansi(x\String)
Object\Reset()
Object\release()
EndIf
CoUninitialize_()
MessageRequester("HTML-Title", myTitle)
DataSection
CLSID_ScriptControl:
Data.l $0E59F1D5
Data.w $1FBE,$11D0
Data.b $8F,$F2,$00,$A0,$D1,$00,$38,$BC
IID_IScriptControl:
Data.l $0E59F1D3
Data.w $1FBE,$11D0
Data.b $8F,$F2,$00,$A0,$D1,$00,$38,$BC
EndDataSection