| View previous topic :: View next topic |
| Author |
Message |
CryptoMan
Status: Offline
Joined: 07 May 2005
Posts: 8
|
 Posted: Sat Dec 23, 2006 6:29 pm Post subject: Liberty Basic Dynamic Web Server |
 |
|
A small Xmas gift for those interested in a Liberty Basic Web Server
-CryptoMan
| Code: |
'// CryptoMan Simple HTTP Server
'// ------------------------------------
'// Copyright (c) 2006, Verisoft
'// www.verisoft.com
'// WILL SERVE AT THIS
PORT = 93
'// Verisoft SERVER DATA DEFINITION
Global CRLF$ : CRLF$=chr$(13)+chr$(10)
Global QU$ : QU$=chr$(34)
Global DEBUG : DEBUG=1
Global Version$ : Version$="1.0"
NoMainWin
Call SetButtons
Open "c:\DLL\wsock32" For DLL As #wsock32
Open "c:\DLL\WMLiberty" For DLL As #wmlib
' Create a window.
WindowWidth = 640
WindowHeight = 480
TextEditor #window.te, 0, 0, 630, 400
Open "CryptoMan Web Server "+Version$ For Window As #window
#window, "TrapCLose [s_Close]"
#window.te, "!AutoResize"
#window.te, "!Font Fixedsys 8"
' Now create a socket, bind it to a local port, set some
' network events to trap, and start listening for clients.
Call WinsockInit
Err = 1 ' Assume failure
If WSAStartup(MAKEWORD(2, 2)) = 0 Then
#window.te, "> Winsock initialized."
sockaddr.sinfamily.struct = 2 'AF_INET
sockaddr.sinzero.struct = String$(8, 0)
sockaddr.sinport.struct = htons(PORT)
If sockaddr.sinport.struct <> -1 Then
sockaddr.sinaddr.struct = htonl(0) 'INADDR_ANY=0
If sockaddr.sinaddr.struct <> -1 Then
sock = socket(2, 1, 0) 'AF_INET=2:SOCK_STREAM=1
If sock <> -1 Then
#window.te, "> Socket created >>>"; sock
If bind(sock) = 0 Then
#window.te,"> Port bind successful."
'FD_READ=1:FD_WRITE=2:FD_OOB=4:FD_ACCEPT=8:FD_CONNECT=16:FD_CLOSE=32
If WSAAsyncSelect(sock, HWnd(#window), _WM_USER, 1 Or 2 Or 8 Or 32) <> -1 Then
#window.te,"> Events selected."
If listen(sock, 1) = 0 Then
#window.te,"> Listening for incoming connections."
Err = 0 ' Success!
Callback lpfnCB, SockProc( Long, Long, Long, Long ), Long
rc = SetWMHandler(HWnd(#window), _WM_USER, lpfnCB, 1)
End If
End If
End If
End If
End If
End If
End If
If Err Then
#window.te,"> ERROR: "; GetWSAErrorString$(WSAGetLastError())
If sock <> -1 Then
rc = closesocket(sock)
End If
Else
myip = GetLocalIP()
#window.te,"> Clients connect to ["; InetNtoA$(myip); ":"; PORT; "]"
#window.te,"> or ["; GetHostByAddr$(myip); ":"; PORT; "]"
End If
[s_Wait]
Scan
CallDLL #kernel32, "Sleep", _
100 As Long, _
rc As Void
GoTo [s_Wait]
[s_Close]
If sock <> -1 Then
rc = closesocket(sock)
End If
#window.te,"> Closing"
Call WSACleanup
#window.te,"> Step 1"
#window.te,"> Step 2"
Close #wmlib
#window.te,"> Step 3"
rc=closesocket(sock)
#window.te,"> Step 4"
t1=time$("ms")
#window.te,"> Please wait 2 seconds"
[loopz]
t2=time$("ms")
if (t2-t1)<2000 then [loopz]
Close #wsock32
Close #window
End
'*** Application Procedures ***
Function SockProc( hWnd, uMsg, sock, lParam )
' Callback function to handle a Windows message
' forwarded by WMLiberty. Called when a relevant
' network event occurs.
#window.te,""
#window.te,"Sock Proc "+str$(LOWORD(lParam))
Select Case LOWORD(lParam)
Case 1 'FD_READ
'>>>>>>>
#window.te,"> Message from ";sock
buf$ = Recv$(sock, 8192, 0)
#window.te woBang$(buf$);
Call ProcessMessage buf$,sock
If sock <> -1 Then
rc = closesocket(sock)
End If
Case 2 'FD_WRITE
'TODO
Case 8 'FD_ACCEPT
rc = accept(sock)
#window.te,"> Accepted connection from "; _
InetNtoA$(sockaddr.sinaddr.struct); ":"; _
htons(sockaddr.sinport.struct); "."
Case 32 'FD_CLOSE
' Flush the buffers.
rc = SockProc(hWnd, uMsg, sock, 1) 'force read
#window.te,"> Connection Closed."
End Select
End Function
Sub WinsockInit
' Initializes structs used in Winsock calls.
Struct hostent, _
hname As Long, _
haliases As Long, _
haddrtype As Word, _
hlength As Word, _
haddrlist As Long
Struct sockaddr, _
sinfamily As Short, _
sinport As UShort, _
sinaddr As ULong, _
sinzero As Char[8]
Struct WSAData, _
wVersion As Word, _
wHighVersion As Word, _
szDescription As Char[257], _
szSystemStatus As Char[129], _
iMaxSockets As Word, _
iMaxUdpDg As Word, _
lpVendorInfo As Long
End Sub
Function woBang$( raw$ )
' Kludge to print a string that could start with an
' exclamation point, or bang (!). Am I missing something?
woBang$ = raw$
bangs = 0
While Mid$(raw$, bangs+1, 1) = "!"
bangs = bangs + 1
Wend
If bangs Then
bang$ = Left$(raw$, bangs)
woBang$ = Mid$(raw$, bangs+1)
#window.te,"!Lines ln"
#window.te,"!Line "; ln; " ln$"
#window.te,"!Select "; Len(ln$)+1; " "; ln
#window.te,"!Insert bang$"
#window.te,"!Select 1 1"
End If
End Function
'*** General Procedures ***
Function LOWORD( dw )
LOWORD = (dw And 65535)
End Function
Function MAKEWORD( b1, b2 )
MAKEWORD = b1 Or (256 * b2)
End Function
Function String$( num, ch )
If num > 0 Then
String$ = Chr$(ch)
While Len(String$) < num
String$ = String$ + String$
Wend
String$ = Left$(String$, num)
End If
End Function
'*** Winsock Wrappers ***
Function GetHostByAddr$( addr )
Struct p, addr As ULong
p.addr.struct = addr
CallDLL #wsock32, "gethostbyaddr", _
p As Struct, _
4 As Long, _
2 As Long, _ 'AF_INET=2
phe As Long
If phe Then
helen = Len(hostent.struct)
CallDLL #kernel32, "RtlMoveMemory", _
hostent As Struct, _
phe As ULong, _
helen As Long, _
rc As Void
GetHostByAddr$ = WinString(hostent.hname.struct)
End If
End Function
Function GetHostByName$( sName$ )
CallDLL #wsock32, "gethostbyname", _
sName$ As Ptr, _
phe As ULong
If phe Then
helen = Len(hostent.struct)
CallDLL #kernel32, "RtlMoveMemory", _
hostent As Struct, _
phe As ULong, _
helen As Long, _
rc As Void
GetHostByName$ = WinString(hostent.hname.struct)
End If
End Function
Function GetHostName$()
buf$ = Space$(256)+Chr$(0)
CallDLL #wsock32, "gethostname", _
buf$ As Ptr, _
256 As Long, _
rc As Long
GetHostName$ = Trim$(buf$)
End Function
Function GetLocalIP()
sName$ = GetHostName$()
CallDLL #wsock32, "gethostbyname", _
sName$ As Ptr, _
phe As ULong
If phe Then
helen = Len(hostent.struct)
CallDLL #kernel32, "RtlMoveMemory", _
hostent As Struct, _
phe As ULong, _
helen As Long, _
rc As Void
plong = hostent.haddrlist.struct
Struct p, addrlist As ULong
CallDLL #kernel32, "RtlMoveMemory", _
p As Struct, _
plong As ULong, _
4 As Long, _
rc As Void
plong = p.addrlist.struct
Struct p, addr As ULong
hlength = hostent.hlength.struct
CallDLL #kernel32, "RtlMoveMemory", _
p As Struct, _
plong As ULong, _
hlength As Long, _
rc As Void
GetLocalIP = p.addr.struct
End If
End Function
Function InetNtoA$( inaddr )
CallDLL #wsock32, "inet_ntoa", _
inaddr As ULong, _
pstr As ULong
InetNtoA$ = WinString(pstr)
End Function
Function Recv$( s, buflen, flags )
Recv$ = Space$(buflen)+Chr$(0)
CallDLL #wsock32, "recv", _
s As Long, _
Recv$ As Ptr, _
buflen As Long, _
flags As Long, _
buflen As Long
Recv$ = Left$(Recv$, buflen)
End Function
Function Send$( s, bufs$, buflen, flags )
#window.te,"Send Socket [";s;"][";bufs$;"]"
buflen = Min(Len(bufs$), buflen)
CallDLL #wsock32, "send", _
s As Long, _
bufs$ As Ptr, _
buflen As Long, _
flags As Long, _
buflen As Long
If buflen > 0 Then Send$ = Mid$(bufs$, buflen+1)
End Function
'*** Winsock Thin Wrappers ***
Function accept( s )
Struct p, length As Long
p.length.struct = Len(sockaddr.struct)
CallDLL #wsock32, "accept", _
s As Long, _
sockaddr As Struct, _
p As Struct, _
accept As Long
End Function
Function bind( s )
namelen = Len(sockaddr.struct)
CallDLL #wsock32, "bind", _
s As Long, _
sockaddr As Struct, _
namelen As Long, _
bind As Long
End Function
Function closesocket( s )
CallDLL #wsock32, "closesocket", _
s As Long, _
closesocket As Long
End Function
Function htonl( hostlong )
CallDLL #wsock32, "htonl", _
hostlong As ULong, _
htonl As ULong
End Function
Function htons( hostshort )
CallDLL #wsock32, "htons", _
hostshort As Word, _
htons As Word
End Function
Function inetaddr( cp$ )
CallDLL #wsock32, "inet_addr", _
cp$ As Ptr, _
inetaddr As ULong
End Function
Function listen( s, backlog )
CallDLL #wsock32, "listen", _
s As Long, _
backlog As Long, _
listen As Long
End Function
Function socket( af, type, protocol )
CallDLL #wsock32, "socket", _
af As Long, _
type As Long, _
protocol As Long, _
socket As Long
End Function
Function WSAAsyncSelect( s, hWnd, wMsg, lEvent )
CallDLL #wsock32, "WSAAsyncSelect", _
s As Long, _
hWnd As ULong, _
wMsg As ULong, _
lEvent As Long, _
WSAAsyncSelect As Long
End Function
Sub WSACleanup
CallDLL #wsock32, "WSACleanup", _
r As Void
End Sub
Function WSAGetLastError()
CallDLL #wsock32, "WSAGetLastError", _
WSAGetLastError As Long
End Function
Function WSAStartup( wVersionRequested )
CallDLL #wsock32, "WSAStartup", _
wVersionRequested As Word, _
WSAData As Struct, _
WSAStartup As Long
End Function
'*** WMLiberty Thin Wrappers ***
Function SetWMHandler( hWnd, uMsg, lpfnCB, lSuccess )
CallDLL #wmlib, "SetWMHandler", _
hWnd As Long, _
uMsg As Long, _
lpfnCB As Long, _
lSuccess As Long, _
SetWMHandler As Long
End Function
Sub GetChar handle$, c$
c$ = Inkey$
if len(c$) = 1 then #window.te, "KeyPress [";ASC(c$);"]"
End Sub
Sub Quit handle$
#window.te,"[Quit] Signal Received from Handle ";handle$
Call Sleep 500
#window.te,"> Closing"
Call WSACleanup
#window.te,"> Step 1"
#window.te,"> Step 2"
Close #wmlib
#window.te,"> Step 3"
rc=closesocket(sock)
#window.te,"> Step 4"
t1=time$("ms")
#window.te,"> Please wait 2 seconds"
[loopz]
t2=time$("ms")
if (t2-t1)<2000 then [loopz]
Close #wsock32
Close #window
End
End Sub
Sub Sleep Delay
timer Delay,[standby]
wait
[standby]
timer 0
End Sub
Function TruncateJunk$( t$ )
'Messages must start with STX, whatever remains in comm buffer must be flushed...
TruncateJunk$=""
for i=1 to LEN(t$)
if mid$(t$,i,1)=STX$ then
TruncateJunk$=mid$(t$,i) 'Found STX, copy from here onwards...
exit for
end if
next
End Function
Sub ProcessMessage sMsg$, CallingSocket
#window.te, "-PROCESS BEGIN-"
#window.te,"PROCESS MSG :[";sMsg$;"]"
MessageType$=MID$( sMsg$, BEGMSG, TYPLEN )
SELECT CASE MessageType$
CASE "INDEX"
CASE "XYZ"
CASE "PQR"
CASE ELSE
#window.te,"DEFAULT INDEX:"
CALL SendIndex "INDEX",CallingSocket
END SELECT
#window.te, "-PROCESS END-"
'Select Case
#window.te, "-PROCESS END-"
End Sub
Sub SendIndex Index$,CallingSocket
Message$="HTTP/1.1 200 OK"+CRLF$
Message$=Message$+"Date: Sun, 24 Dec 2006 00:01:59 GMT"+CRLF$
Message$=Message$+"Content-Type: text/html"+CRLF$
Message$=Message$+"Content-Length: 256"+CRLF$
Message$=Message$+"<html>"+CRLF$
Message$=Message$+"<HEAD>"+CRLF$
Message$=Message$+"<TITLE>Liberty Basic Web Server</TITLE>"+CRLF$
Message$=Message$+"</HEAD>"+CRLF$
Message$=Message$+"<body>"+CRLF$
Message$=Message$+"<h1>Liberty Basic 4.03 Web Server Demo</h1>"+CRLF$
Message$=Message$+"This example demonstrates how you can make dynamic servers in pure Liberty Basic<BR>"+CRLF$
Message$=Message$+"Enjoy !<BR>"+CRLF$
Message$=Message$+"CryptoMan<BR><BR><BR><CODE>"+CRLF$
FOR i=1 to 10
Message$=Message$+" [";USING("##",i);"] ";DATE$()+" "+TIME$()+"<BR>"+CRLF$
NEXT i
Message$=Message$+"<h3>You can not only use MySQL and MsSQL from Liberty but can also make Web Servers...</h3>"+CRLF$
Message$=Message$+"<h3>And, you can also connect Dynamic SQL I/O to this Web Server...</h3>"+CRLF$
Message$=Message$+"<h2>Merry Christmas and Happy New Year !</h2>"+CRLF$
Message$=Message$+"</CODE></body>"+CRLF$
Message$=Message$+"</html>"+CRLF$
outbuf$ = Send$(CallingSocket, Message$, len(Message$), 0)
End Sub
Sub SetButtons
button #window.button01, " Button 1 ", Button01Click, UL, 10, WindowHeight+45, 100, 25
button #window.button02, " Button 2 ", Button02Click, UL, 120,WindowHeight+45, 100, 25
button #window.button03, " Button 3 ", Button03Click, UL, 230,WindowHeight+45, 100, 25
button #window.buttonQt, " Quit ", Quit, UL, 340,WindowHeight+45, 100, 25
End Sub
Sub Button01Click handle$
Notice "Button 1 Title"+chr$(13)+"Button 1 Pressed"+chr$(13)+"Do Whatever..."
End Sub
Sub Button02Click handle$
Notice "Button 2 Title"+chr$(13)+"Button 2 Pressed"+chr$(13)+"Do Whatever..."
End Sub
Sub Button03Click handle$
Notice "Button 3 Title"+chr$(13)+"Button 3 Pressed"+chr$(13)+"Do Whatever..."
End Sub
|
|
|
| Back to top |
|
 |
Sponsor
|
|
|
CryptoMan
Status: Offline
Joined: 07 May 2005
Posts: 8
|
| Posted: Sat Dec 23, 2006 7:46 pm Post subject: Dynamic Web Server in Liberty Basic - Much Better ! |
|
|
I have added links and multiple pages...
Enjoy
-- CryptoMan
Last edited by CryptoMan on Sat Dec 23, 2006 7:50 pm; edited 1 time in total |
|
| Back to top |
|
|
CryptoMan
Status: Offline
Joined: 07 May 2005
Posts: 8
|
| Posted: Sat Dec 23, 2006 7:47 pm Post subject: Dynamic Web Server in Liberty Basic - Much Better ! |
|
|
| Code: |
'// CryptoMan Simple HTTP Server
'// ----------------...--------
'// Copyright (c) 2006, Verisoft
'// www.verisoft.com
'// WILL SERVE AT THIS
PORT = 93
'// Verisoft SERVER DATA DEFINITION
Global CRLF$ : CRLF$=chr$(13)+chr$(10)
Global QU$ : QU$=chr$(34)
Global DEBUG : DEBUG=1
Global Version$ : Version$="1.1"
NoMainWin
Call SetButtons
Open "c:\DLL\wsock32" For DLL As #wsock32
Open "c:\DLL\WMLiberty" For DLL As #wmlib
' Create a window.
WindowWidth = 640
WindowHeight = 480
TextEditor #window.te, 0, 0, 630, 400
Open "CryptoMan Web Server "+Version$ For Window As #window
#window, "TrapCLose [s_Close]"
#window.te, "!AutoResize"
#window.te, "!Font Fixedsys 8"
' Now create a socket, bind it to a local port, set some
' network events to trap, and start listening for clients.
Call WinsockInit
Err = 1 ' Assume failure
If WSAStartup(MAKEWORD(2, 2)) = 0 Then
#window.te, "> Winsock initialized."
sockaddr.sinfamily.struct = 2 'AF_INET
sockaddr.sinzero.struct = String$(8, 0)
sockaddr.sinport.struct = htons(PORT)
If sockaddr.sinport.struct <> -1 Then
sockaddr.sinaddr.struct = htonl(0) 'INADDR_ANY=0
If sockaddr.sinaddr.struct <> -1 Then
sock = socket(2, 1, 0) 'AF_INET=2:SOCK_STREAM=1
If sock <> -1 Then
#window.te, "> Socket created >>>"; sock
If bind(sock) = 0 Then
#window.te,"> Port bind successful."
'FD_READ=1:FD_WRITE=2:FD_OOB=4:FD_ACCEPT=8:FD_CONNECT=16:FD_CLOSE=32
If WSAAsyncSelect(sock, HWnd(#window), _WM_USER, 1 Or 2 Or 8 Or 32) <> -1 Then
#window.te,"> Events selected."
If listen(sock, 1) = 0 Then
#window.te,"> Listening for incoming connections."
Err = 0 ' Success!
Callback lpfnCB, SockProc( Long, Long, Long, Long ), Long
rc = SetWMHandler(HWnd(#window), _WM_USER, lpfnCB, 1)
End If
End If
End If
End If
End If
End If
End If
If Err Then
#window.te,"> ERROR: "; GetWSAErrorString$(WSAGetLastError())
If sock <> -1 Then
rc = closesocket(sock)
End If
Else
myip = GetLocalIP()
#window.te,"> Clients connect to ["; InetNtoA$(myip); ":"; PORT; "]"
#window.te,"> or ["; GetHostByAddr$(myip); ":"; PORT; "]"
End If
[s_Wait]
Scan
CallDLL #kernel32, "Sleep", _
100 As Long, _
rc As Void
GoTo [s_Wait]
[s_Close]
If sock <> -1 Then
rc = closesocket(sock)
End If
#window.te,"> Closing"
Call WSACleanup
#window.te,"> Step 1"
#window.te,"> Step 2"
Close #wmlib
#window.te,"> Step 3"
rc=closesocket(sock)
#window.te,"> Step 4"
t1=time$("ms")
#window.te,"> Please wait 2 seconds"
[loopz]
t2=time$("ms")
if (t2-t1)<2000 then [loopz]
Close #wsock32
Close #window
End
'*** Application Procedures ***
Function SockProc( hWnd, uMsg, sock, lParam )
' Callback function to handle a Windows message
' forwarded by WMLiberty. Called when a relevant
' network event occurs.
#window.te,""
#window.te,"Sock Proc "+str$(LOWORD(lParam))
Select Case LOWORD(lParam)
Case 1 'FD_READ
'>>>>>>>
#window.te,"> Message from ";sock
buf$ = Recv$(sock, 8192, 0)
#window.te woBang$(buf$);
Call ProcessMessage buf$,sock
If sock <> -1 Then
rc = closesocket(sock)
End If
Case 2 'FD_WRITE
'TODO
Case 8 'FD_ACCEPT
rc = accept(sock)
#window.te,"> Accepted connection from "; _
InetNtoA$(sockaddr.sinaddr.struct); ":"; _
htons(sockaddr.sinport.struct); "."
Case 32 'FD_CLOSE
' Flush the buffers.
rc = SockProc(hWnd, uMsg, sock, 1) 'force read
#window.te,"> Connection Closed."
End Select
End Function
Sub WinsockInit
' Initializes structs used in Winsock calls.
Struct hostent, _
hname As Long, _
haliases As Long, _
haddrtype As Word, _
hlength As Word, _
haddrlist As Long
Struct sockaddr, _
sinfamily As Short, _
sinport As UShort, _
sinaddr As ULong, _
sinzero As Char[8]
Struct WSAData, _
wVersion As Word, _
wHighVersion As Word, _
szDescription As Char[257], _
szSystemStatus As Char[129], _
iMaxSockets As Word, _
iMaxUdpDg As Word, _
lpVendorInfo As Long
End Sub
Function woBang$( raw$ )
' Kludge to print a string that could start with an
' exclamation point, or bang (!). Am I missing something?
woBang$ = raw$
bangs = 0
While Mid$(raw$, bangs+1, 1) = "!"
bangs = bangs + 1
Wend
If bangs Then
bang$ = Left$(raw$, bangs)
woBang$ = Mid$(raw$, bangs+1)
#window.te,"!Lines ln"
#window.te,"!Line "; ln; " ln$"
#window.te,"!Select "; Len(ln$)+1; " "; ln
#window.te,"!Insert bang$"
#window.te,"!Select 1 1"
End If
End Function
'*** General Procedures ***
Function LOWORD( dw )
LOWORD = (dw And 65535)
End Function
Function MAKEWORD( b1, b2 )
MAKEWORD = b1 Or (256 * b2)
End Function
Function String$( num, ch )
If num > 0 Then
String$ = Chr$(ch)
While Len(String$) < num
String$ = String$ + String$
Wend
String$ = Left$(String$, num)
End If
End Function
'*** Winsock Wrappers ***
Function GetHostByAddr$( addr )
Struct p, addr As ULong
p.addr.struct = addr
CallDLL #wsock32, "gethostbyaddr", _
p As Struct, _
4 As Long, _
2 As Long, _ 'AF_INET=2
phe As Long
If phe Then
helen = Len(hostent.struct)
CallDLL #kernel32, "RtlMoveMemory", _
hostent As Struct, _
phe As ULong, _
helen As Long, _
rc As Void
GetHostByAddr$ = WinString(hostent.hname.struct)
End If
End Function
Function GetHostByName$( sName$ )
CallDLL #wsock32, "gethostbyname", _
sName$ As Ptr, _
phe As ULong
If phe Then
helen = Len(hostent.struct)
CallDLL #kernel32, "RtlMoveMemory", _
hostent As Struct, _
phe As ULong, _
helen As Long, _
rc As Void
GetHostByName$ = WinString(hostent.hname.struct)
End If
End Function
Function GetHostName$()
buf$ = Space$(256)+Chr$(0)
CallDLL #wsock32, "gethostname", _
buf$ As Ptr, _
256 As Long, _
rc As Long
GetHostName$ = Trim$(buf$)
End Function
Function GetLocalIP()
sName$ = GetHostName$()
CallDLL #wsock32, "gethostbyname", _
sName$ As Ptr, _
phe As ULong
If phe Then
helen = Len(hostent.struct)
CallDLL #kernel32, "RtlMoveMemory", _
hostent As Struct, _
phe As ULong, _
helen As Long, _
rc As Void
plong = hostent.haddrlist.struct
Struct p, addrlist As ULong
CallDLL #kernel32, "RtlMoveMemory", _
p As Struct, _
plong As ULong, _
4 As Long, _
rc As Void
plong = p.addrlist.struct
Struct p, addr As ULong
hlength = hostent.hlength.struct
CallDLL #kernel32, "RtlMoveMemory", _
p As Struct, _
plong As ULong, _
hlength As Long, _
rc As Void
GetLocalIP = p.addr.struct
End If
End Function
Function InetNtoA$( inaddr )
CallDLL #wsock32, "inet_ntoa", _
inaddr As ULong, _
pstr As ULong
InetNtoA$ = WinString(pstr)
End Function
Function Recv$( s, buflen, flags )
Recv$ = Space$(buflen)+Chr$(0)
CallDLL #wsock32, "recv", _
s As Long, _
Recv$ As Ptr, _
buflen As Long, _
flags As Long, _
buflen As Long
Recv$ = Left$(Recv$, buflen)
End Function
Function Send$( s, bufs$, buflen, flags )
#window.te,"Send Socket [";s;"][";bufs$;"]"
buflen = Min(Len(bufs$), buflen)
CallDLL #wsock32, "send", _
s As Long, _
bufs$ As Ptr, _
buflen As Long, _
flags As Long, _
buflen As Long
If buflen > 0 Then Send$ = Mid$(bufs$, buflen+1)
End Function
'*** Winsock Thin Wrappers ***
Function accept( s )
Struct p, length As Long
p.length.struct = Len(sockaddr.struct)
CallDLL #wsock32, "accept", _
s As Long, _
sockaddr As Struct, _
p As Struct, _
accept As Long
End Function
Function bind( s )
namelen = Len(sockaddr.struct)
CallDLL #wsock32, "bind", _
s As Long, _
sockaddr As Struct, _
namelen As Long, _
bind As Long
End Function
Function closesocket( s )
CallDLL #wsock32, "closesocket", _
s As Long, _
closesocket As Long
End Function
Function htonl( hostlong )
CallDLL #wsock32, "htonl", _
hostlong As ULong, _
htonl As ULong
End Function
Function htons( hostshort )
CallDLL #wsock32, "htons", _
hostshort As Word, _
htons As Word
End Function
Function inetaddr( cp$ )
CallDLL #wsock32, "inet_addr", _
cp$ As Ptr, _
inetaddr As ULong
End Function
Function listen( s, backlog )
CallDLL #wsock32, "listen", _
s As Long, _
backlog As Long, _
listen As Long
End Function
Function socket( af, type, protocol )
CallDLL #wsock32, "socket", _
af As Long, _
type As Long, _
protocol As Long, _
socket As Long
End Function
Function WSAAsyncSelect( s, hWnd, wMsg, lEvent )
CallDLL #wsock32, "WSAAsyncSelect", _
s As Long, _
hWnd As ULong, _
wMsg As ULong, _
lEvent As Long, _
WSAAsyncSelect As Long
End Function
Sub WSACleanup
CallDLL #wsock32, "WSACleanup", _
r As Void
End Sub
Function WSAGetLastError()
CallDLL #wsock32, "WSAGetLastError", _
WSAGetLastError As Long
End Function
Function WSAStartup( wVersionRequested )
CallDLL #wsock32, "WSAStartup", _
wVersionRequested As Word, _
WSAData As Struct, _
WSAStartup As Long
End Function
'*** WMLiberty Thin Wrappers ***
Function SetWMHandler( hWnd, uMsg, lpfnCB, lSuccess )
CallDLL #wmlib, "SetWMHandler", _
hWnd As Long, _
uMsg As Long, _
lpfnCB As Long, _
lSuccess As Long, _
SetWMHandler As Long
End Function
Sub GetChar handle$, c$
c$ = Inkey$
if len(c$) = 1 then #window.te, "KeyPress [";ASC(c$);"]"
End Sub
Sub Quit handle$
#window.te,"[Quit] Signal Received from Handle ";handle$
Call Sleep 500
#window.te,"> Closing"
Call WSACleanup
#window.te,"> Step 1"
#window.te,"> Step 2"
Close #wmlib
#window.te,"> Step 3"
rc=closesocket(sock)
#window.te,"> Step 4"
t1=time$("ms")
#window.te,"> Please wait 2 seconds"
[loopz]
t2=time$("ms")
if (t2-t1)<2000 then [loopz]
Close #wsock32
Close #window
End
End Sub
Sub Sleep Delay
timer Delay,[standby]
wait
[standby]
timer 0
End Sub
Function TruncateJunk$( t$ )
'Messages must start with STX, whatever remains in comm buffer must be flushed...
TruncateJunk$=""
for i=1 to LEN(t$)
if mid$(t$,i,1)=STX$ then
TruncateJunk$=mid$(t$,i) 'Found STX, copy from here onwards...
exit for
end if
next
End Function
Sub ProcessMessage sMsg$, CallingSocket
#window.te, "-PROCESS BEGIN-"
#window.te,"PROCESS MSG :[";sMsg$;"]"
MessageType$=TRIM$( LEFT$(sMsg$,INSTR(sMsg$,"HTTP")-1 ))
#window.te,">>>>> SELECT COMMAND :[";MessageType$;"]"
SELECT CASE MessageType$
CASE "GET /"
#window.te,"ROOT PAGE:"
CALL SendIndex "INDEX",CallingSocket
CASE "GET /INDEX.HTM"
#window.te,"HOME PAGE:"
CALL SendIndex "INDEX",CallingSocket
CASE "GET /CHAP1.HTM"
#window.te,"CHAPTER 1:"
CALL SendChap1 "CHAP1",CallingSocket
CASE "GET /CHAP2.HTM"
#window.te,"CHAPTER 2:"
CALL SendChap2 "CHAP2",CallingSocket
CASE "PQR"
CASE ELSE
#window.te,"DEFAULT INDEX:"
CALL SendIndex "INDEX",CallingSocket
END SELECT
#window.te, "-PROCESS END-"
'Select Case
#window.te, "-PROCESS END-"
End Sub
Sub SendIndex Index$,CallingSocket
Message$="HTTP/1.1 200 OK"+CRLF$
Message$=Message$+"Date: Sun, 24 Dec 2006 00:01:59 GMT"+CRLF$
Message$=Message$+"Content-Type: text/html"+CRLF$
Message$=Message$+"Content-Length: 256"+CRLF$
Message$=Message$+"<html>"+CRLF$
Message$=Message$+"<HEAD>"+CRLF$
Message$=Message$+"<TITLE>Liberty Basic Web Server</TITLE>"+CRLF$
Message$=Message$+"</HEAD>"+CRLF$
Message$=Message$+"<body>"+CRLF$
Message$=Message$+"<h1>Liberty Basic 4.03 Web Server Demo</h1>"+CRLF$
Message$=Message$+"This example demonstrates how you can make dynamic servers in pure Liberty Basic<BR>"+CRLF$
Message$=Message$+"Enjoy !<BR>"+CRLF$
Message$=Message$+"CryptoMan<BR><BR><BR><CODE>"+CRLF$
FOR i=1 to 3
'Message$=Message$+"<P><font size=";i;">"
Message$=Message$+" [";USING("##",i);"] ";DATE$()+" "+TIME$()+"<BR>"+CRLF$
Message$=Message$+"</font>"
NEXT i
Message$=Message$+"<h3>You can not only use MySQL and MsSQL from Liberty but can also make Web Servers...</h3>"+CRLF$
Message$=Message$+"<h3>And, you can also connect Dynamic SQL I/O to this Web Server...</h3>"+CRLF$
Message$=Message$+"</CODE>"
Message$=Message$+"<P><A href="+QU$+"http://localhost:93/CHAP1.HTM"+QU$+">What is Liberty Basic ?</A>"+CRLF$
Message$=Message$+"<P><A href="+QU$+"http://localhost:93/CHAP2.HTM"+QU$+">Can you use MySQL with Liberty Basic ?</A>"+CRLF$
Message$=Message$+"<h2>Merry Christmas and Happy New Year !</h2>"+CRLF$
Message$=Message$+"</body>"+CRLF$
Message$=Message$+"</html>"+CRLF$
outbuf$ = Send$(CallingSocket, Message$, len(Message$), 0)
End Sub
Sub SendChap1 Index$,CallingSocket
Message$="HTTP/1.1 200 OK"+CRLF$
Message$=Message$+"Date: Sun, 24 Dec 2006 00:01:59 GMT"+CRLF$
Message$=Message$+"Content-Type: text/html"+CRLF$
Message$=Message$+"Content-Length: 256"+CRLF$
Message$=Message$+"<html>"+CRLF$
Message$=Message$+"<HEAD>"+CRLF$
Message$=Message$+"<TITLE>Chapter 1</TITLE>"+CRLF$
Message$=Message$+"</HEAD>"+CRLF$
Message$=Message$+"<body>"+CRLF$
Message$=Message$+"<h1>What is Liberty Basic ?</h1>"+CRLF$
Message$=Message$+"<h3>Greatest programming language in the world...</h3><BR>"+CRLF$
Message$=Message$+"Enjoy !<BR>"+CRLF$
Message$=Message$+"CryptoMan<BR><BR><BR><CODE>"+CRLF$
Message$=Message$+"</CODE>"
Message$=Message$+"<P><A href="+QU$+"http://localhost:93/INDEX.HTM"+QU$+">Main Page</A>"+CRLF$
Message$=Message$+"<h2>Merry Christmas and Happy New Year !</h2>"+CRLF$
Message$=Message$+"</body>"+CRLF$
Message$=Message$+"</html>"+CRLF$
outbuf$ = Send$(CallingSocket, Message$, len(Message$), 0)
End Sub
Sub SendChap2 Index$,CallingSocket
Message$="HTTP/1.1 200 OK"+CRLF$
Message$=Message$+"Date: Sun, 24 Dec 2006 00:01:59 GMT"+CRLF$
Message$=Message$+"Content-Type: text/html"+CRLF$
Message$=Message$+"Content-Length: 256"+CRLF$
Message$=Message$+"<html>"+CRLF$
Message$=Message$+"<HEAD>"+CRLF$
Message$=Message$+"<TITLE>Chapter 2</TITLE>"+CRLF$
Message$=Message$+"</HEAD>"+CRLF$
Message$=Message$+"<body>"+CRLF$
Message$=Message$+"<h1>Can you use MySQL with Liberty Basic ?</h1>"+CRLF$
Message$=Message$+"<h3>Ofcourse you can !</h3><BR>"+CRLF$
Message$=Message$+"Enjoy !<BR>"+CRLF$
Message$=Message$+"CryptoMan<BR><BR><BR><CODE>"+CRLF$
Message$=Message$+"</CODE>"
Message$=Message$+"<P><A href="+QU$+"http://localhost:93/INDEX.HTM"+QU$+">Main Page</A>"+CRLF$
Message$=Message$+"<h2>Merry Christmas and Happy New Year !</h2>"+CRLF$
Message$=Message$+"</body>"+CRLF$
Message$=Message$+"</html>"+CRLF$
outbuf$ = Send$(CallingSocket, Message$, len(Message$), 0)
End Sub
Sub SetButtons
button #window.button01, " Button 1 ", Button01Click, UL, 10, WindowHeight+45, 100, 25
button #window.button02, " Button 2 ", Button02Click, UL, 120,WindowHeight+45, 100, 25
button #window.button03, " Button 3 ", Button03Click, UL, 230,WindowHeight+45, 100, 25
button #window.buttonQt, " Quit ", Quit, UL, 340,WindowHeight+45, 100, 25
End Sub
Sub Button01Click handle$
Notice "Button 1 Title"+chr$(13)+"Button 1 Pressed"+chr$(13)+"Do Whatever..."
End Sub
Sub Button02Click handle$
Notice "Button 2 Title"+chr$(13)+"Button 2 Pressed"+chr$(13)+"Do Whatever..."
End Sub
Sub Button03Click handle$
Notice "Button 3 Title"+chr$(13)+"Button 3 Pressed"+chr$(13)+"Do Whatever..."
End Sub
|
|
|
| Back to top |
|
|
CryptoMan
Status: Offline
Joined: 07 May 2005
Posts: 8
|
| Posted: Mon Dec 25, 2006 4:43 pm Post subject: |
|
|
Version 1.2 : Demonstrates data entry with forms
| Code: |
'// CryptoMan Simple HTTP Server
'// -----------------------------------------------------------------------------------------------
'// Copyright (c) 2006,2007 Verisoft
'// All rights reserved. Personal educational use only.
'// It may not be used commercially without express written consent from VERISOFT.
'// Please contact info@verisoft.com for permissions and licensing conditions.
'// www.verisoft.com
'// Requires WMLiberty.DLL from Brent Thorn
'// WILL SERVE AT THIS
PORT = 93
'// Verisoft SERVER DATA DEFINITION
Global CRLF$ : CRLF$=chr$(13)+chr$(10)
Global QU$ : QU$=chr$(34)
Global DEBUG : DEBUG=1
Global Version$ : Version$="1.2"
NoMainWin
Call SetButtons
Open "c:\DLL\wsock32" For DLL As #wsock32
Open "c:\DLL\WMLiberty" For DLL As #wmlib
' Create a window.
WindowWidth = 640
WindowHeight = 480
TextEditor #window.te, 0, 0, 630, 400
Open "CryptoMan Web Server "+Version$ For Window As #window
#window, "TrapCLose [s_Close]"
#window.te, "!AutoResize"
#window.te, "!Font Fixedsys 8"
#window.te,"CryptoMan Simple HTTP Server "
#window.te,"-------------------------------------------------------------------------------------------"
#window.te,"Copyright (c) 2006,2007 Verisoft "
#window.te,"All rights reserved. Personal educational use only. "
#window.te,"It may not be used commercially without express written consent from VERISOFT. "
#window.te,"Please contact info@verisoft.com for permissions and licensing conditions. "
#window.te," www.verisoft.com "
#window.te,"Requires WMLiberty.DLL from Brent Thorn "
#window.te,"Credit and thanks to Brent Thorn for WMLiberty.DLL and his excellent TELNET SERVER example."
#window.te,""
' Now create a socket, bind it to a local port, set some
' network events to trap, and start listening for clients.
Call WinsockInit
Err = 1 ' Assume failure
If WSAStartup(MAKEWORD(2, 2)) = 0 Then
#window.te, "> Winsock initialized."
sockaddr.sinfamily.struct = 2 'AF_INET
sockaddr.sinzero.struct = String$(8, 0)
sockaddr.sinport.struct = htons(PORT)
If sockaddr.sinport.struct <> -1 Then
sockaddr.sinaddr.struct = htonl(0) 'INADDR_ANY=0
If sockaddr.sinaddr.struct <> -1 Then
sock = socket(2, 1, 0) 'AF_INET=2:SOCK_STREAM=1
If sock <> -1 Then
#window.te, "> Socket created >>>"; sock
If bind(sock) = 0 Then
#window.te,"> Port bind successful."
'FD_READ=1:FD_WRITE=2:FD_OOB=4:FD_ACCEPT=8:FD_CONNECT=16:FD_CLOSE=32
If WSAAsyncSelect(sock, HWnd(#window), _WM_USER, 1 Or 2 Or 8 Or 32) <> -1 Then
#window.te,"> Events selected."
If listen(sock, 1) = 0 Then
#window.te,"> Listening for incoming connections."
Err = 0 ' Success!
Callback lpfnCB, SockProc( Long, Long, Long, Long ), Long
rc = SetWMHandler(HWnd(#window), _WM_USER, lpfnCB, 1)
End If
End If
End If
End If
End If
End If
End If
If Err Then
#window.te,"> ERROR: "; GetWSAErrorString$(WSAGetLastError())
If sock <> -1 Then
rc = closesocket(sock)
End If
Else
myip = GetLocalIP()
#window.te,"> Clients connect to ["; InetNtoA$(myip); ":"; PORT; "]"
#window.te,"> or ["; GetHostByAddr$(myip); ":"; PORT; "]"
End If
[s_Wait]
Scan
CallDLL #kernel32, "Sleep", _
100 As Long, _
rc As Void
GoTo [s_Wait]
[s_Close]
If sock <> -1 Then
rc = closesocket(sock)
End If
#window.te,"> Closing"
Call WSACleanup
#window.te,"> Step 1"
#window.te,"> Step 2"
Close #wmlib
#window.te,"> Step 3"
rc=closesocket(sock)
#window.te,"> Step 4"
t1=time$("ms")
#window.te,"> Please wait 2 seconds"
[loopz]
t2=time$("ms")
if (t2-t1)<2000 then [loopz]
Close #wsock32
Close #window
End
'*** Application Procedures ***
Function SockProc( hWnd, uMsg, sock, lParam )
' Callback function to handle a Windows message
' forwarded by WMLiberty. Called when a relevant
' network event occurs.
#window.te,""
#window.te,"Sock Proc "+str$(LOWORD(lParam))
Select Case LOWORD(lParam)
Case 1 'FD_READ
'>>>>>>>
#window.te,"> Message from ";sock
buf$ = Recv$(sock, 8192, 0)
#window.te woBang$(buf$);
Call ProcessMessage buf$,sock
If sock <> -1 Then
rc = closesocket(sock)
End If
Case 2 'FD_WRITE
'TODO
Case 8 'FD_ACCEPT
rc = accept(sock)
#window.te,"> Accepted connection from "; _
InetNtoA$(sockaddr.sinaddr.struct); ":"; _
htons(sockaddr.sinport.struct); "."
Case 32 'FD_CLOSE
' Flush the buffers.
rc = SockProc(hWnd, uMsg, sock, 1) 'force read
#window.te,"> Connection Closed."
End Select
End Function
Function GetWSAErrorString$( errnum )
Select Case errnum
Case 10004: e$ = "Interrupted system call."
Case 10009: e$ = "Bad file number."
Case 10013: e$ = "Permission Denied."
Case 10014: e$ = "Bad Address."
Case 10022: e$ = "Invalid Argument."
Case 10024: e$ = "Too many open files."
Case 10035: e$ = "Operation would block."
Case 10036: e$ = "Operation now in progress."
Case 10037: e$ = "Operation already in progress."
Case 10038: e$ = "Socket operation on nonsocket."
Case 10039: e$ = "Destination address required."
Case 10040: e$ = "Message too long."
Case 10041: e$ = "Protocol wrong type for socket."
Case 10042: e$ = "Protocol not available."
Case 10043: e$ = "Protocol not supported."
Case 10044: e$ = "Socket type not supported."
Case 10045: e$ = "Operation not supported on socket."
Case 10046: e$ = "Protocol family not supported."
Case 10047: e$ = "Address family not supported by protocol family."
Case 10048: e$ = "Address already in use."
Case 10049: e$ = "Can't assign requested address."
Case 10050: e$ = "Network is down."
Case 10051: e$ = "Network is unreachable."
Case 10052: e$ = "Network dropped connection."
Case 10053: e$ = "Software caused connection abort."
Case 10054: e$ = "Connection reset by peer."
Case 10055: e$ = "No buffer space available."
Case 10056: e$ = "Socket is already connected."
Case 10057: e$ = "Socket is not connected."
Case 10058: e$ = "Can't send after socket shutdown."
Case 10059: e$ = "Too many references: can't splice."
Case 10060: e$ = "Connection timed out."
Case 10061: e$ = "Connection refused."
Case 10062: e$ = "Too many levels of symbolic links."
Case 10063: e$ = "File name too long."
Case 10064: e$ = "Host is down."
Case 10065: e$ = "No route to host."
Case 10066: e$ = "Directory not empty."
Case 10067: e$ = "Too many processes."
Case 10068: e$ = "Too many users."
Case 10069: e$ = "Disk quota exceeded."
Case 10070: e$ = "Stale NFS file handle."
Case 10071: e$ = "Too many levels of remote in path."
Case 10091: e$ = "Network subsystem is unusable."
Case 10092: e$ = "Winsock DLL cannot support this application."
Case 10093: e$ = "Winsock not initialized."
Case 10101: e$ = "Disconnect."
Case 11001: e$ = "Host not found."
Case 11002: e$ = "Nonauthoritative host not found."
Case 11003: e$ = "Nonrecoverable error."
Case 11004: e$ = "Valid name, no data record of requested type."
Case Else: e$ = "Unknown error "; errno; "."
End Select
GetWSAErrorString$ = e$
End Function
Sub WinsockInit
' Initializes structs used in Winsock calls.
Struct hostent, _
hname As Long, _
haliases As Long, _
haddrtype As Word, _
hlength As Word, _
haddrlist As Long
Struct sockaddr, _
sinfamily As Short, _
sinport As UShort, _
sinaddr As ULong, _
sinzero As Char[8]
Struct WSAData, _
wVersion As Word, _
wHighVersion As Word, _
szDescription As Char[257], _
szSystemStatus As Char[129], _
iMaxSockets As Word, _
iMaxUdpDg As Word, _
lpVendorInfo As Long
End Sub
Function woBang$( raw$ )
' Kludge to print a string that could start with an
' exclamation point, or bang (!). Am I missing something?
woBang$ = raw$
bangs = 0
While Mid$(raw$, bangs+1, 1) = "!"
bangs = bangs + 1
Wend
If bangs Then
bang$ = Left$(raw$, bangs)
woBang$ = Mid$(raw$, bangs+1)
#window.te,"!Lines ln"
#window.te,"!Line "; ln; " ln$"
#window.te,"!Select "; Len(ln$)+1; " "; ln
#window.te,"!Insert bang$"
#window.te,"!Select 1 1"
End If
End Function
'*** General Procedures ***
Function LOWORD( dw )
LOWORD = (dw And 65535)
End Function
Function MAKEWORD( b1, b2 )
MAKEWORD = b1 Or (256 * b2)
End Function
Function String$( num, ch )
If num > 0 Then
String$ = Chr$(ch)
While Len(String$) < num
String$ = String$ + String$
Wend
String$ = Left$(String$, num)
End If
End Function
'*** Winsock Wrappers ***
Function GetHostByAddr$( addr )
Struct p, addr As ULong
p.addr.struct = addr
CallDLL #wsock32, "gethostbyaddr", _
p As Struct, _
4 As Long, _
2 As Long, _ 'AF_INET=2
phe As Long
If phe Then
helen = Len(hostent.struct)
CallDLL #kernel32, "RtlMoveMemory", _
hostent As Struct, _
phe As ULong, _
helen As Long, _
rc As Void
GetHostByAddr$ = WinString(hostent.hname.struct)
End If
End Function
Function GetHostByName$( sName$ )
CallDLL #wsock32, "gethostbyname", _
sName$ As Ptr, _
phe As ULong
If phe Then
helen = Len(hostent.struct)
CallDLL #kernel32, "RtlMoveMemory", _
hostent As Struct, _
phe As ULong, _
helen As Long, _
rc As Void
GetHostByName$ = WinString(hostent.hname.struct)
End If
End Function
Function GetHostName$()
buf$ = Space$(256)+Chr$(0)
CallDLL #wsock32, "gethostname", _
buf$ As Ptr, _
256 As Long, _
rc As Long
GetHostName$ = Trim$(buf$)
End Function
Function GetLocalIP()
sName$ = GetHostName$()
CallDLL #wsock32, "gethostbyname", _
sName$ As Ptr, _
phe As ULong
If phe Then
helen = Len(hostent.struct)
CallDLL #kernel32, "RtlMoveMemory", _
hostent As Struct, _
phe As ULong, _
helen As Long, _
rc As Void
plong = hostent.haddrlist.struct
Struct p, addrlist As ULong
CallDLL #kernel32, "RtlMoveMemory", _
p As Struct, _
plong As ULong, _
4 As Long, _
rc As Void
plong = p.addrlist.struct
Struct p, addr As ULong
hlength = hostent.hlength.struct
CallDLL #kernel32, "RtlMoveMemory", _
p As Struct, _
plong As ULong, _
hlength As Long, _
rc As Void
GetLocalIP = p.addr.struct
End If
End Function
Function InetNtoA$( inaddr )
CallDLL #wsock32, "inet_ntoa", _
inaddr As ULong, _
pstr As ULong
InetNtoA$ = WinString(pstr)
End Function
Function Recv$( s, buflen, flags )
Recv$ = Space$(buflen)+Chr$(0)
CallDLL #wsock32, "recv", _
s As Long, _
Recv$ As Ptr, _
buflen As Long, _
flags As Long, _
buflen As Long
Recv$ = Left$(Recv$, buflen)
End Function
Function Send$( s, bufs$, buflen, flags )
#window.te,"Send Socket [";s;"][";bufs$;"]"
buflen = Min(Len(bufs$), buflen)
CallDLL #wsock32, "send", _
s As Long, _
bufs$ As Ptr, _
buflen As Long, _
flags As Long, _
buflen As Long
If buflen > 0 Then Send$ = Mid$(bufs$, buflen+1)
End Function
'*** Winsock Thin Wrappers ***
Function accept( s )
Struct p, length As Long
p.length.struct = Len(sockaddr.struct)
CallDLL #wsock32, "accept", _
s As Long, _
sockaddr As Struct, _
p As Struct, _
accept As Long
End Function
Function bind( s )
namelen = Len(sockaddr.struct)
CallDLL #wsock32, "bind", _
s As Long, _
sockaddr As Struct, _
namelen As Long, _
bind As Long
End Function
Function closesocket( s )
CallDLL #wsock32, "closesocket", _
s As Long, _
closesocket As Long
End Function
Function htonl( hostlong )
CallDLL #wsock32, "htonl", _
hostlong As ULong, _
htonl As ULong
End Function
Function htons( hostshort )
CallDLL #wsock32, "htons", _
hostshort As Word, _
htons As Word
End Function
Function inetaddr( cp$ )
CallDLL #wsock32, "inet_addr", _
cp$ As Ptr, _
inetaddr As ULong
End Function
Function listen( s, backlog )
CallDLL #wsock32, "listen", _
s As Long, _
backlog As Long, _
listen As Long
End Function
Function socket( af, type, protocol )
CallDLL #wsock32, "socket", _
af As Long, _
type As Long, _
protocol As Long, _
socket As Long
End Function
Function WSAAsyncSelect( s, hWnd, wMsg, lEvent )
CallDLL #wsock32, "WSAAsyncSelect", _
s As Long, _
hWnd As ULong, _
wMsg As ULong, _
lEvent As Long, _
WSAAsyncSelect As Long
End Function
Sub WSACleanup
CallDLL #wsock32, "WSACleanup", _
r As Void
End Sub
Function WSAGetLastError()
CallDLL #wsock32, "WSAGetLastError", _
WSAGetLastError As Long
End Function
Function WSAStartup( wVersionRequested )
CallDLL #wsock32, "WSAStartup", _
wVersionRequested As Word, _
WSAData As Struct, _
WSAStartup As Long
End Function
'*** WMLiberty Thin Wrappers ***
Function SetWMHandler( hWnd, uMsg, lpfnCB, lSuccess )
CallDLL #wmlib, "SetWMHandler", _
hWnd As Long, _
uMsg As Long, _
lpfnCB As Long, _
lSuccess As Long, _
SetWMHandler As Long
End Function
Sub GetChar handle$, c$
c$ = Inkey$
if len(c$) = 1 then #window.te, "KeyPress [";ASC(c$);"]"
End Sub
Sub Quit handle$
#window.te,"[Quit] Signal Received from Handle ";handle$
Call Sleep 500
#window.te,"> Closing"
Call WSACleanup
#window.te,"> Step 1"
#window.te,"> Step 2"
Close #wmlib
#window.te,"> Step 3"
rc=closesocket(sock)
#window.te,"> Step 4"
t1=time$("ms")
#window.te,"> Please wait 2 seconds"
[loopz]
t2=time$("ms")
if (t2-t1)<2000 then [loopz]
Close #wsock32
Close #window
End
End Sub
Sub Sleep Delay
timer Delay,[standby]
wait
[standby]
timer 0
End Sub
Function TruncateJunk$( t$ )
'Messages must start with STX, whatever remains in comm buffer must be flushed...
TruncateJunk$=""
for i=1 to LEN(t$)
if mid$(t$,i,1)=STX$ then
TruncateJunk$=mid$(t$,i) 'Found STX, copy from here onwards...
exit for
end if
next
End Function
Sub ProcessMessage sMsg$, CallingSocket
#window.te, "-PROCESS BEGIN-"
#window.te,"PROCESS MSG :[";sMsg$;"]"
Question=INSTR(sMsg$,"?")
Http=INSTR(sMsg$,"HTTP")
Fields$=TRIM$( LEFT$(sMsg$, Http-1 ))
IF Question>1 THEN
MessageType$=TRIM$( LEFT$(sMsg$,Question-1 ))
ELSE
MessageType$=TRIM$( LEFT$(sMsg$, Http-1 ))
END IF
#window.te,">>>>> SELECT COMMAND :[";MessageType$;"]"
SELECT CASE MessageType$
CASE "GET /"
#window.te,"ROOT PAGE:"
CALL SendIndex "INDEX",CallingSocket
CASE "GET /INDEX.HTM"
#window.te,"HOME PAGE:"
CALL SendIndex "INDEX",CallingSocket
CASE "GET /CHAP1.HTM"
#window.te,"CHAPTER 1:"
CALL SendChap1 "CHAP1",CallingSocket
CASE "GET /CHAP2.HTM"
#window.te,"CHAPTER 2:"
CALL SendChap2 "CHAP2",CallingSocket
CASE "GET /CHAP3.HTM"
#window.te,"CHAPTER 3:"
CALL SendChap3 "CHAP3",CallingSocket
CASE "GET /PROC1.HTM"
FieldsToParse$=TRIM$( MID$(Fields$,Question+1) )
#window.te,"PROCESS 1:"
CALL SendProc1 FieldsToParse$,CallingSocket
CASE "PQR"
CASE ELSE
#window.te,"DEFAULT INDEX:"
CALL SendIndex "INDEX",CallingSocket
END SELECT
#window.te, "-PROCESS END-"
'Select Case
#window.te, "-PROCESS END-"
End Sub
Sub SendIndex Index$,CallingSocket
Message$="HTTP/1.1 200 OK"+CRLF$
Message$=Message$+"Date: Sun, 24 Dec 2006 00:01:59 GMT"+CRLF$
Message$=Message$+"Content-Type: text/html"+CRLF$
Message$=Message$+"Content-Length: 256"+CRLF$
Message$=Message$+"<html>"+CRLF$
Message$=Message$+"<HEAD>"+CRLF$
Message$=Message$+"<TITLE>Liberty Basic Web Server</TITLE>"+CRLF$
Message$=Message$+"</HEAD>"+CRLF$
Message$=Message$+"<body>"+CRLF$
Message$=Message$+"<h1>Liberty Basic 4.03 Web Server Demo</h1>"+CRLF$
Message$=Message$+"This example demonstrates how you can make dynamic servers in pure Liberty Basic<BR>"+CRLF$
Message$=Message$+"Enjoy !<BR>"+CRLF$
Message$=Message$+"CryptoMan<BR><BR><BR><CODE>"+CRLF$
FOR i=1 to 3
'Message$=Message$+"<P><font size=";i;">"
Message$=Message$+" [";USING("##",i);"] ";DATE$()+" "+TIME$()+"<BR>"+CRLF$
Message$=Message$+"</font>"
NEXT i
Message$=Message$+"<h3>You can not only use MySQL and MsSQL from Liberty but can also make Web Servers...</h3>"+CRLF$
Message$=Message$+"<h3>And, you can also connect Dynamic SQL I/O to this Web Server...</h3>"+CRLF$
Message$=Message$+"</CODE>"
Message$=Message$+"<P><A href="+QU$+"http://localhost:93/CHAP1.HTM"+QU$+">What is Liberty Basic ?</A>"+CRLF$
Message$=Message$+"<P><A href="+QU$+"http://localhost:93/CHAP2.HTM"+QU$+">Can you use MySQL with Liberty Basic ?</A>"+CRLF$
Message$=Message$+"<P><A href="+QU$+"http://localhost:93/CHAP3.HTM"+QU$+">Can you enter data in a form ?</A>"+CRLF$
Message$=Message$+"<h2>Merry Christmas and Happy New Year !</h2>"+CRLF$
Message$=Message$+"</body>"+CRLF$
Message$=Message$+"</html>"+CRLF$
outbuf$ = Send$(CallingSocket, Message$, len(Message$), 0)
End Sub
Sub SendChap1 Index$,CallingSocket
Message$="HTTP/1.1 200 OK"+CRLF$
Message$=Message$+"Date: Sun, 24 Dec 2006 00:01:59 GMT"+CRLF$
Message$=Message$+"Content-Type: text/html"+CRLF$
Message$=Message$+"Content-Length: 256"+CRLF$
Message$=Message$+"<html>"+CRLF$
Message$=Message$+"<HEAD>"+CRLF$
Message$=Message$+"<TITLE>Chapter 1</TITLE>"+CRLF$
Message$=Message$+"</HEAD>"+CRLF$
Message$=Message$+"<body>"+CRLF$
Message$=Message$+"<h1>What is Liberty Basic ?</h1>"+CRLF$
Message$=Message$+"<h3>Greatest programming language in the world...</h3><BR>"+CRLF$
Message$=Message$+"Enjoy !<BR>"+CRLF$
Message$=Message$+"CryptoMan<BR><BR><BR><CODE>"+CRLF$
Message$=Message$+"</CODE>"
Message$=Message$+"<P><A href="+QU$+"http://localhost:93/INDEX.HTM"+QU$+">Main Page</A>"+CRLF$
Message$=Message$+"<h2>Merry Christmas and Happy New Year !</h2>"+CRLF$
Message$=Message$+"</body>"+CRLF$
Message$=Message$+"</html>"+CRLF$
outbuf$ = Send$(CallingSocket, Message$, len(Message$), 0)
End Sub
Sub SendChap2 Index$,CallingSocket
Message$="HTTP/1.1 200 OK"+CRLF$
Message$=Message$+"Date: Sun, 24 Dec 2006 00:01:59 GMT"+CRLF$
Message$=Message$+"Content-Type: text/html"+CRLF$
Message$=Message$+"Content-Length: 256"+CRLF$
Message$=Message$+"<html>"+CRLF$
Message$=Message$+"<HEAD>"+CRLF$
Message$=Message$+"<TITLE>Chapter 2</TITLE>"+CRLF$
Message$=Message$+"</HEAD>"+CRLF$
Message$=Message$+"<body>"+CRLF$
Message$=Message$+"<h1>Can you use MySQL with Liberty Basic ?</h1>"+CRLF$
Message$=Message$+"<h3>Ofcourse you can !</h3><BR>"+CRLF$
Message$=Message$+"Enjoy !<BR>"+CRLF$
Message$=Message$+"CryptoMan<BR><BR><BR><CODE>"+CRLF$
Message$=Message$+"</CODE>"
Message$=Message$+"<P><A href="+QU$+"http://localhost:93/INDEX.HTM"+QU$+">Main Page</A>"+CRLF$
Message$=Message$+"<h2>Merry Christmas and Happy New Year !</h2>"+CRLF$
Message$=Message$+"</body>"+CRLF$
Message$=Message$+"</html>"+CRLF$
outbuf$ = Send$(CallingSocket, Message$, len(Message$), 0)
End Sub
Sub SendChap3 Index$,CallingSocket
Message$="HTTP/1.1 200 OK"+CRLF$
Message$=Message$+"Date: Sun, 24 Dec 2006 00:01:59 GMT"+CRLF$
Message$=Message$+"Content-Type: text/html"+CRLF$
Message$=Message$+"Content-Length: 256"+CRLF$
Message$=Message$+"<html>"+CRLF$
Message$=Message$+"<HEAD>"+CRLF$
Message$=Message$+"<TITLE>Chapter 3</TITLE>"+CRLF$
Message$=Message$+"</HEAD>"+CRLF$
Message$=Message$+"<body>"+CRLF$
Message$=Message$+"<h1>Please Enter Data in Form and Press [ Submit ]</h1>"+CRLF$
Message$=Message$+"<form name="+QU$+"input"+QU$+"action="+QU$+"PROC1.HTM"+QU$+" method="+QU$+"get"+QU$+">"
Message$=Message$+"First name:"
Message$=Message$+"<input type="+QU$+"text"+QU$+"name="+QU$+"firstname"+QU$+">"
Message$=Message$+"<br>"
Message$=Message$+"Last name:"
Message$=Message$+"<input type="+QU$+"text"+QU$+"name="+QU$+"lastname"+QU$+">"
Message$=Message$+"<br>"
Message$=Message$+"<input type="+QU$+"submit"+QU$+"value="+QU$+"Submit"+QU$+">"
Message$=Message$+"</form>"
Message$=Message$+"</CODE>"
'<input type="submit" value="Submit">
'Message$=Message$+"<P><A href="+QU$+"http://localhost:93/SUBMIT.HTM"+QU$+">Submit</A>"+CRLF$
Message$=Message$+"<P><A href="+QU$+"http://localhost:93/INDEX.HTM"+QU$+">Main Page</A>"+CRLF$
Message$=Message$+"<h2>Merry Christmas and Happy New Year !</h2>"+CRLF$
Message$=Message$+"</body>"+CRLF$
Message$=Message$+"</html>"+CRLF$
outbuf$ = Send$(CallingSocket, Message$, len(Message$), 0)
End Sub
Sub SendProc1 FieldData$,CallingSocket
Message$="HTTP/1.1 200 OK"+CRLF$
Message$=Message$+"Date: Sun, 24 Dec 2006 00:01:59 GMT"+CRLF$
Message$=Message$+"Content-Type: text/html"+CRLF$
Message$=Message$+"Content-Length: 256"+CRLF$
Message$=Message$+"<html>"+CRLF$
Message$=Message$+"<HEAD>"+CRLF$
Message$=Message$+"<TITLE>Process 1</TITLE>"+CRLF$
Message$=Message$+"</HEAD>"+CRLF$
Message$=Message$+"<body>"+CRLF$
Message$=Message$+"<h1>Thank You !</h1>"+CRLF$
Message$=Message$+"<BR><BR>"+UPPER$(Left$(FieldData$,INSTR(FieldData$,"&")-1))
Message$=Message$+"<BR><BR>"+UPPER$(Mid$( FieldData$,INSTR(FieldData$,"&")+1))
Message$=Message$+"<BR><BR>"
Message$=Message$+"<P><A href="+QU$+"http://localhost:93/INDEX.HTM"+QU$+">Main Page</A>"+CRLF$
Message$=Message$+"</body>"+CRLF$
Message$=Message$+"</html>"+CRLF$
outbuf$ = Send$(CallingSocket, Message$, len(Message$), 0)
End Sub
Sub SetButtons
button #window.button01, " Button 1 ", Button01Click, UL, 10, WindowHeight+45, 100, 25
button #window.button02, " Button 2 ", Button02Click, UL, 120,WindowHeight+45, 100, 25
button #window.button03, " Button 3 ", Button03Click, UL, 230,WindowHeight+45, 100, 25
button #window.buttonQt, " Quit ", Quit, UL, 340,WindowHeight+45, 100, 25
End Sub
Sub Button01Click handle$
Notice "Button 1 Title"+chr$(13)+"Button 1 Pressed"+chr$(13)+"Do Whatever..."
End Sub
Sub Button02Click handle$
Notice "Button 2 Title"+chr$(13)+"Button 2 Pressed"+chr$(13)+"Do Whatever..."
End Sub
Sub Button03Click handle$
Notice "Button 3 Title"+chr$(13)+"Button 3 Pressed"+chr$(13)+"Do Whatever..."
End Sub
|
|
|
| Back to top |
|
|
CryptoMan
Status: Offline
Joined: 07 May 2005
Posts: 8
|
| Posted: Mon Jan 01, 2007 5:55 pm Post subject: Version 1.4 with correct content length and date for all pag |
|
|
Version 1.4 with correct content length and date for all pages.
| Code: |
' Version 1.2 Forms
' Version 1.3 Computed content length and Date Time for index page only
' Version 1.4 Computed content length and Date Time for all pages
'// CryptoMan Simple HTTP Server
'// -----------------------------------------------------------------------------------------------
'// Copyright (c) 2006,2007 Verisoft
'// All rights reserved. Personal educational use only.
'// It may not be used commercially without express written consent from VERISOFT.
'// Please contact info@verisoft.com for permissions and licensing conditions.
'// www.verisoft.com
'// Requires WMLiberty.DLL from Brent Thorn
'// WILL SERVE AT THIS
Global PORT: PORT = 97
'// Verisoft SERVER DATA DEFINITION
Global CRLF$ : CRLF$=chr$(13)+chr$(10)
Global QU$ : QU$=chr$(34)
Global DEBUG : DEBUG=1
Global Version$ : Version$="1.4"
Global TZ : TZ=2 'Number of hours from GMT
Global IPstr$ : IPstr$="cryptoman.servehttp.com"
Global YourIPstr$ , Browser$
NoMainWin
Call SetButtons
Open "c:\DLL\wsock32" For DLL As #wsock32
Open "c:\DLL\WMLiberty" For DLL As #wmlib
' Create a window.
WindowWidth = 640
WindowHeight = 480
TextEditor #window.te, 0, 0, 630, 400
Open "CryptoMan Web Server "+Version$ For Window As #window
#window, "TrapCLose [s_Close]"
#window.te, "!AutoResize"
#window.te, "!Font Fixedsys 8"
#window.te,"CryptoMan Simple HTTP Server "
#window.te,"-------------------------------------------------------------------------------------------"
#window.te,"Copyright (c) 2006,2007 Verisoft "
#window.te,"All rights reserved. Personal educational use only. "
#window.te,"It may not be used commercially without express written consent from VERISOFT. "
#window.te,"Please contact info@verisoft.com for permissions and licensing conditions. "
#window.te," www.verisoft.com "
#window.te,"Requires WMLiberty.DLL from Brent Thorn "
#window.te,"Credit and thanks to Brent Thorn for WMLiberty.DLL and his excellent TELNET SERVER example."
#window.te,""
' Now create a socket, bind it to a local port, set some
' network events to trap, and start listening for clients.
Call WinsockInit
Err = 1 ' Assume failure
If WSAStartup(MAKEWORD(2, 2)) = 0 Then
#window.te, "> Winsock initialized."
sockaddr.sinfamily.struct = 2 'AF_INET
sockaddr.sinzero.struct = String$(8, 0)
sockaddr.sinport.struct = htons(PORT)
If sockaddr.sinport.struct <> -1 Then
sockaddr.sinaddr.struct = htonl(0) 'INADDR_ANY=0
If sockaddr.sinaddr.struct <> -1 Then
sock = socket(2, 1, 0) 'AF_INET=2:SOCK_STREAM=1
If sock <> -1 Then
#window.te, "> Socket created >>>"; sock
If bind(sock) = 0 Then
#window.te,"> Port bind successful."
'FD_READ=1:FD_WRITE=2:FD_OOB=4:FD_ACCEPT=8:FD_CONNECT=16:FD_CLOSE=32
If WSAAsyncSelect(sock, HWnd(#window), _WM_USER, 1 Or 2 Or 8 Or 32) <> -1 Then
#window.te,"> Events selected."
If listen(sock, 1) = 0 Then
#window.te,"> Listening for incoming connections."
Err = 0 ' Success!
Callback lpfnCB, SockProc( Long, Long, Long, Long ), Long
rc = SetWMHandler(HWnd(#window), _WM_USER, lpfnCB, 1)
End If
End If
End If
End If
End If
End If
End If
If Err Then
#window.te,"> ERROR: "; GetWSAErrorString$(WSAGetLastError())
If sock <> -1 Then
rc = closesocket(sock)
End If
Else
myip = GetLocalIP()
IPlocstr$=InetNtoA$(myip)
#window.te,"> Clients connect to [";IPlocstr$; ":"; PORT; "]"
#window.te,"> or ["; GetHostByAddr$(myip); ":"; PORT; "]"
#window.te,"> HEXIP ["; dechex$(myip); "]"
End If
[s_Wait]
Scan
CallDLL #kernel32, "Sleep", _
200 As Long, _
rc As Void
GoTo [s_Wait]
[s_Close]
If sock <> -1 Then
rc = closesocket(sock)
End If
#window.te,"> Closing"
Call WSACleanup
#window.te,"> Step 1"
#window.te,"> Step 2"
Close #wmlib
#window.te,"> Step 3"
rc=closesocket(sock)
#window.te,"> Step 4"
t1=time$("ms")
#window.te,"> Please wait 2 seconds"
[loopz]
t2=time$("ms")
if (t2-t1)<2000 then [loopz]
Close #wsock32
Close #window
End
'*** Application Procedures ***
Function SockProc( hWnd, uMsg, sock, lParam )
' Callback function to handle a Windows message
' forwarded by WMLiberty. Called when a relevant
' network event occurs.
#window.te,""
#window.te,"Sock Proc "+str$(LOWORD(lParam))
Select Case LOWORD(lParam)
Case 1 'FD_READ
'>>>>>>>
#window.te,"> Message from ";sock
buf$ = Recv$(sock, 8192, 0)
#window.te woBang$(buf$);
Call ProcessMessage buf$,sock
If sock <> -1 Then
Scan
Call Sleep 1000
rc = closesocket(sock)
End If
Case 2 'FD_WRITE
'TODO
Case 8 'FD_ACCEPT
rc = accept(sock)
YourIPstr$= InetNtoA$(sockaddr.sinaddr.struct)
#window.te,"> Accepted connection from ";YourIPstr$;":";htons(sockaddr.sinport.struct); "."
playwave "ding"
#window.te,"> Calling Network ";dechex$(RemoteIP(InetNtoA$(sockaddr.sinaddr.struct)))
'#window.te,"> Calling Network ";GetHostByAddr$(RemoteIP(InetNtoA$(sockaddr.sinaddr.struct)))
Case 32 'FD_CLOSE
' Flush the buffers.
rc = SockProc(hWnd, uMsg, sock, 1) 'force read
#window.te,"> Connection Closed."
End Select
End Function
Function GetWSAErrorString$( errnum )
Select Case errnum
Case 10004: e$ = "Interrupted system call."
Case 10009: e$ = "Bad file number."
Case 10013: e$ = "Permission Denied."
Case 10014: e$ = "Bad Address."
Case 10022: e$ = "Invalid Argument."
Case 10024: e$ = "Too many open files."
Case 10035: e$ = "Operation would block."
Case 10036: e$ = "Operation now in progress."
Case 10037: e$ = "Operation already in progress."
Case 10038: e$ = "Socket operation on nonsocket."
Case 10039: e$ = "Destination address required."
Case 10040: e$ = "Message too long."
Case 10041: e$ = "Protocol wrong type for socket."
Case 10042: e$ = "Protocol not available."
Case 10043: e$ = "Protocol not supported."
Case 10044: e$ = "Socket type not supported."
Case 10045: e$ = "Operation not supported on socket."
Case 10046: e$ = "Protocol family not supported."
Case 10047: e$ = "Address family not supported by protocol family."
Case 10048: e$ = "Address already in use."
Case 10049: e$ = "Can't assign requested address."
Case 10050: e$ = "Network is down."
Case 10051: e$ = "Network is unreachable."
Case 10052: e$ = "Network dropped connection."
Case 10053: e$ = "Software caused connection abort."
Case 10054: e$ = "Connection reset by peer."
Case 10055: e$ = "No buffer space available."
Case 10056: e$ = "Socket is already connected."
Case 10057: e$ = "Socket is not connected."
Case 10058: e$ = "Can't send after socket shutdown."
Case 10059: e$ = "Too many references: can't splice."
Case 10060: e$ = "Connection timed out."
Case 10061: e$ = "Connection refused."
Case 10062: e$ = "Too many levels of symbolic links."
Case 10063: e$ = "File name too long."
Case 10064: e$ = "Host is down."
Case 10065: e$ = "No route to host."
Case 10066: e$ = "Directory not empty."
Case 10067: e$ = "Too many processes."
Case 10068: e$ = "Too many users."
Case 10069: e$ = "Disk quota exceeded."
Case 10070: e$ = "Stale NFS file handle."
Case 10071: e$ = "Too many levels of remote in path."
Case 10091: e$ = "Network subsystem is unusable."
Case 10092: e$ = "Winsock DLL cannot support this application."
Case 10093: e$ = "Winsock not initialized."
Case 10101: e$ = "Disconnect."
Case 11001: e$ = "Host not found."
Case 11002: e$ = "Nonauthoritative host not found."
Case 11003: e$ = "Nonrecoverable error."
Case 11004: e$ = "Valid name, no data record of requested type."
Case Else: e$ = "Unknown error "; errno; "."
End Select
GetWSAErrorString$ = e$
End Function
Sub WinsockInit
' Initializes structs used in Winsock calls.
Struct hostent, _
hname As Long, _
haliases As Long, _
haddrtype As Word, _
hlength As Word, _
haddrlist As Long
Struct sockaddr, _
sinfamily As Short, _
sinport As UShort, _
sinaddr As ULong, _
sinzero As Char[8]
Struct WSAData, _
wVersion As Word, _
wHighVersion As Word, _
szDescription As Char[257], _
szSystemStatus As Char[129], _
iMaxSockets As Word, _
iMaxUdpDg As Word, _
lpVendorInfo As Long
End Sub
Function woBang$( raw$ )
' Kludge to print a string that could start with an
' exclamation point, or bang (!). Am I missing something?
woBang$ = raw$
bangs = 0
While Mid$(raw$, bangs+1, 1) = "!"
bangs = bangs + 1
Wend
If bangs Then
bang$ = Left$(raw$, bangs)
woBang$ = Mid$(raw$, bangs+1)
#window.te,"!Lines ln"
#window.te,"!Line "; ln; " ln$"
#window.te,"!Select "; Len(ln$)+1; " "; ln
#window.te,"!Insert bang$"
#window.te,"!Select 1 1"
End If
End Function
'*** General Procedures ***
Function LOWORD( dw )
LOWORD = (dw And 65535)
End Function
Function MAKEWORD( b1, b2 )
MAKEWORD = b1 Or (256 * b2)
End Function
Function String$( num, ch )
If num > 0 Then
String$ = Chr$(ch)
While Len(String$) < num
String$ = String$ + String$
Wend
String$ = Left$(String$, num)
End If
End Function
'*** Winsock Wrappers ***
Function GetHostByAddr$( addr )
Struct p, addr As ULong
p.addr.struct = addr
CallDLL #wsock32, "gethostbyaddr", _
p As Struct, _
4 As Long, _
2 As Long, _ 'AF_INET=2
phe As Long
If phe Then
helen = Len(hostent.struct)
CallDLL #kernel32, "RtlMoveMemory", _
hostent As Struct, _
phe As ULong, _
helen As Long, _
rc As Void
GetHostByAddr$ = WinString(hostent.hname.struct)
End If
End Function
Function GetHostByName$( sName$ )
CallDLL #wsock32, "gethostbyname", _
sName$ As Ptr, _
phe As ULong
If phe Then
helen = Len(hostent.struct)
CallDLL #kernel32, "RtlMoveMemory", _
hostent As Struct, _
phe As ULong, _
helen As Long, _
rc As Void
GetHostByName$ = WinString(hostent.hname.struct)
End If
End Function
Function GetHostName$()
buf$ = Space$(256)+Chr$(0)
CallDLL #wsock32, "gethostname", _
buf$ As Ptr, _
256 As Long, _
rc As Long
GetHostName$ = Trim$(buf$)
End Function
Function GetLocalIP()
sName$ = GetHostName$()
CallDLL #wsock32, "gethostbyname", _
sName$ As Ptr, _
phe As ULong
If phe Then
helen = Len(hostent.struct)
CallDLL #kernel32, "RtlMoveMemory", _
hostent As Struct, _
phe As ULong, _
helen As Long, _
rc As Void
plong = hostent.haddrlist.struct
Struct p, addrlist As ULong
CallDLL #kernel32, "RtlMoveMemory", _
p As Struct, _
plong As ULong, _
4 As Long, _
rc As Void
plong = p.addrlist.struct
Struct p, addr As ULong
hlength = hostent.hlength.struct
CallDLL #kernel32, "RtlMoveMemory", _
p As Struct, _
plong As ULong, _
hlength As Long, _
rc As Void
GetLocalIP = p.addr.struct
End If
End Function
function RemoteIP( strIPno$ )
p1=val(word$( strIPno$,1,"."))
p2=val(word$( strIPno$,2,"."))
p3=val(word$( strIPno$,3,"."))
p4=val(word$( strIPno$,4,"."))
if p1>15 then h1$=dechex$(p1) else h1$="0"+dechex$(p1)
if p2>15 then h2$=dechex$(p2) else h2$="0"+dechex$(p2)
if p3>15 then h3$=dechex$(p3) else h3$="0"+dechex$(p3)
if p4>15 then h4$=dechex$(p4) else h4$="0"+dechex$(p4)
RemoteIP=hexdec(h4$+h3$+h2$+h1$)
end function
Function InetNtoA$( inaddr )
CallDLL #wsock32, "inet_ntoa", _
inaddr As ULong, _
pstr As ULong
InetNtoA$ = WinString(pstr)
End Function
Function Recv$( s, buflen, flags )
Recv$ = Space$(buflen)+Chr$(0)
CallDLL #wsock32, "recv", _
s As Long, _
Recv$ As Ptr, _
buflen As Long, _
flags As Long, _
buflen As Long
Recv$ = Left$(Recv$, buflen)
End Function
Function Send$( s, bufs$, buflen, flags )
#window.te,"Send Socket [";s;"][";bufs$;"]"
buflen = Min(Len(bufs$), buflen)
CallDLL #wsock32, "send", _
s As Long, _
bufs$ As Ptr, _
buflen As Long, _
flags As Long, _
buflen As Long
If buflen > 0 Then Send$ = Mid$(bufs$, buflen+1)
End Function
'*** Winsock Thin Wrappers ***
Function accept( s )
Struct p, length As Long
p.length.struct = Len(sockaddr.struct)
CallDLL #wsock32, "accept", _
s As Long, _
sockaddr As Struct, _
p As Struct, _
accept As Long
End Function
Function bind( s )
namelen = Len(sockaddr.struct)
CallDLL #wsock32, "bind", _
s As Long, _
sockaddr As Struct, _
namelen As Long, _
bind As Long
End Function
Function closesocket( s )
CallDLL #wsock32, "closesocket", _
s As Long, _
closesocket As Long
End Function
Function htonl( hostlong )
CallDLL #wsock32, "htonl", _
hostlong As ULong, _
htonl As ULong
End Function
Function htons( hostshort )
CallDLL #wsock32, "htons", _
hostshort As Word, _
htons As Word
End Function
Function inetaddr( cp$ )
CallDLL #wsock32, "inet_addr", _
cp$ As Ptr, _
inetaddr As ULong
End Function
Function listen( s, backlog )
CallDLL #wsock32, "listen", _
s As Long, _
backlog As Long, _
listen As Long
End Function
Function socket( af, type, protocol )
CallDLL #wsock32, "socket", _
af As Long, _
type As Long, _
protocol As Long, _
socket As Long
End Function
Function WSAAsyncSelect( s, hWnd, wMsg, lEvent )
CallDLL #wsock32, "WSAAsyncSelect", _
s As Long, _
hWnd As ULong, _
wMsg As ULong, _
lEvent As Long, _
WSAAsyncSelect As Long
End Function
Sub WSACleanup
CallDLL #wsock32, "WSACleanup", _
r As Void
End Sub
Function WSAGetLastError()
CallDLL #wsock32, "WSAGetLastError", _
WSAGetLastError As Long
End Function
Function WSAStartup( wVersionRequested )
CallDLL #wsock32, "WSAStartup", _
wVersionRequested As Word, _
WSAData As Struct, _
WSAStartup As Long
End Function
'*** WMLiberty Thin Wrappers ***
Function SetWMHandler( hWnd, uMsg, lpfnCB, lSuccess )
CallDLL #wmlib, "SetWMHandler", _
hWnd As Long, _
uMsg As Long, _
lpfnCB As Long, _
lSuccess As Long, _
SetWMHandler As Long
End Function
Sub GetChar handle$, c$
c$ = Inkey$
if len(c$) = 1 then #window.te, "KeyPress [";ASC(c$);"]"
End Sub
Sub Quit handle$
#window.te,"[Quit] Signal Received from Handle ";handle$
Call Sleep 500
#window.te,"> Closing"
Call WSACleanup
#window.te,"> Step 1"
#window.te,"> Step 2"
Close #wmlib
#window.te,"> Step 3"
rc=closesocket(sock)
#window.te,"> Step 4"
t1=time$("ms")
#window.te,"> Please wait 2 seconds"
[loopz]
t2=time$("ms")
if (t2-t1)<2000 then [loopz]
Close #wsock32
Close #window
End
End Sub
Sub Sleep Delay
CallDLL #kernel32, "Sleep", _
Delay As Long, _
rc As Void
End Sub
Function TruncateJunk$( t$ )
'Messages must start with STX, whatever remains in comm buffer must be flushed...
TruncateJunk$=""
for i=1 to LEN(t$)
if mid$(t$,i,1)=STX$ then
TruncateJunk$=mid$(t$,i) 'Found STX, copy from here onwards...
exit for
end if
next
End Function
Sub ProcessMessage sMsg$, CallingSocket
#window.te, "-PROCESS BEGIN-"
#window.te,"PROCESS MSG :[";sMsg$;"]"
Question=INSTR(sMsg$,"?")
Http=INSTR(sMsg$,"HTTP")
BR1 =INSTR(sMsg$,"User-Agent:")
BR2 =INSTR(sMsg$,"Host:")
Browser$=MID$( sMsg$,BR1+11,(BR2-BR1-5-11))
Fields$=TRIM$( LEFT$(sMsg$, Http-1 ))
IF Question>1 THEN
MessageType$=TRIM$( LEFT$(sMsg$,Question-1 ))
ELSE
MessageType$=TRIM$( LEFT$(sMsg$, Http-1 ))
END IF
#window.te,">>>>> SELECT COMMAND :[";MessageType$;"]"
SELECT CASE MessageType$
CASE "GET /"
#window.te,"ROOT PAGE:"
CALL SendIndex "INDEX",CallingSocket
CASE "GET /INDEX.HTM"
#window.te,"HOME PAGE:"
CALL SendIndex "INDEX",CallingSocket
CASE "GET /CHAP1.HTM"
#window.te,"CHAPTER 1:"
CALL SendChap1 "CHAP1",CallingSocket
CASE "GET /CHAP2.HTM"
#window.te,"CHAPTER 2:"
CALL SendChap2 "CHAP2",CallingSocket
CASE "GET /CHAP3.HTM"
#window.te,"CHAPTER 3:"
CALL SendChap3 "CHAP3",CallingSocket
CASE "GET /PROC1.HTM"
FieldsToParse$=TRIM$( MID$(Fields$,Question+1) )
#window.te,"PROCESS 1:"
CALL SendProc1 FieldsToParse$,CallingSocket
CASE "PQR"
CASE ELSE
#window.te,"DEFAULT INDEX:"
CALL SendIndex "INDEX",CallingSocket
END SELECT
#window.te, "-PROCESS END-"
End Sub
Sub SendPage Content$,CallingSocket
ContentLen=Len(Content$)
Message$="HTTP/1.1 200 OK"+CRLF$
Message$=Message$+DateTime$()+CRLF$
Message$=Message$+"Content-Type: text/html"+CRLF$
Message$=Message$+"Content-Length: "+str$(ContentLen)+CRLF$
Message$=Message$+Content$
outbuf$ = Send$(CallingSocket, Message$, len(Message$), 0)
End Sub
Sub SendIndex Index$,CallingSocket
Message$="<html>"+CRLF$
Message$=Message$+"<HEAD>"+CRLF$
Message$=Message$+"<TITLE>Liberty Basic Web Server</TITLE>"+CRLF$
Message$=Message$+"</HEAD>"+CRLF$
Message$=Message$+"<body>"+CRLF$
Message$=Message$+"<h1>Liberty Basic 4.03 Web Server Demo</h1>"+CRLF$
Message$=Message$+"This example demonstrates how you can make dynamic servers in pure Liberty Basic<BR>"+CRLF$
Message$=Message$+"Enjoy !<BR>"+CRLF$
Message$=Message$+"CryptoMan<BR><BR><BR><CODE>"+CRLF$
Message$=Message$+"<BR>"+DateTime$()+"<BR>Your IP: ";YourIPstr$;"<BR>Browser: ";Browser$;"<BR><BR>"+CRLF$
Message$=Message$+"<h3>You can not only use MySQL and MsSQL from Liberty but can also make Web Servers...</h3>"+CRLF$
Message$=Message$+"<h3>And, you can also connect Dynamic SQL I/O to this Web Server...</h3>"+CRLF$
Message$=Message$+"</CODE>"
Message$=Message$+"<P><A href="+QU$+"http://"+IPstr$+"/CHAP1.HTM"+QU$+">What is Liberty Basic ?</A>"+CRLF$
Message$=Message$+"<P><A href="+QU$+"http://"+IPstr$+"/CHAP2.HTM"+QU$+">Can you use MySQL with Liberty Basic ?</A>"+CRLF$
Message$=Message$+"<P><A href="+QU$+"http://"+IPstr$+"/CHAP3.HTM"+QU$+">Can you enter data in a form ?</A>"+CRLF$
Message$=Message$+"<h2>Merry Christmas and Happy New Year !</h2>"+CRLF$
Message$=Message$+"</body>"+CRLF$
Message$=Message$+"</html>"+CRLF$
Call SendPage Message$,CallingSocket
End Sub
Function DateTime$( )
DayNo=date$("days")
TM$=TIME$()
TNow =VAL(MID$(TM$,1,2))-TZ
If TNow<0 Then
TNow=TNow+24
DayNo=DayNo-1
End If
DT$=DATE$(DayNo)
TH$=STR$(TNow)
If LEN(TH$)=1 Then TH$="0"+TH$
DateTime$=dayname$(date$(DayNo))+TH$+MID$(TM$,3,6)+" GMT"
End Function
FUNCTION dayname$(dt$)
days$ = "Tue Wed Thu Fri Sat Sun Mon"
months$ = "Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec"
dayname$ = "Date...: "+word$(days$,(DATE$(dt$) MOD 7)+1)+", " +MID$(dt$,4,2)+" "+ word$( months$, INT(VAL( LEFT$(dt$,2))) ) +" "+MID$(dt$,7,4)+" "
END FUNCTION
Sub SendChap1 Index$,CallingSocket
Message$="<html>"+CRLF$
Message$=Message$+"</HEAD>"+CRLF$
Message$=Message$+"<body>"+CRLF$
Message$=Message$+"<h1>What is Liberty Basic ?</h1>"+CRLF$
Message$=Message$+"<h3>Greatest programming language in the world...</h3><BR>"+CRLF$
Message$=Message$+"Enjoy !<BR>"+CRLF$
Message$=Message$+"CryptoMan<BR><BR><BR><CODE>"+CRLF$
Message$=Message$+"</CODE>"
Message$=Message$+"<P><A href="+QU$+"http://"+IPstr$+"/INDEX.HTM"+QU$+">Main Page</A>"+CRLF$
Message$=Message$+"<h2>Merry Christmas and Happy New Year !</h2>"+CRLF$
Message$=Message$+"</body>"+CRLF$
Message$=Message$+"</html>"+CRLF$
Call SendPage Message$,CallingSocket
End Sub
Sub SendChap2 Index$,CallingSocket
Message$="<html>"+CRLF$
Message$=Message$+"<HEAD>"+CRLF$
Message$=Message$+"<TITLE>Chapter 2</TITLE>"+CRLF$
Message$=Message$+"</HEAD>"+CRLF$
Message$=Message$+"<body>"+CRLF$
Message$=Message$+"<h1>Can you use MySQL with Liberty Basic ?</h1>"+CRLF$
Message$=Message$+"<h3>Ofcourse you can !</h3><BR>"+CRLF$
Message$=Message$+"Enjoy !<BR>"+CRLF$
Message$=Message$+"CryptoMan<BR><BR><BR><CODE>"+CRLF$
Message$=Message$+"</CODE>"
Message$=Message$+"<P><A href="+QU$+"http://"+IPstr$+"/INDEX.HTM"+QU$+">Main Page</A>"+CRLF$
Message$=Message$+"<h2>Merry Christmas and Happy New Year !</h2>"+CRLF$
Message$=Message$+"</body>"+CRLF$
Message$=Message$+"</html>"+CRLF$
Call SendPage Message$,CallingSocket
End Sub
Sub SendChap3 Index$,CallingSocket
Message$="<html>"+CRLF$
Message$=Message$+"<HEAD>"+CRLF$
Message$=Message$+"<TITLE>Chapter 3</TITLE>"+CRLF$
Message$=Message$+"</HEAD>"+CRLF$
Message$=Message$+"<body>"+CRLF$
Message$=Message$+"<h1>Please Enter Data in Form and Press [ Submit ]</h1>"+CRLF$
Message$=Message$+"<form name="+QU$+"input"+QU$+"action="+QU$+"PROC1.HTM"+QU$+" method="+QU$+"get"+QU$+">"
Message$=Message$+"First name:"
Message$=Message$+"<input type="+QU$+"text"+QU$+"name="+QU$+"firstname"+QU$+">"
Message$=Message$+"<br>"
Message$=Message$+"Last name:"
Message$=Message$+"<input type="+QU$+"text"+QU$+"name="+QU$+"lastname"+QU$+">"
Message$=Message$+"<br>"
Message$=Message$+"<input type="+QU$+"submit"+QU$+"value="+QU$+"Submit"+QU$+">"
Message$=Message$+"</form>"
Message$=Message$+"</CODE>"
Message$=Message$+"<P><A href="+QU$+"http://"+IPstr$+"/INDEX.HTM"+QU$+">Main Page</A>"+CRLF$
Message$=Message$+"<h2>Merry Christmas and Happy New Year !</h2>"+CRLF$
Message$=Message$+"</body>"+CRLF$
Message$=Message$+"</html>"+CRLF$
Call SendPage Message$,CallingSocket
End Sub
Sub SendProc1 FieldData$,CallingSocket
Message$="<html>"+CRLF$
Message$=Message$+"<HEAD>"+CRLF$
Message$=Message$+"<TITLE>Process 1</TITLE>"+CRLF$
Message$=Message$+"</HEAD>"+CRLF$
Message$=Message$+"<body>"+CRLF$
Message$=Message$+"<h1>Thank You !</h1>"+CRLF$
Message$=Message$+"<BR><BR>"+UPPER$(Left$(FieldData$,INSTR(FieldData$,"&")-1))
Message$=Message$+"<BR><BR>"+UPPER$(Mid$( FieldData$,INSTR(FieldData$,"&")+1))
Message$=Message$+"<BR><BR>"
Message$=Message$+"<P><A href="+QU$+"http://"+IPstr$+"/INDEX.HTM"+QU$+">Main Page</A>"+CRLF$
Message$=Message$+"</body>"+CRLF$
Message$=Message$+"</html>"+CRLF$
Call SendPage Message$,CallingSocket
End Sub
Sub SetButtons
button #window.button01, " Button 1 ", Button01Click, UL, 10, WindowHeight+45, 100, 25
button #window.button02, " Button 2 ", Button02Click, UL, 120,WindowHeight+45, 100, 25
button #window.button03, " Button 3 ", Button03Click, UL, 230,WindowHeight+45, 100, 25
button #window.buttonQt, " Quit ", Quit, UL, 340,WindowHeight+45, 100, 25
End Sub
Sub Button01Click handle$
Notice "Button 1 Title"+chr$(13)+"Button 1 Pressed"+chr$(13)+"Do Whatever..."
End Sub
Sub Button02Click handle$
Notice "Button 2 Title"+chr$(13)+"Button 2 Pressed"+chr$(13)+"Do Whatever..."
End Sub
Sub Button03Click handle$
Notice "Button 3 Title"+chr$(13)+"Button 3 Pressed"+chr$(13)+"Do Whatever..."
End Sub
|
|
|
| Back to top |
|
|
|
|
|
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
You cannot vote in polls in this forum
You cannot attach files in this forum
You can download files in this forum
|
LBDownloads.com and the LBDownloads File Depot hosting proudly sponsored by BanPro NET
Powered by phpBB © 2001, 2002 phpBB Group
|
FAQ
Search
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
