The preprocessor compiles bhp files(html+freebasic) to a dll. The edited webserver calls the preprocessor when the corresponding dll doesn't exist for the bhp file when the browser requests the page, then the webserver loads the dll and calls the entry function which will return the response.
It currently supports <% %> and <%= %> tags to escape from html to freebasic codes.
To try it:
1.Get CVS freebasic (windows, modifications needed for linux)
2.Compile the sources to exe
3.put freebasic in a FreeBASIC folder with the exes, so bhp can call "FreeBASIC\fbc.exe"
4.put the test.bhp with the exes
5.run webserver
6.try http://127.0.0.1:8080/test.jsp
Let's get form posting handling ready and replace php lol
bhp.bas compile to bhp.exe
Code: Select all
'Copyright (c) 2007 Lung Wing Kiu aka fishhf
'
'This software is provided 'as-is', without any express or implied
'warranty. In no event will the authors be held liable for any damages
'arising from the use of this software.
'
'Permission is granted to anyone to use this software for any purpose,
'including commercial applications, and to alter it and redistribute it
'freely, subject to the following restrictions:
'
' 1. The origin of this software must not be misrepresented; you must not
' claim that you wrote the original software. If you use this software
' in a product, an acknowledgment in the product documentation would be
' appreciated but is not required.
'
' 2. Altered source versions must be plainly marked as such, and must not be
' misrepresented as being the original software.
'
' 3. This notice may not be removed or altered from any source
' distribution.
Sub replaceString(ByRef s As String,f As String,r As string)
Dim As Integer st=InStr(s,f)
Dim As Integer lenf=Len(f)
Dim As Integer lenr=Len(r)
Do While st<>0
Dim As String l=Mid(s,1,st-1)
Dim As String ri=Mid(s,st+lenf)
s=l+r+ri
st=InStr(st+lenf+lenr-1,s,f)
Loop
End Sub
sub splitString(ByRef s As String,l As Integer,arr() As String)
Dim As Integer parts=Len(s)/l
'if float s/l > integer s/l then parts++
If (Cast(Single,Len(s))/Cast(Single,l))>Cast(Single,parts) Then parts+=1
ReDim As String arr(0 To parts-1)
Dim As Integer ind=0
For i As Integer=1 To l*parts Step l
arr(ind)=Mid(s,i,l)
ind+=1
Next
End Sub
Sub translate(ByRef i As String,ByRef translated As string)
Dim As Integer s=InStr(i,"<%")
Dim As String arr()
Do While s<>0
Dim As String lhtml=Mid(i,1,s-1)
splitString(lhtml,100,arr())
For ind As Integer=LBound(arr) To UBound(arr)
Dim As String chunk=arr(ind)
replaceString(chunk,"\","\\") ' \ to \\
replaceString(chunk,!"\"",!"\\\"")' " to \"
replaceString(chunk,!"\r","\r")' cr to \r
replaceString(chunk,!"\n","\n")' lf to \n
translated+=!"response+=!\""+chunk+!"\"\r\n"
Next
Dim As Integer e=InStr(i,"%>")
If Mid(i,s+2,1)="=" Then
'if <%=
Dim As String inside=Mid(i,s+3,e-(s+3)) 'inside <%= and %>
replaceString(inside,!"\r","")' remove cr
replaceString(inside,!"\n","")' remove lf
translated+="response+=str("+inside+!")\r\n"
Else
'<%
translated+=Mid(i,s+2,e-(s+2))+!"\r\n"
EndIf
i=Mid(i,e+2)
s=InStr(i,"<%")
Loop
splitString(i,100,arr())
For ind As Integer=LBound(arr) To UBound(arr)
Dim As String chunk=arr(ind)
replaceString(chunk,"\","\\") ' \ to \\
replaceString(chunk,!"\"",!"\\\"")' " to \"
replaceString(chunk,!"\r","\r")' cr to \r
replaceString(chunk,!"\n","\n")' lf to \n
translated+=!"response+=!\""+chunk+!"\"\r\n"
Next
End Sub
Sub startTranslate(ByRef translated As string)
translated+=!"Function entry cdecl alias \"entry\" () As String export\r\n"
translated+=!"Dim As String response=\"\"\r\n"
translate(Input(Lof(1),1),translated)
translated+=!"Return response\r\n"
translated+=!"End Function\r\n"
End Sub
Sub main()
Print "Basic Hypertext Preprocessor build:"+__DATE__+" "+__TIME__
Print "Copyright(c) 2007 Lung Wing Kiu"
Dim As String filename=Command(1)
If Open( filename For Binary Access Read Shared As 1 ) = 0 Then
Print "processing:"+filename
Dim As String translated=""
startTranslate(translated)
Print "translated:"
Print translated
filename+=".bas"
Open filename For Output As #2
put #2,,translated
Close #2
Close #1
shell !"FreeBASIC\\fbc.exe -mt -dll \""+filename+!"\">out.txt"
Open "out.txt" For Input As #3
Dim As String compileResult
compileResult=Input(Lof(3),3)
Close #3
Kill filename
Print compileResult
Print "Done!"
Else
Print "Error reading file:"+filename+"."
EndIf
End Sub
main()
webserver.bas compile to exe
Code: Select all
'Simple Web Server, (c) Anselme Dewavrin 2006 - dewavrin@yahoo.com
'Feel free to use it, provided you mention my name.
'based on the example provided with freebasic.
'edited to run with BHP by fishhf
'Option Explicit
#include once "windows.bi"
#Include Once "file.bi"
#Include once "win/winsock2.bi"
#Include once "win/shellapi.bi"
Const WM_SHELLNOTIFY = WM_USER + 5
Const ID_RUN = 1001
Const ID_PAUSE = 1002
Const ID_EXIT = 1003
Const SERVER_ADDR = "localhost"
Const HOMEDIR = "."
Const DEFAULT_PORT = 8080
Const SERVER_BUFFSIZE = 576
Dim Shared note As NOTIFYICONDATA
Dim Shared TB_CREATED As Integer
Dim Shared szAppName As String
Dim Shared As Integer ServerPort = DEFAULT_PORT
'---
Type CLIENT
socket As SOCKET
ip As Integer
port As Integer
recvthread As Integer
prev As CLIENT Ptr
Next As CLIENT Ptr
End Type
Type SERVERCTX
socket As SOCKET
acceptthread As Integer
isrunning As Integer
globmutex As Integer
filemutex As Integer
clientlisthead As CLIENT Ptr
End Type
Dim Shared ctx As SERVERCTX
'multithreaded socket handling
'':::::
Sub serverDel( Byval client As CLIENT Ptr )
Dim s As SOCKET
'' not already removed?
If( client->socket <> NULL ) Then
s = NULL
Swap s, client->socket ' this should be atomic..
'' close connection
shutdown( s, 2 )
closesocket( s )
'' recv thread stills running?
If( client->recvthread <> NULL ) Then
threadwait( client->recvthread )
End If
'' remove from list
If( client->next ) Then
client->next->prev = client->prev
End If
If( client->prev ) Then
client->prev->next = client->next
Else
ctx.clientlisthead = client->next
End If
End If
End Sub
'':::::
Function serverEnd( ) As Integer
Dim client As CLIENT Ptr
ctx.isrunning = FALSE
'' close the listening socket
If( ctx.socket <> 0 ) Then
shutdown(ctx.socket, 2 )
closesocket( ctx.socket )
ctx.socket = 0
End If
'' remove all clients yet running
Dim i As Integer
Do
client = ctx.clientlisthead
If( client = NULL ) Then
Exit Do
End If
serverDel( client )
Loop
'' shutdown winsock
Function = WSACleanup( )
End Function
Sub replaceString(ByRef s As String,f As String,r As string)
Dim As Integer st=InStr(s,f)
Dim As Integer lenf=Len(f)
Dim As Integer lenr=Len(r)
Do While st<>0
Dim As String l=Mid(s,1,st-1)
Dim As String ri=Mid(s,st+lenf)
s=l+r+ri
st=InStr(st+lenf+lenr-1,s,f)
Loop
End Sub
'thread waiting for data to arrive, parsing HTTP GET requests and sending responses
Sub serverReceive( Byval client As CLIENT Ptr )
Dim PacketBuffer(SERVER_BUFFSIZE) As Byte
Dim As Integer ReceivedLen = 0
Dim As Byte Ptr ReceivedBuffer = 0
Dim As String stNL = Chr(13) & Chr(10)
Dim As String stNLNL = stNL & stNL
Dim FileBuffer() As Byte 'fix for fb0.16beta, thx v1ctor
Dim SendBuffer() As Byte 'fix for fb0.16beta, thx v1ctor
Dim FileHandle As Ubyte
'receive loop
Do While( ctx.isrunning And (client->socket <> NULL) )
' block until some data
Dim bytes As Integer
bytes = recv( client->socket, @PacketBuffer(0), SERVER_BUFFSIZE, 0 )
' connection closed?
If( bytes <= 0 ) Then
Exit Do
End If
' accumulate received data
ReceivedBuffer = reallocate(ReceivedBuffer, bytes + ReceivedLen)
Dim i As Integer
For i=0 To bytes-1
ReceivedBuffer[ReceivedLen+i] = PacketBuffer(i)
Next i
ReceivedLen += bytes
Dim As String strecv=""
For i = 0 To ReceivedLen-1
strecv+=Chr(ReceivedBuffer[i])
Next
Print strecv
'CRLF found twice ?
If (ReceivedLen >= 4) And _
(ReceivedBuffer[ReceivedLen-4] = 13) And _
(ReceivedBuffer[ReceivedLen-3] = 10) And _
(ReceivedBuffer[ReceivedLen-2] = 13) And _
(ReceivedBuffer[ReceivedLen-1] = 10) Then
'extract get path + url decoding (special chars are coded %XY)
Dim As String stPath = HOMEDIR
Dim As Integer iAcc = 0, iHex = 0
For i = 4 To ReceivedLen-1
Dim c As Byte
c = ReceivedBuffer[i]
If c = Asc(" ") Then Exit For
If iHex <> 0 Then
iHex += 1 'decode hex code
iAcc *= 16
iAcc += (c-48)
If iHex = 3 Then
c = iAcc
iAcc = 0
iHex = 0
Endif
Endif
If c=Asc("%") Then 'hex code coming ?
iHex = 1
iAcc = 0
Endif
If iHex = 0 Then stPath += Chr(c)
Next i
If (stPath = HOMEDIR + "/") Or _ 'default page and
(Instr(stPath,"..") <> 0) Then 'restrict to wwwroot
stPath = HOMEDIR + "/index.html"
End If
'get rid of received data
ReceivedLen = 0
Deallocate(ReceivedBuffer)
'prepare response
Dim As String stReponseHeader
Dim As Integer FileLength = 0
'read requested file from disk (no mutex, thanx to Zerospeed)
If dir(stPath) = "" Then
stReponseHeader = "HTTP/1.1 404 Not Found" & stNL & stNL
stReponseHeader += "HTTP/1.1 404 Not Found"
Else
FileHandle = Freefile
If Open( stPath For Binary Access Read Shared As #FileHandle ) <> 0 Then
stReponseHeader = "HTTP/1.1 403 Forbbiden" & stNL & stNL
stReponseHeader += "HTTP/1.1 403 Forbbiden"
Else
If Right(stpath,4)=".bhp" Or Right(stpath,4)=".jsp" Then
Close #FileHandle
Dim As HMODULE hmod=LoadLibrary(stpath+".dll")
Dim As Boolean compileError=false
If hmod=0 Then
'library doesn't exist, so compile it
Shell !"bhp \""+stpath+!"\""
compileError=FileLen("out.txt")<>0
If Not compileError Then hmod=LoadLibrary(stpath+".dll")
EndIf
If hmod<>0 Then 'if hmod is library
Dim As Function Cdecl () As String entry
entry=Cast(Function Cdecl () As String,GetProcAddress(hmod,"entry"))
Dim As String htmlresult=entry()
FreeLibrary(hmod)
FileLength=Len(htmlresult)
Dim FileBuffer(FileLength) As Byte
For i As Integer=1 To FileLength
FileBuffer(i-1)=Asc(htmlresult,i)
Next
Else 'else hmod is not valid
If compileError then
'compile error
Dim As String htmlresult="<html><body>Compile error!<br><br>"
Open "out.txt" For Input As #2
htmlresult+=Input(Lof(2),2)
Close #2
replaceString(htmlresult,!"\n","<br>")
htmlresult+="</body></html>"
FileLength=Len(htmlresult)
Dim FileBuffer(FileLength) As Byte
For i As Integer=1 To FileLength
FileBuffer(i-1)=Asc(htmlresult,i)
Next
End If
End if
Kill("out.txt")
Else 'else request is not bhp
FileLength = Lof(FileHandle) 'file len
If FileLength <> 0 Then
Dim FileBuffer(FileLength) As Byte
Get #FileHandle, , FileBuffer()
End If
Close #FileHandle
EndIf
stReponseHeader = "HTTP/1.1 200 OK" & stNL
stReponseHeader += "Cache-Control: private" & stNL
stReponseHeader += "Content-Type: text/html" & stNL
stReponseHeader += "content-length : " & Str(FileLength) & stNL & stNL
End If
End If
'copy response header to sendbuffer
Dim HeaderLength As Integer
HeaderLength = Len(stReponseHeader)
Dim As Integer SendBufferLen = HeaderLength + FileLength
Dim SendBuffer(SendBufferLen) As Byte
'copy loop (thx v1ctor for this simplified version)
For i = 0 To HeaderLength-1
SendBuffer(i) = stReponseHeader[i]
Next i
'copy response data to sendbuffer
If FileLength <> 0 Then
For i = 0 To FileLength-1
SendBuffer(i+HeaderLength) = FileBuffer(i)
Next i
End If
'send response
Dim As Byte Ptr sendptr
sendptr = @sendBuffer(0)
Do While (ctx.isrunning And (client->socket <> NULL) And (SendBufferLen > 0))
' loop until the whole buffer is sent
bytes = send( client->socket, sendptr, SendBufferLen, 0 )
'' connection closed?
If( bytes <= 0 ) Then
Exit Do
End If
sendptr += bytes
SendBufferLen -= bytes
Loop 'send loop
' remove client
client->recvthread = NULL
serverDel( client )
End If 'bFound
Loop 'receive loop
' remove client
client->recvthread = NULL
serverDel( client )
End Sub
Sub serverAccept( Byval unused As Integer )
Dim sa As sockaddr_in
Dim s As SOCKET
Do While( ctx.isrunning )
Dim salen As Integer
salen = Len( sockaddr_in )
s = accept( ctx.socket, cptr( PSOCKADDR, @sa ), @salen )
If( s = INVALID_SOCKET ) Then
Exit Do
End If
Dim client As CLIENT Ptr
'' access global data, lock it
mutexlock( ctx.globmutex )
'' allocate node
client = allocate( Len( CLIENT ) )
'' add to head of list
client->next = ctx.clientlisthead
ctx.clientlisthead = client
If client->next Then client->next->prev = client
client->prev = NULL
mutexunlock( ctx.globmutex )
'' setup the client
client->socket = s
client->ip = (@sa)->sin_addr.S_addr
client->port = (@sa)->sin_port
'' start new recv and send threads
client->recvthread = threadcreate( @serverReceive, Cint( client ) )
Loop
ctx.isrunning = FALSE
End Sub
Function serverRun( ) As Integer
' start winsock
Dim wsaData As WSAData
If( WSAStartup( MAKEWORD( 2, 0 ), @wsaData ) <> 0 ) Then
'print "error calling WSAStartup: "; WSAGetLastError( )
Return FALSE
End If
If( wsaData.wVersion <> MAKEWORD( 2, 0 ) ) Then
WSACleanup( )
Return FALSE
End If
' create a socket for listening
ctx.socket = opensocket( AF_INET, SOCK_STREAM, IPPROTO_TCP )
If( ctx.socket = NULL ) Then
'print "error calling opensocket: "; WSAGetLastError( )
Return FALSE
End If
' bind it to the server port
Dim sa As sockaddr_in
sa.sin_port = htons( ServerPort )
sa.sin_family = AF_INET
sa.sin_addr.S_addr = INADDR_ANY
If(bind( ctx.socket, cptr( PSOCKADDR, @sa ), Len( sa ) ) = SOCKET_ERROR ) Then
'print "error calling bind: "; WSAGetLastError( )
Return FALSE
End If
If( listen( ctx.socket, SOMAXCONN ) = SOCKET_ERROR ) Then
Return FALSE
End If
ctx.clientlisthead = NULL
ctx.isrunning = TRUE
ctx.globmutex = mutexcreate( )
ctx.filemutex = mutexcreate( )
ctx.acceptthread = threadcreate( @serverAccept ) 'launch accept thread
Function = TRUE
End Function
'----------- TRAY ICON HANDLING --------------
Function WndProc ( Byval hWnd As HWND, Byval message As UINT, Byval wParam As WPARAM, Byval lParam As LPARAM ) As LRESULT
Static pt As Point
Function = 0
Select Case (message)
Case WM_CREATE
TB_CREATED = RegisterWindowMessage ("TaskbarCreated")
Exit Function
Case WM_DESTROY
UnregisterClass (szAppName, GetModuleHandle( null ))
Shell_NotifyIcon (NIM_DELETE, @note)
PostQuitMessage( 0 )
Exit Function
Case WM_COMMAND
If LOWORD (wParam)= ID_RUN Then
If ctx.isrunning = FALSE Then serverRun( ) 'Listenning on 80
End If
If LOWORD (wParam)= ID_PAUSE Then
If ctx.isrunning = TRUE Then serverEnd( ) 'pause
End If
If LOWORD (wParam) = ID_EXIT Then
DestroyWindow (hWnd)
End If
Case WM_SHELLNOTIFY
If (lParam = WM_RBUTTONDOWN) Or (lParam = WM_LBUTTONDOWN) Then
GetCursorPos (@pt)
SetForegroundWindow (hWnd)
Dim MainMenu As HANDLE
Dim FileMenu As HANDLE
MainMenu = CreateMenu ()
FileMenu = CreateMenu ()
If ctx.isrunning = TRUE Then
AppendMenu (FileMenu, MF_STRING Or MF_CHECKED Or MF_GRAYED, ID_RUN, "&Run")
AppendMenu (FileMenu, MF_STRING, ID_PAUSE, "&Pause")
Else
AppendMenu (FileMenu, MF_STRING, ID_RUN, "&Run")
AppendMenu (FileMenu, MF_STRING Or MF_CHECKED Or MF_GRAYED, ID_PAUSE, "&Pause")
End If
AppendMenu (FileMenu, MF_STRING, ID_EXIT, "E&xit")
InsertMenu (MainMenu, 0, MF_POPUP, cuint(FileMenu), "invisible menu")
TrackPopupMenuEx (FileMenu, TPM_LEFTALIGN Or TPM_RIGHTBUTTON, pt.x, pt.y, hWnd, NULL)
PostMessage (hWnd, WM_NULL, 0, 0)
End If
Case TB_CREATED
Shell_NotifyIcon (NIM_ADD, @note)
End Select
Function = DefWindowProc( hWnd, message, wParam, lParam )
End Function
'---------------- SIMILI-WINMAIN ----------------
Dim hInstance As HINSTANCE
hInstance = GetModuleHandle( null )
If Command$ <> "" Then
ServerPort = Val(Command$)
Endif
If( FALSE = serverRun( ) ) Then End
Dim wMsg As MSG
Dim wcls As WNDCLASS
Dim hWnd As HWND
szAppName = "SWS"
'already running ?
hWnd=FindWindow(szAppName,NULL)
If hWnd <> 0 Then
End
end If
With wcls
.style = CS_HREDRAW Or CS_VREDRAW
.lpfnWndProc = @WndProc
.cbClsExtra = 0
.cbWndExtra = 0
.hInstance = hInstance
.hIcon = LoadIcon (hInstance, MAKEINTRESOURCE (1))
.hCursor = LoadCursor( NULL, IDC_ARROW )
.hbrBackground = GetStockObject( WHITE_BRUSH )
.lpszMenuName = NULL
.lpszClassName = Strptr( szAppName )
End With
If( RegisterClass( @wcls ) = FALSE ) Then
End
end If
'' Create the window and _BUT DONT_ show it
hWnd = CreateWindowEx( 0, szAppName, "", 0, 0, 0, 0, 0, NULL, NULL, hInstance, NULL )
note.cbSize = sizeof (NOTIFYICONDATA)
note.hWnd = hWnd
note.hIcon = 0'LoadIcon (hInstance, MAKEINTRESOURCE (1))
note.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
note.uCallbackMessage = WM_SHELLNOTIFY
note.szTip= szAppName
Shell_NotifyIcon (NIM_ADD, @note)
Print "Listening on port "+Str(DEFAULT_PORT)
Print "Webserver initialized!"
'wait for quit message
While GetMessage( @wMsg, NULL, 0, 0 ) <> FALSE
TranslateMessage( @wMsg )
DispatchMessage( @wMsg )
Wend
'eventually stop server
If ctx.isrunning = TRUE Then
serverEnd( )
End If
test.bhp put it with the exes
Code: Select all
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
<title>Untitled Document</title>
<style type="text/css">
<!--
.table {
border: 1px solid #0033FF;
}
.style1 {border: 1px solid #0033FF; color: #0000FF; }
-->
</style>
</head>
<body>
<table width="32%" class="table">
<tr>
<td class="style1">name</td>
<% randomize timer
dim as integer upper=rnd()*1000 %>
<td class="style1">number 1 to <%=upper%></td>
</tr>
<% for i as integer=1 to upper %>
<tr>
<td class="style1">apple<%=i%></td>
<td class="style1"><%=i%></td>
</tr>
<% next %>
</table>
<form action="test.jsp" method="post" enctype="multipart/form-data" name="form1" id="form1">
name
<input name="name" type="text" id="name" />
<br />
<input type="submit" name="Submit" value="Submit" />
</form>
<p> </p>
<p> </p>
<p> </p>
</body>
</html>