Mousehole - web server / browser hybrid

Share your advanced PureBasic knowledge/code with the community.
User avatar
the.weavster
Addict
Addict
Posts: 1536
Joined: Thu Jul 03, 2003 6:53 pm
Location: England

Mousehole - web server / browser hybrid

Post by the.weavster »

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: Select all

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: Select all

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: Select all

[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: Select all

<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.
User avatar
idle
Always Here
Always Here
Posts: 5040
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Re: Mousehole - web server / browser hybrid

Post by idle »

Nice, thanks for sharing.
Windows 11, Manjaro, Raspberry Pi OS
Image
User avatar
captain_skank
Enthusiast
Enthusiast
Posts: 636
Joined: Fri Oct 06, 2006 3:57 pm
Location: England

Re: Mousehole - web server / browser hybrid

Post by captain_skank »

Hi,

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

Windows 10 x64 - PB 5.62 x86

cheers
User avatar
the.weavster
Addict
Addict
Posts: 1536
Joined: Thu Jul 03, 2003 6:53 pm
Location: England

Re: Mousehole - web server / browser hybrid

Post by the.weavster »

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.
User avatar
the.weavster
Addict
Addict
Posts: 1536
Joined: Thu Jul 03, 2003 6:53 pm
Location: England

Re: Mousehole - web server / browser hybrid

Post by the.weavster »

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.
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5342
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: Mousehole - web server / browser hybrid

Post by Kwai chang caine »

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
User avatar
the.weavster
Addict
Addict
Posts: 1536
Joined: Thu Jul 03, 2003 6:53 pm
Location: England

Re: Mousehole - web server / browser hybrid

Post by the.weavster »

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.
User avatar
captain_skank
Enthusiast
Enthusiast
Posts: 636
Joined: Fri Oct 06, 2006 3:57 pm
Location: England

Re: Mousehole - web server / browser hybrid

Post by captain_skank »

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
User avatar
the.weavster
Addict
Addict
Posts: 1536
Joined: Thu Jul 03, 2003 6:53 pm
Location: England

Re: Mousehole - web server / browser hybrid

Post by the.weavster »

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.
User avatar
the.weavster
Addict
Addict
Posts: 1536
Joined: Thu Jul 03, 2003 6:53 pm
Location: England

Re: Mousehole - web server / browser hybrid

Post by the.weavster »

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.
User avatar
captain_skank
Enthusiast
Enthusiast
Posts: 636
Joined: Fri Oct 06, 2006 3:57 pm
Location: England

Re: Mousehole - web server / browser hybrid

Post by captain_skank »

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.
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5342
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: Mousehole - web server / browser hybrid

Post by Kwai chang caine »

Excuse me the.weavster for the late answer :oops:
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
User avatar
the.weavster
Addict
Addict
Posts: 1536
Joined: Thu Jul 03, 2003 6:53 pm
Location: England

Re: Mousehole - web server / browser hybrid

Post by the.weavster »

It's the same error captain_skank had, you need to make sure you have saved the html as utf8 :wink:
Mistrel
Addict
Addict
Posts: 3415
Joined: Sat Jun 30, 2007 8:04 pm

Re: Mousehole - web server / browser hybrid

Post by Mistrel »

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.
User avatar
the.weavster
Addict
Addict
Posts: 1536
Joined: Thu Jul 03, 2003 6:53 pm
Location: England

Re: Mousehole - web server / browser hybrid

Post by the.weavster »

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'
Post Reply