It is currently Wed Aug 22, 2018 6:42 am

All times are UTC + 1 hour




Post new topic Reply to topic  [ 22 posts ]  Go to page 1, 2  Next
Author Message
 Post subject: Mousehole - web server / browser hybrid
PostPosted: Wed Aug 08, 2018 2:10 pm 
Offline
Addict
Addict
User avatar

Joined: Thu Jul 03, 2003 6:53 pm
Posts: 1199
Location: England
In another thread there's been some discussion about using HTML/CSS to create a UI for PB using an external library. I thought it might be fun to see what was possible without using an external dependency and the only way I could think of doing it was by having a server / browser hybrid with a front end and back end that exchange event data using JSON.

So here it is :D

StringBuilder.pb (this just contains some functions for joining and splitting strings):
Code:
Structure StringBuilderItem
  item.s
  size.i
EndStructure

Structure StringBuilder
  size.i
  count.i
  List item.StringBuilderItem()
EndStructure

Procedure StringBuilder_Add(*sb.StringBuilder,itm$)
  nSize = StringByteLength(itm$)
  *sb\size = *sb\size + nSize
  *sb\count = *sb\count + 1
  AddElement(*sb\item())
  *sb\item()\item = itm$
  *sb\item()\size = nSize
EndProcedure

Procedure StringBuilder_Clear(*sb.StringBuilder)
  ClearList(*sb\item())
  *sb\count = 0
  *sb\size = 0
EndProcedure

Procedure StringBuilder_Free(*sb.StringBuilder)
  ClearList(*sb\item())
  FreeStructure(*sb)
EndProcedure

Procedure.s StringBuilder_Get(*sb.StringBuilder,idx.i)
  If idx > *sb\count - 1
    ProcedureReturn ""
  EndIf
  SelectElement(*sb\item(),idx)
  ProcedureReturn *sb\item()\item
EndProcedure

Procedure.s StringBuilder_GetChunk(*source,nSize)
  *bfr = AllocateMemory(nSize + 4)
  CopyMemory(*source,*bfr,nSize)
  out$ = PeekS(*bfr)
  FreeMemory(*bfr)
  ProcedureReturn out$
EndProcedure

Procedure.i StringBuilder_GetLongest(*sb.StringBuilder)
  nLongest = 0
  ResetList(*sb\item())
  While NextElement(*sb\item())
    If *sb\item()\size > nLongest
      nLongest = *sb\item()\size
    EndIf
  Wend
  ProcedureReturn nLongest
EndProcedure

Procedure StringBuilder_Insert(*sb.StringBuilder,idx,val$)
  If idx > *sb\count - 1 : ProcedureReturn : EndIf
  SelectElement(*sb\item(),idx)
  InsertElement(*sb\item())
  nSize = StringByteLength(val$)
  *sb\count = *sb\count + 1
  *sb\size = *sb\size + nSize
  *sb\item()\item = val$
  *sb\item()\size = nSize
EndProcedure

Procedure.s StringBuilder_Join(*sb.StringBuilder,delim$="")
  nSizeDelim = StringByteLength(delim$)
  nAdder = ListSize(*sb\item()) * nSizeDelim
  *bfr = AllocateMemory(*sb\size + nAdder + 4)
  nLoops = 0
  ResetList(*sb\item())
  While NextElement(*sb\item())
    PokeS(*bfr+nPos,*sb\item()\item,*sb\item()\size)
    nPos = nPos + *sb\item()\size
    nLoops = nLoops + 1
    If nSizeDelim > 0 And nLoops < *sb\count
      PokeS(*bfr+nPos,delim$,nSizeDelim)
      nPos = nPos + nSizeDelim
    EndIf
  Wend
  out$ = PeekS(*bfr,*sb\size)
  FreeMemory(*bfr)
  ProcedureReturn out$
EndProcedure

Procedure.i StringBuilder_New()
  *s.StringBuilder = AllocateStructure(StringBuilder)
  *s\count = 0
  *s\size = 0
  ProcedureReturn *s
EndProcedure

Procedure StringBuilder_Remove(*sb.StringBuilder,idx.i)
  If idx > *sb\count - 1 : ProcedureReturn : EndIf
  SelectElement(*sb\item(),idx)
  *sb\count = *sb\count - 1
  *sb\size = *sb\size - *sb\item()\size
  DeleteElement(*sb\item())
EndProcedure

Procedure StringBuilder_Replace(*sb.StringBuilder,idx.i,val$)
  If idx > *sb\count - 1 : ProcedureReturn : EndIf
  SelectElement(*sb\item(),idx)
  *sb\size = *sb\size - *sb\item()\size
  nSize = StringByteLength(val$)
  *sb\size = *sb\size + nSize
  *sb\item()\item = val$
  *sb\item()\size = nSize
EndProcedure

Procedure.i StringBuilder_Split(val$,delim$)
  *sb = StringBuilder_New()
  nSizeDel = StringByteLength(delim$)
  nSizeVal = StringByteLength(val$)
  If nSizeDel = 0 Or nSizeVal = 0
    ProcedureReturn *sb
  EndIf
  nEnd = 0 : nLen = 0 : nStart = 0
  While nEnd <= nSizeVal
    If CompareMemory(@val$+nEnd,@delim$,nSizeDel)
      StringBuilder_Add(*sb,StringBuilder_GetChunk(@val$+nStart,nLen))
      nEnd = nEnd + nSizeDel
      nStart = nEnd
      nLen = 0
    Else
      nEnd = nEnd + 1
      nLen = nLen + 1
    EndIf
  Wend
  If nLen > 0
    StringBuilder_Add(*sb,StringBuilder_GetChunk(@val$+nStart,nLen))
  EndIf
  ProcedureReturn *sb
EndProcedure


Mousehole.pb (the server / browser hybrid):
Code:
XIncludeFile "StringBuilder.pb"

Declare.s ExtractFileName(conID)
Declare FileNotFound(conID,errcode=404,errmsg$="File Not Found")
Declare.s GetMimeType(fn$)
Declare.s GetRequestPath(conID)
Declare.s GetStringField(hdr$,fld$)
Declare HandleEvent(conID,nJS)
Declare NetworkLoop()
Declare OpenBrowser()
Declare.s PathFix(pth$)
Declare.s PathJoin(P1$,P2$)
Declare SendResponse(conID,txt$)
Declare SplitIncomingData(conID)
Declare WriteLog(txt$,clr=#False)

Enumeration
  #winMain
  #htm1
  #server
EndEnumeration

Global PS$     = "/"
Global NPS$    = "\"
CompilerIf #PB_Compiler_OS = #PB_OS_Windows
  PS$     = "\"
  NPS$    = "/"
CompilerEndIf

Global AppTitle$      = "Mousehole"
Global Port           = 8080
Global ini$           = PS$ + "setup.ini"
Global cwd$           = GetCurrentDirectory()
Global DefaultPage$   = PS$ + "index.html"
Global EOL$           = Chr(13) + Chr(10)
Global Quit           = 0
Global lpValueName.s = GetFilePart(ProgramFilename())
Global lpData = 11001

Global ReplyChunk     = 4096
Global RequestChunk   = ReplyChunk * 4

Global NewMap *incomingReq.StringBuilder() ; incoming request in progress
Global NewMap reqs.s()          ; incoming requests headers
Global NewMap reqbody.s()       ; incoming requests body
Global NewMap mimetypes.s()     ; mime types

CompilerIf #PB_Compiler_OS = #PB_OS_Windows
  If RegCreateKeyEx_(#HKEY_CURRENT_USER,"SOFTWARE\Microsoft\Internet Explorer\Main\FeatureControl\FEATURE_BROWSER_EMULATION",0,#Null,#REG_OPTION_VOLATILE,#KEY_ALL_ACCESS,#Null,@phkResult,@lpdwDisposition) = #ERROR_SUCCESS
    RegSetValueEx_(phkResult,lpValueName,0,#REG_DWORD,@lpData,SizeOf(LONG))
    RegCloseKey_(phkResult)
  Else
    MessageRequester("Error","Failed to bring the renderer into the 21st century!",0)
    End
  EndIf
CompilerElseIf #PB_Compiler_OS = #PB_OS_Linux
  ImportC "-no-pie" : EndImport
  ImportC "-lwebkitgtk-3.0"
    webkit_web_settings_new()
    webkit_web_view_set_settings(*WebkitWebView,*WebkitSettings)
  EndImport
  ;Global *err
  ;IconPath.s = "mouse.png"
  ;ImportC ""
  ;  gtk_window_set_default_icon_from_file(file.p-utf8, *err) As "gtk_window_set_default_icon_from_file"
  ;EndImport
  ;gtk_window_set_default_icon_from_file(IconPath,@*err)
CompilerEndIf

Procedure AddIncomingData(conID.i,txt$)
  key$ = Str(conID)
  If Not FindMapElement(*incomingReq(),key$) : *incomingReq(key$) = StringBuilder_New() : EndIf
  StringBuilder_Add(*incomingReq(key$),txt$)
EndProcedure

Procedure ClearRequest(conID)
  DeleteMapElement(*incomingReq(),Str(conID))
  DeleteMapElement(reqs(),Str(conID))
  DeleteMapElement(reqbody(),Str(conID))
EndProcedure

Procedure DoGET(conID)
  fn$ = PathJoin(cwd$,ExtractFileName(conID))
  DataLength = FileSize(fn$)
  If DataLength <= 0
    FileNotFound(conID)
    ProcedureReturn
  EndIf 
  key$ = Str(conID)
  req$ = reqs(key$)
  mt$  = GetMimeType(fn$)
  res$ = "HTTP/1.1 200 OK"  + EOL$ +
         "Content-Type: "   + mt$  + EOL$ +
         "Transfer-Encoding: chunked" + EOL$ + EOL$
  SendNetworkString(conID,res$,#PB_UTF8)
  nFile = ReadFile(#PB_Any,fn$)
  If nFile
    BufferSize = ReplyChunk
    DataSent   = 0
    While DataSent < DataLength
      If BufferSize > DataLength - DataSent
        BufferSize = DataLength - DataSent
      EndIf
      hxSize$ = Hex(BufferSize) + EOL$
      nSize   = StringByteLength(hxSize$,#PB_UTF8)
      *bfr    = AllocateMemory(BufferSize + nSize + 20)
      nPos    = PokeS(*bfr,hxSize$,nSize,#PB_UTF8) : nPos = *bfr + nPos ;buffer address + offset
      ReadData(nFile,nPos,BufferSize) : nPos = nPos + BufferSize
      PokeS(nPos,EOL$,StringByteLength(EOL$,#PB_UTF8),#PB_UTF8)
      nSize = nSize + BufferSize + StringByteLength(EOL$,#PB_UTF8)
      nSent = 0
      While nSent < nSize
        nPart = SendNetworkData(conID,*bfr + nSent,nSize - nSent)
        If nPart = -1
          Delay(3)
        Else
          nSent = nSent + nPart
        EndIf
      Wend
      FreeMemory(*bfr)
      DataSent = DataSent + BufferSize
    Wend
    hxSize$ = Hex(0) + EOL$ + EOL$
    SendNetworkString(conID,hxSize$,#PB_UTF8)
    CloseFile(nFile)
  Else
    FileNotFound(conID,403,"Forbidden")
  EndIf
  ClearRequest(conID)
EndProcedure

Procedure DoPOST(conID)
  ;Debug reqbody(Str(conID))
  nJS = ParseJSON(#PB_Any,reqbody(Str(conID)),#PB_UTF8)
  If nJS
    Debug ComposeJSON(nJS,#PB_JSON_PrettyPrint)
    HandleEvent(conID,nJS)
  Else
    ;Debug "Invalid JSON"
  EndIf
  ClearRequest(conID)
EndProcedure

CompilerIf #PB_Compiler_OS = #PB_OS_Linux
  Procedure EnableJSforWebGadget(WebgadgetID.i)
    ; Enable JavaScript support in GTK3 WebGadgets
    Protected WebkitSettings.i
    ; ----- Get Webkit's default setting (with scripting languages enabled by default)
    WebkitSettings = webkit_web_settings_new()
    ; ----- Store Webkit's default settings in WebGadget
    webkit_web_view_set_settings(GadgetID(WebgadgetID.i),WebkitSettings)
  EndProcedure
CompilerEndIf

Procedure Events_WindowClose()
  CloseNetworkServer(#server)
  End
EndProcedure

Procedure Events_WindowResized()
  nHeight = WindowHeight(#winMain)
  nWidth  = WindowWidth(#winMain)
  If IsGadget(#htm1)
    ResizeGadget(#htm1,2,2,nWidth-4,nHeight-4)
  EndIf
EndProcedure

Procedure.s ExtractFileName(conID)
  pth$ = GetRequestPath(conID)
  RequestedFile$    = URLDecoder(pth$)
  If RequestedFile$ = "" : RequestedFile$  = DefaultPage$ : EndIf
  RequestedFile$ = PathFix(RequestedFile$)
  ProcedureReturn RequestedFile$
EndProcedure

Procedure FileNotFound(conID,errcode=404,errmsg$="File Not Found")
  key$ = Str(conID)
  DataLength = StringByteLength(errmsg$,#PB_UTF8)
  res$ = "HTTP/1.1 " + Str(errcode) + " OK" + EOL$ +
         "Content-Type: text/plain" + EOL$ +
         "Content-length: " + Str(DataLength) + EOL$ +
         EOL$ + errmsg$
  SendNetworkString(conID,res$,#PB_UTF8)
  ClearRequest(conID)
EndProcedure

Procedure.s GetClientAddress(conID)
  ProcedureReturn IPString(GetClientIP(conID))
EndProcedure

Procedure.s GetContentBody(conID)
  ProcedureReturn reqbody(Str(conID))
EndProcedure

Procedure.s GetHeaderSection(conID)
  ProcedureReturn reqs(Str(conID))
EndProcedure

Procedure.s GetHeaderValue(conID,nm$)
  ProcedureReturn Trim(GetStringField(GetHeaderSection(conID),nm$))
EndProcedure

Procedure.s GetMimeType(fn$)
  ext$ = LCase(GetExtensionPart(fn$))
  mt$  = mimetypes(ext$)
  If mt$ = "" : mt$ = "text/html" : EndIf
  ProcedureReturn mt$
EndProcedure

Procedure.s GetQueryPath(conID) ; full path including parameters
  a$   = reqs(Str(conID))
  hdr$ = StringField(a$,1,Chr(13))
  pth$ = StringField(hdr$,2," ")
  ProcedureReturn pth$ 
EndProcedure

Procedure.s GetQueryString(conID) ; parameters without path
  pth$ = GetQueryPath(conID)
  nRes = FindString(pth$,"?",0)
  If nRes = 0 : ProcedureReturn "" : EndIf
  nLen = Len(pth$)
  ProcedureReturn Right(pth$,nLen-nRes)
EndProcedure

Procedure.i GetRequestLength(conID)
  ct$ = GetHeaderValue(conID,"Content-Length:")
  If ct$ <> "" : ProcedureReturn Val(ct$) : EndIf
  ct$ = GetContentBody(conID)
  ProcedureReturn StringByteLength(ct$,#PB_UTF8)
EndProcedure

Procedure.s GetRequestMethod(conID)
  a$   = reqs(Str(conID))
  hdr$ = StringField(a$,1,Chr(13))
  ProcedureReturn StringField(hdr$,1," ")
EndProcedure

Procedure.s GetRequestPath(conID) ; path without parameters
  pth$ = GetQueryPath(conID)
  If FindString(pth$,"?")
    pth$ = StringField(pth$,1,"?")
  EndIf
  ProcedureReturn pth$
EndProcedure

Procedure.s GetServerIP()
  ip$ = ""
  If ExamineIPAddresses(#PB_Network_IPv4)
    Repeat
      IP = NextIPAddress()
      If IP
        ip$ = IPString(IP)
      EndIf
    Until IP = 0
  EndIf
  ProcedureReturn ip$
EndProcedure

Procedure.s GetStringField(hdr$,fld$)
  nLen = Len(fld$)
  nCnt = CountString(hdr$,Chr(13))
  nPos = 1
  res$ = ""
  While nPos <= nCnt
    ln$ = Trim(StringField(hdr$,nPos,EOL$))
    If LCase(Left(ln$,nLen)) = LCase(fld$)
      nStart = FindString(ln$,":",0)
      nSize  = Len(ln$)
      ln$    = Right(ln$,nSize-nStart)
      If res$ <> "" : res$ = res$ + "," : EndIf
      res$ = res$ + ln$
    EndIf
    nPos = nPos + 1
  Wend
  ProcedureReturn res$
EndProcedure

Procedure HandleEvent(conID,nJS)
  id$ = GetJSONString(GetJSONMember(JSONValue(nJS),"id"))
  gd$ = GetJSONString(GetJSONMember(JSONValue(nJS),"gadgetId"))
  nRJ = CreateJSON(#PB_Any)
  If nRJ
    msg = SetJSONObject(JSONValue(nRJ))
    SetJSONString(AddJSONMember(msg,"response"),"Response from event handler for " + gd$)
    SetJSONString(AddJSONMember(msg,"id"),id$)
    txt$ = ComposeJSON(nRJ)
    SendResponse(conID,txt$)
    FreeJSON(nRJ)
  EndIf
  FreeJSON(nJS)
EndProcedure

Procedure HandleIncoming(ClientID)
  *Buffer = AllocateMemory(RequestChunk)
  RequestLength = ReceiveNetworkData(ClientID,*Buffer,RequestChunk)
  txt$ = PeekS(*Buffer,RequestLength,#PB_UTF8)
  AddIncomingData(ClientID,txt$)
  FreeMemory(*Buffer)
  If RequestLength < RequestChunk And RequestLength > 0
    SplitIncomingData(ClientID)
    pth$ = GetRequestPath(ClientID)
    mthd$ = GetRequestMethod(ClientID)
    If mthd$ = "GET"
      CreateThread(@DoGET(),ClientID)
    ElseIf mthd$ = "POST"
      CreateThread(@DoPOST(),ClientID)
    Else
      FileNotFound(ClientID,501,"Not Implemented: " + mthd$)
    EndIf                   
  EndIf 
EndProcedure

Procedure LoadSettings(fn$)
  If FileSize(fn$) > 0
    If OpenPreferences(fn$)
      If GetPathPart(fn$) <> "" : cwd$ = GetPathPart(fn$) : EndIf
      ExaminePreferenceGroups()
      While NextPreferenceGroup()
        If PreferenceGroupName() = "app"
          ExaminePreferenceKeys()
          While  NextPreferenceKey()
            Select PreferenceKeyName()
              Case "title"
                AppTitle$ = Trim(PreferenceKeyValue())
              Case "port"
                If PreferenceKeyValue() <> "" : Port = Val(PreferenceKeyValue()) : EndIf
                If Port = 0 : Port = 8080 : EndIf
              Case "main"
                DefaultPage$ = Trim(PreferenceKeyValue())
                DefaultPage$ = ReplaceString(DefaultPage$,"/","")
                DefaultPage$ = ReplaceString(DefaultPage$,"\","")
                If DefaultPage$ <> "" : DefaultPage$ = "/" + DefaultPage$ : EndIf
            EndSelect
          Wend
        ElseIf PreferenceGroupName() = "mime-types"
          ExaminePreferenceKeys()
          While NextPreferenceKey()
            mimetypes(LCase(PreferenceKeyName())) = Trim(PreferenceKeyValue())
          Wend         
        EndIf
      Wend
      ClosePreferences()
    EndIf
  Else
    WriteLog("Invalid *.ini file: " + fn$)
    End
  EndIf
EndProcedure

Procedure Main()
  iniFile$ = cwd$ + ini$
  LoadSettings(iniFile$)
 
  If InitNetwork()
    nLoops = 0 : nTries = 100
    nServerOpen = #False
    While nLoops < nTries
      If CreateNetworkServer(#server,Port)
        nServerOpen = #True
        nLoops = nTries
      Else
        nLoops = nLoops + 1
        Port = Port + 1
      EndIf
    Wend
    If Not nServerOpen
      MessageRequester("Error","Port " + Str(Port) + " already in use?",0)
      End
    EndIf   
  Else
    MessageRequester("Error","Failed To initialize the network!",0)
    End
  EndIf
 
  BindEvent(#PB_Event_CloseWindow,@Events_WindowClose())
  BindEvent(#PB_Event_SizeWindow,@Events_WindowResized())

  OpenBrowser()
  If LCase(Left(DefaultPage$,4)) = "http"
    u$ = DefaultPage$
  Else
    u$ = "http://localhost:" + Str(Port) + DefaultPage$
  EndIf
  SetGadgetText(#htm1,u$)
  NetworkLoop()
EndProcedure

Procedure NetworkLoop()
  Quit = 0
  Repeat 
    WEvent = WaitWindowEvent(20)
      SEvent = NetworkServerEvent()
      If SEvent
        ClientID = EventClient()
        Select SEvent   
          Case 1  ; When a new client has been connected...
           
          Case 4  ; When a client has closed the connection...
           
          Default
            HandleIncoming(ClientID)
        EndSelect
      EndIf
  Until Quit = 1 
EndProcedure

Procedure OpenBrowser()
  If OpenWindow(#winMain,100,100,700,400,AppTitle$,#PB_Window_SystemMenu|#PB_Window_SizeGadget|#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget)
    WebGadget(#htm1,5,5,580,280,"")
    SetGadgetAttribute(#htm1,#PB_Web_BlockPopups,#True)
    SetGadgetAttribute(#htm1,#PB_Web_BlockPopupMenu,#True)
    Events_WindowResized()
    CompilerIf #PB_Compiler_OS = #PB_OS_Linux
      EnableJSforWebGadget(#htm1)
    CompilerEndIf
  Else
    End
  EndIf
EndProcedure

Procedure.s PathFix(pth$)
  txt$ = pth$
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    txt$ = ReplaceString(txt$,"/",PS$)
  CompilerEndIf 
  ProcedureReturn txt$
EndProcedure

Procedure.s PathJoin(P1$,P2$)
  If Right(P1$,Len(PS$)) = PS$ And Left(P2$,Len(PS$)) = PS$
    ProcedureReturn Left(P1$,Len(P1$)-Len(PS$)) + P2$
  ElseIf Right(P1$,Len(PS$)) <> PS$ And Left(P2$,Len(PS$)) <> PS$
    ProcedureReturn P1$ + PS$ + P2$
  Else
    ProcedureReturn P1$ + P2$
  EndIf
EndProcedure

Procedure SendChunk(conID,txt$,eot=#False)
  nSize    = StringByteLength(txt$,#PB_UTF8)
  If eot=#False And nSize = 0 : ProcedureReturn : EndIf ; don't want to eot by mistake
  hxSize$  = Hex(nSize)
  res$ = hxSize$ + EOL$ + txt$ + EOL$
  nSize = StringByteLength(res$,#PB_UTF8)
  *bfr = AllocateMemory(nSize+10)
  PokeS(*bfr,res$,nSize,#PB_UTF8)
  nSent = 0
  While nSent < nSize
    nPart = SendNetworkData(conID,*bfr + nSent,nSize - nSent)
    If nPart = -1
      Delay(3)
    Else
      nSent = nSent + nPart
    EndIf
  Wend
  FreeMemory(*bfr)
EndProcedure

Procedure SendEOT(conID)
  SendChunk(conID,"",#True)
EndProcedure

Procedure SendHeader(conID)
  res$ = "HTTP/1.1 200 OK"  + EOL$ +
         "Content-Type: application/json" + EOL$ +
         "Transfer-Encoding: chunked" + EOL$ + EOL$
  SendNetworkString(conID,res$,#PB_UTF8)
EndProcedure

Procedure SendResponse(conID,txt$)
  SendHeader(conID)
  SendChunk(conID,txt$)
  SendEOT(conID)
EndProcedure

Procedure SplitIncomingData(conID)
  dlim$ = EOL$ + EOL$
  key$ = Str(conID)
  txt$ = StringBuilder_Join(*incomingReq(key$))
  *sb = StringBuilder_Split(txt$,dlim$)
  reqs(key$) = StringBuilder_Get(*sb,0)
  StringBuilder_Remove(*sb,0)
  reqbody(key$) = StringBuilder_Join(*sb)
  StringBuilder_Free(*sb)
EndProcedure

Procedure.s URLJoin(P1$,P2$)
  DS$ = "/"
  If Right(P1$,Len(DS$)) = DS$ And Left(P2$,Len(DS$)) = DS$
    ProcedureReturn Left(P1$,Len(P1$)-Len(PS$)) + P2$
  ElseIf Right(P1$,Len(DS$)) <> DS$ And Left(P2$,Len(DS$)) <> DS$
    ProcedureReturn P1$ + DS$ + P2$
  Else
    ProcedureReturn P1$ + P2$
  EndIf
EndProcedure

Procedure WriteLog(txt$,clr=#False)
  If clr
    nRes = OpenFile(0,PathJoin(cwd$,"mousehole_log.txt"))
  Else
    nRes = OpenFile(0,PathJoin(cwd$,"mousehole_log.txt"),#PB_File_Append)
  EndIf
  If nRes
    WriteStringN(0,txt$)
    TruncateFile(0)
    CloseFile(0)
  EndIf 
EndProcedure

Main()
CompilerIf #PB_Compiler_OS = #PB_OS_Windows
  If RegOpenKeyEx_(#HKEY_CURRENT_USER,"SOFTWARE\Microsoft\Internet Explorer\Main\FeatureControl\FEATURE_BROWSER_EMULATION",0,#KEY_SET_VALUE,@phkResult) = #ERROR_SUCCESS
    RegDeleteValue_(phkResult,lpValueName)
    RegCloseKey_(phkResult)
  EndIf
CompilerEndIf
End


setup.ini (an ini file):
Code:
[app]
title = Mousehole Demo
main = index.html
port = 8082

[mime-types]
json = application/json
pdf = application/pdf
sig = application/pgp-signature
spl = application/futuresplash
ps = application/postscript
torrent = application/x-bittorrent
dvi = application/x-dvi
gz = application/x-gzip
pac = application/x-ns-proxy-autoconfig
swf = application/x-shockwave-flash
gz = application/x-tgz
tgz = application/x-tgz
tar = application/x-tar
zip = application/zip
mp3 = audio/mpeg
m3u = audio/x-mpegurl
wma = audio/x-ms-wma
wax = audio/x-ms-wax
ogg = application/ogg
wav = audio/x-wav
gif = image/gif
jpg = image/jpeg
jpeg = image/jpeg
png = image/png
xbm = image/x-xbitmap
xpm = image/x-xpixmap
xwd = image/x-xwindowdump
css = text/css
html = text/html
htm = text/html
js = text/javascript
asc = text/plain
c = text/plain
cpp = text/plain
log = text/plain
conf = text/plain
text = text/plain
txt = text/plain
dtd = text/xml
xml = text/xml
mpeg = video/mpeg
mpg = video/mpeg
mov = video/quicktime
qt = video/quicktime
avi = video/x-msvideo
asf = video/x-ms-asf
asx = video/x-ms-asf
wmv = video/x-ms-wmv
bz2 = application/x-bzip
tbz = application/x-bzip-compressed-tar


index.html (a very simple test ui):
Code:
<html>
    <head>
        <meta http-equiv="content-type" content="text/html;charset=utf-8" />
        <meta name="viewport" content="width=device-width, initial-scale=1.0, maximum-scale=1.0, user-scalable=no">
    </head>
    <body>
        <div id="frmMain" width="600px">
            <div id="box">
                <textarea id="txtResponse" rows="20" cols="80"></textarea>
                <br>
                <input id="btnOne" type="button" onclick="test_one()" value="Test 1"/>
                <input id="btnTwo" type="button" onclick="test_two()" value="Test 2"/>
            </div>
        </div>
   
    <script>
    function send_it(mthd,pth,obj) {
        var request = new XMLHttpRequest();
        var formData = "";
        if (typeof(obj) == "object") {
            formData = JSON.stringify(obj);
        } else {
            formData = obj;
        }
   
        request.onreadystatechange = function() {
            var t = document.getElementById("txtResponse");   
            if (request.readyState == 4) {
                if(request.status == 200) {
                    t.value = request.responseText;
                } else {
                    t.value = request.status + " -> " + request.responseText;
                }
            }
        };
   
        // var port = window.location.port;
        request.open(mthd,pth);
        try {
            request.send(formData);
        } catch(err) {
            alert(err.description);
        }
    }

    function test_one() {
        var obj={"gadgetId":"btnOne","eventType":"click","id":"123"};
        obj["params"]={"additionalData":"Mary had a little pig"};
        send_it("POST","/",obj);
    }
   
    function test_two() {
        var obj={"gadgetId":"btnTwo","eventType":"click","id":"456"};
        obj["params"]={"additionalData":"she could not stop it grunting"};
        send_it("POST","/",obj);
    }   
    </script>
    </body>
</html>


setup.ini and index.html should be in the same folder as the mousehole executable.


Last edited by the.weavster on Thu Aug 09, 2018 10:48 am, edited 2 times in total.

Top
 Profile  
Reply with quote  
 Post subject: Re: Mousehole - web server / browser hybrid
PostPosted: Wed Aug 08, 2018 9:11 pm 
Offline
Addict
Addict
User avatar

Joined: Fri Sep 21, 2007 5:52 am
Posts: 3311
Location: New Zealand
Nice, thanks for sharing.

_________________
Got winter blues?
Enjoy a Caravan Trip into, "The Land of Grey and Pink", wine and punk weed optional!
https://www.youtube.com/watch?v=9hmFzGTxod4


Top
 Profile  
Reply with quote  
 Post subject: Re: Mousehole - web server / browser hybrid
PostPosted: Thu Aug 09, 2018 8:50 am 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Fri Oct 06, 2006 3:57 pm
Posts: 480
Location: England
Hi,

I get 'script error' at start up and if I press either button.

Windows 10 x64 - PB 5.62 x86

cheers


Top
 Profile  
Reply with quote  
 Post subject: Re: Mousehole - web server / browser hybrid
PostPosted: Thu Aug 09, 2018 10:36 am 
Offline
Addict
Addict
User avatar

Joined: Thu Jul 03, 2003 6:53 pm
Posts: 1199
Location: England
I have to confess I'd only tested it on Ubuntu 18.04.

I'll give it a try on Windows when I get the chance. It sounds from the error you describe it's the html it doesn't like.


Top
 Profile  
Reply with quote  
 Post subject: Re: Mousehole - web server / browser hybrid
PostPosted: Thu Aug 09, 2018 10:54 am 
Offline
Addict
Addict
User avatar

Joined: Thu Jul 03, 2003 6:53 pm
Posts: 1199
Location: England
Can you try again now?

I had a bug that wasn't clearing down the first request before the second one arrived. I guess on Ubuntu the second request had a different connection ID but on Windows the connection was being kept alive so I ended up with a conjoined mess of a request :lol:

It's working on my Windows 10 PC with PB 5.61 x64 so hopefully it will work for you too now.


Top
 Profile  
Reply with quote  
 Post subject: Re: Mousehole - web server / browser hybrid
PostPosted: Thu Aug 09, 2018 1:45 pm 
Offline
Addict
Addict
User avatar

Joined: Sun Nov 05, 2006 11:42 pm
Posts: 4229
Location: Lyon - France
Waouhhh !! what a big job :shock:
Here that not works with W7 x86 / v5.62 x86 (Impossible to find the page)
Perhaps because i'm behind a proxy :cry:

_________________
ImageThe happiness is a road...
Not a destination


Top
 Profile  
Reply with quote  
 Post subject: Re: Mousehole - web server / browser hybrid
PostPosted: Thu Aug 09, 2018 2:38 pm 
Offline
Addict
Addict
User avatar

Joined: Thu Jul 03, 2003 6:53 pm
Posts: 1199
Location: England
Kwai chang caine wrote:
Here that not works with W7 x86 / v5.62 x86 (Impossible to find the page)

Do you actually get a 404 or does it just timeout?
I've noticed there's a real difference in load up time between my Ubuntu PC and my Windows 10 PC (similar specs), with Ubuntu it's instantaneous but with Windows there's quite a pause before it's up and running.


Top
 Profile  
Reply with quote  
 Post subject: Re: Mousehole - web server / browser hybrid
PostPosted: Thu Aug 09, 2018 4:25 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Fri Oct 06, 2006 3:57 pm
Posts: 480
Location: England
the.weavster wrote:
Can you try again now?

I had a bug that wasn't clearing down the first request before the second one arrived. I guess on Ubuntu the second request had a different connection ID but on Windows the connection was being kept alive so I ended up with a conjoined mess of a request :lol:

It's working on my Windows 10 PC with PB 5.61 x64 so hopefully it will work for you too now.


hi weavster,

I'm Assuming you only change the Mousehole.pb file ??

In which case it still throws the same javascript error.

Win 10 Pro x64, PB 5.62 x86, AMD FX8350 and ooooodles of ram -> if that helps any

cheers


Top
 Profile  
Reply with quote  
 Post subject: Re: Mousehole - web server / browser hybrid
PostPosted: Thu Aug 09, 2018 5:26 pm 
Offline
Addict
Addict
User avatar

Joined: Thu Jul 03, 2003 6:53 pm
Posts: 1199
Location: England
captain_skank wrote:
I'm Assuming you only change the Mousehole.pb file ??

I changed the html file too in case IE's JSON parser was choking on the fact one of the values had a single quote in it.
If it still fails perhaps you could open IE, point it at http://localhost:8080/index.html while Mousehole is running and then see what the console says.

Have you tried with PB x64 rather than PB x86? I'd be interested to know if that makes a difference on your PC.


Top
 Profile  
Reply with quote  
 Post subject: Re: Mousehole - web server / browser hybrid
PostPosted: Thu Aug 09, 2018 6:56 pm 
Offline
Addict
Addict
User avatar

Joined: Thu Jul 03, 2003 6:53 pm
Posts: 1199
Location: England
I've installed PB x86 and given it a test run and on my PC it works.
It doesn't matter whether or not the JSON has the single quote or not either.

Could it be an encoding issue? What did you use to save the html to disk? The HTML should be UTF8. I might be clutching at straws here but I can't think why you'd be getting the error you are.


Top
 Profile  
Reply with quote  
 Post subject: Re: Mousehole - web server / browser hybrid
PostPosted: Fri Aug 10, 2018 8:57 am 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Fri Oct 06, 2006 3:57 pm
Posts: 480
Location: England
Hi, sorry for the delay in getting back.

Re-saved the index.html using notepad++ and it's now working.

looks good and an intersting concept.


Top
 Profile  
Reply with quote  
 Post subject: Re: Mousehole - web server / browser hybrid
PostPosted: Sat Aug 18, 2018 5:23 pm 
Offline
Addict
Addict
User avatar

Joined: Sun Nov 05, 2006 11:42 pm
Posts: 4229
Location: Lyon - France
Excuse me the.weavster for the late answer :oops:

Quote:
Do you actually get a 404 or does it just timeout?
In my remember it's a time out, it's the reason why i talk about the proxy :wink:

So now i'm in my home, without proxy with another machine with W10 x86 / v5.62 x86
And i have this error

Image

_________________
ImageThe happiness is a road...
Not a destination


Top
 Profile  
Reply with quote  
 Post subject: Re: Mousehole - web server / browser hybrid
PostPosted: Sat Aug 18, 2018 6:26 pm 
Offline
Addict
Addict
User avatar

Joined: Thu Jul 03, 2003 6:53 pm
Posts: 1199
Location: England
It's the same error captain_skank had, you need to make sure you have saved the html as utf8 :wink:


Top
 Profile  
Reply with quote  
 Post subject: Re: Mousehole - web server / browser hybrid
PostPosted: Sun Aug 19, 2018 4:52 am 
Offline
Addict
Addict
User avatar

Joined: Sat Jun 30, 2007 8:04 pm
Posts: 3222
My solution was to pass data through the address bar url and watch for JavaScript events. But I think it used Win32 stuff as well to make the JavaScript events work.

_________________
Image


Top
 Profile  
Reply with quote  
 Post subject: Re: Mousehole - web server / browser hybrid
PostPosted: Sun Aug 19, 2018 7:25 am 
Offline
Addict
Addict
User avatar

Joined: Thu Jul 03, 2003 6:53 pm
Posts: 1199
Location: England
Actually I'm not sure the win32 stuff is needed at all, I think I could have used a compatability tag in the html. I don't have access to a PC right now so I can't test that.

If you want to try the tag is: <meta http-equiv="X-UA-Compatible" content="IE=edge">
and then you should be able to comment out the FEATURE_BROWSER_EMULATION stuff.

If you want a good, free html/css/js/php editor google 'Geany'


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 22 posts ]  Go to page 1, 2  Next

All times are UTC + 1 hour


Who is online

Users browsing this forum: Micoute and 5 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye