WebGadget compatible HTML5
Publié : lun. 06/oct./2014 19:07
Un webgadget compatible HTML5. L’exécutable sera vu comme un navigateur compatible Internet explorer 11 et sera enregistré dans la base de registre.
Le numéro de version du navigateur se trouve dans la procédure Start.Modifié le code 11001 par 10001 si vous souhaitez passer en version 10.
D'autres code de navigateurs sur ce lien http://msdn.microsoft.com/en-us/library ... s.85).aspx
Le code complet qui ouvre le site http://html5test.com afin de voir le résultat.
Le numéro de version du navigateur se trouve dans la procédure Start.
Code : Tout sélectionner
Procedure Start()
RegCreateKeyValue("HKEY_LOCAL_MACHINE\Software\Microsoft\Internet Explorer\Main\FeatureControl\FEATURE_BROWSER_EMULATION", GetFilePart(ProgramFilename()), "11001", #REG_DWORD, ".")
MainFormShow()
EndProcedure
D'autres code de navigateurs sur ce lien http://msdn.microsoft.com/en-us/library ... s.85).aspx
Le code complet qui ouvre le site http://html5test.com afin de voir le résultat.
Code : Tout sélectionner
;WebGadget HTML5 compatible
;Contributor: Sphere Users Pure Basic
;
;Create 29-08-2014
;Update 29-08-2014
;
Enumeration Window
#MainForm
EndEnumeration
Enumeration Gadget
#URL
#WebGadget
EndEnumeration
Global Url.s="http://html5test.com/"
;-
;- U.T. Registry
Procedure RegConvertRegKeyToTopKeyAndKeyName(Key.s)
Shared topKey,KeyName.s
temp.s=StringField(Key,1,"\")
temp=UCase(temp)
Select temp
Case "HKEY_CLASSES_ROOT"
topKey=#HKEY_CLASSES_ROOT
Case "HKEY_CURRENT_USER"
topKey=#HKEY_CURRENT_USER
Case "HKEY_LOCAL_MACHINE"
topKey=#HKEY_LOCAL_MACHINE
Case "HKEY_USERS"
topKey=#HKEY_USERS
Case "HKEY_CURRENT_CONFIG"
topKey=#HKEY_CURRENT_CONFIG
EndSelect
PositionSlash=FindString(Key,"\",1)
KeyName.s=Right(Key,(Len(Key)-PositionSlash))
EndProcedure
ProcedureDLL RegSetValue(Key.s, ValueName.s, Value.s, Type, ComputerName.s) ; Sets a Value
;Type can be #REG_SZ / #REG_DWORD / #REG_BINARY / #REG_EXPAND_SZ
;For REG_BINARY type use Hexa value as String
;Returns 1 if successful or 0 if it fails
Shared RegWow64.l,RegEx,topKey,KeyName.s
RegConvertRegKeyToTopKeyAndKeyName(Key)
If ComputerName = "."
If RegEx
GetHandle = RegOpenKeyEx_(topKey,KeyName,0,#KEY_ALL_ACCESS|RegWow64,@hKey)
Else
GetHandle = RegOpenKey_(topKey,KeyName,@hKey)
EndIf
Else
lReturnCode = RegConnectRegistry_(ComputerName,topKey,@lhRemoteRegistry)
If RegEx
GetHandle = RegOpenKeyEx_(lhRemoteRegistry,KeyName,0,#KEY_ALL_ACCESS|RegWow64,@hKey)
Else
GetHandle = RegOpenKey_(lhRemoteRegistry,KeyName,@hKey)
EndIf
EndIf
If GetHandle = #ERROR_SUCCESS
lpcbData = 255
lpData.s = Space(255)
Select Type
Case #REG_EXPAND_SZ
GetHandle = RegSetValueEx_(hKey, ValueName, 0, #REG_EXPAND_SZ, @Value, Len(Value) + 1)
Case #REG_SZ
GetHandle = RegSetValueEx_(hKey, ValueName, 0, #REG_SZ, @Value, Len(Value) + 1)
Case #REG_DWORD
lValue = Val(Value)
GetHandle = RegSetValueEx_(hKey, ValueName, 0, #REG_DWORD, @lValue, 4)
Case #REG_BINARY
LenBuffer=Len(Value)/2
*RegBuffer=AllocateMemory(LenBuffer)
For n=0 To LenBuffer-1
OctetHexa.s=Mid(Value,(n*2)+1,2)
Octet=Val("$"+OctetHexa)
PokeB(*RegBuffer+n,Octet)
Next
GetHandle= RegSetValueEx_(hKey,ValueName,0,#REG_BINARY,*RegBuffer,LenBuffer)
FreeMemory(*RegBuffer)
EndSelect
RegCloseKey_(hKey)
ergebnis = 1
ProcedureReturn ergebnis
Else
RegCloseKey_(hKey)
ergebnis = 0
ProcedureReturn ergebnis
EndIf
EndProcedure
ProcedureDLL RegCreateKey(Key.s, ComputerName.s)
;It create subkey if KeyPath don't exist
;Returns 1 if successful or 0 if it fails
Shared RegWow64.l,RegEx,topKey,KeyName.s
RegConvertRegKeyToTopKeyAndKeyName(Key)
lpSecurityAttributes.SECURITY_ATTRIBUTEs
If ComputerName = "."
If RegEx
GetHandle = RegCreateKeyEx_(topKey,KeyName,0,0,#REG_OPTION_NON_VOLATILE,#KEY_ALL_ACCESS|RegWow64,@lpSecurityAttributes,@hNewKey,@GetHandle)
Else
GetHandle = RegCreateKey_(topKey,KeyName,@hNewKey)
EndIf
Else
lReturnCode = RegConnectRegistry_(ComputerName, topKey, @lhRemoteRegistry)
If RegEx
GetHandle = RegCreateKeyEx_(lhRemoteRegistry,KeyName,0,0,#REG_OPTION_NON_VOLATILE,#KEY_ALL_ACCESS|RegWow64,@lpSecurityAttributes,@hNewKey,@GetHandle)
Else
GetHandle = RegCreateKey_(lhRemoteRegistry,KeyName,@hNewKey)
EndIf
EndIf
If GetHandle = #ERROR_SUCCESS
GetHandle = RegCloseKey_(hNewKey)
CreateKey = #True
Else
CreateKey = #False
EndIf
ProcedureReturn CreateKey
EndProcedure
ProcedureDLL RegCreateKeyValue(Key.s,ValueName.s,Value.s,Type,ComputerName.s) ; Creates a Key and a Value in a Single Command
;Type can be #REG_SZ or #REG_DWORD
;Returns 1 if successful or 0 if it fails
RegCreateKey(Key,ComputerName)
ProcedureReturn RegSetValue(Key,ValueName,Value,Type,ComputerName)
EndProcedure
;-
;-Test Area
Procedure NavigationCallback(Gadget, NewUrl.s)
Debug "new " + NewUrl + " - " + "old " + Url
If NewUrl <> Url
SetGadgetText(Gadget, NewUrl)
Url = NewUrl
EndIf
ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure
Procedure MainFormShow()
OpenWindow(#MainForm, 0, 0, 1024, 768,"WebGadget HTML5 compatible",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
WebGadget(#WebGadget, 0, 0, 1024, 768, Url)
;SetGadgetAttribute(#WebGadget, #PB_Web_NavigationCallback, @NavigationCallback())
SetGadgetAttribute(#WebGadget, #PB_Web_BlockPopups, #True)
SetGadgetAttribute(#WebGadget, #PB_Web_BlockPopupMenu, #True)
myBrowser.IWebBrowser2 = GetWindowLong_(GadgetID(#WebGadget), #GWL_USERDATA)
myBrowser\put_Silent(#True) ;Suppress error warnings in WebGadget
myBrowser\put_Left(0)
EndProcedure
Procedure Start()
RegCreateKeyValue("HKEY_LOCAL_MACHINE\Software\Microsoft\Internet Explorer\Main\FeatureControl\FEATURE_BROWSER_EMULATION", GetFilePart(ProgramFilename()), "11001", #REG_DWORD, ".")
MainFormShow()
EndProcedure
Start()
Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow