Real CGI EXEs in QB - One method

[dilettante]

The only real obstacle to creating CGI EXEs in compiled QB is a little problem with redirecting standard I/O streams of a 16-bit console EXE under Windows. The standard line from Microsoft on this feels more than a little shoddy, but it works: a 32-bit "shim" or "stub" console application.

While you can probably find such a "stub" written in C, Delphi, etc. I decided to post an all-Basic solution. I got noplace with any version of QB of course - they're all 16-bit. Somebody really ought to do a FreeBasic version of this. There isn't much to it.


I used VB6 though, because I have it handy and I already had the necessary API calls figured out.

modMain.bas

Code:

Option Explicit
'CGIStub32.cgi
'
'This is a 32-bit console stub program that allows a compiled
'16-bit program such as a QuickBasic/VBDOS/etc. program to be
'used as a CGI EXE.
'
'It uses a hack to get around a problem where redirecting
'a 16-bit console program's standard I/O leads to a "hanging
'pipe" condition.
'
'This program may not be bullet-proof, but should work under
'normal conditions.  If the 16-bit program can't be started,
'this program returns the value 1001 (decimal).
'
'The web server must be able to execute a CGI EXE named with
'the extension CGI.
'
'To use a 16-bit CGI named:
'                            FUDD.EXE
'...you place it in the CGI-BIN directory along with a copy
'of *this program*, named:
'                            FUDD.CGI
'
'User URLs will reference FUDD.CGI, not FUDD.EXE (16-bit EXE)
'directly.
'
'This code should be copied into a VB6 project consisting of
'a single standard module.
'
'The program should be compiled with Unattended Execution
'set in the project properties, and after compiling it the
'EXE should be edited using:
'
'       LINK.EXE /EDIT /SUBSYSTEM:CONSOLE CGIStub32.exe
'

Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const INFINITE = -1&
Private Const STARTF_USESHOWWINDOW = &H1
Private Const STARTF_USESTDHANDLES = &H100
Private Const SW_HIDE = 0
Private Const STD_INPUT_HANDLE As Long = -10
Private Const STD_OUTPUT_HANDLE As Long = -11
Private Const STD_ERROR_HANDLE As Long = -12

Private Type STARTUPINFO
    cb As Long
    lpReserved As String
    lpDesktop As String
    lpTitle As String
    dwX As Long
    dwY As Long
    dwXSize As Long
    dwYSize As Long
    dwXCountChars As Long
    dwYCountChars As Long
    dwFillAttribute As Long
    dwFlags As Long
    wShowWindow As Integer
    cbReserved2 As Integer
    lpReserved2 As Long
    hStdInput As Long
    hStdOutput As Long
    hStdError As Long
End Type

Private Type PROCESSINFO
    hProcess As Long
    hThread As Long
    dwProcessID As Long
    dwThreadID As Long
End Type

Private Declare Function GetStdHandle Lib "kernel32" _
    (ByVal HandleType As Long) As Long

Private Declare Function CreateProcessA Lib "kernel32" _
    (ByVal lpApplicationName As String, _
     ByVal lpCommandLine As String, _
     ByVal lpProcessAttributes As Long, _
     ByVal lpThreadAttributes As Long, _
     ByVal bInheritHandles As Long, _
     ByVal dwCreationFlags As Long, _
     ByVal lpEnvironment As Long, _
     ByVal lpCurrentDirectory As String, _
     lpStartupInfo As STARTUPINFO, _
     lpProcessInformation As PROCESSINFO) As Long
      
Private Declare Function WaitForSingleObject Lib "kernel32" _
    (ByVal hHandle As Long, _
     ByVal dwMilliseconds As Long) As Long

Private Declare Function GetExitCodeProcess Lib "kernel32" _
    (ByVal hProcess As Long, _
     lpExitCode As Long) As Long

Private Declare Function CloseHandle Lib "kernel32" _
    (ByVal hObject As Long) As Long

Private Declare Sub ExitProcess Lib "kernel32" _
    (ByVal uExitCode As Long)

Sub Main()
    Dim piProc As PROCESSINFO
    Dim siStart As STARTUPINFO
    Dim strCmd As String
    Dim blnRes As Boolean
    Dim lngRes As Long
    
    siStart.cb = Len(siStart)
    siStart.dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW
    siStart.wShowWindow = SW_HIDE
    siStart.hStdInput = GetStdHandle(STD_INPUT_HANDLE)
    siStart.hStdOutput = GetStdHandle(STD_OUTPUT_HANDLE)
    siStart.hStdError = GetStdHandle(STD_ERROR_HANDLE)
    
    strCmd = App.EXEName & ".exe " & Command$()
    
    blnRes = CreateProcessA(vbNullString, strCmd, 0&, 0&, 1&, _
                            NORMAL_PRIORITY_CLASS, 0&, vbNullString, _
                            siStart, piProc)
    If blnRes Then
        WaitForSingleObject piProc.hProcess, INFINITE
        GetExitCodeProcess piProc.hProcess, lngRes
        Call CloseHandle(piProc.hThread)
        Call CloseHandle(piProc.hProcess)
    Else
        lngRes = 1001
    End If
    ExitProcess lngRes
End Sub

See the comments. You just copy this into a VB6 standard EXE project after deleting the default form module and creating a blank standard module and copying in this code. Then you compile, and relink.

To make linking easier, I offer this script:

LinkConsole.vbs

Code:

Option Explicit
'LinkConsole.vbs
'
'This is a WSH script used to make it easier to edit
'a compiled VB6 EXE using LINK.EXE to create a console
'mode program.
'
'Drag the EXE's icon onto the icon for this file, or
'execute it from a command prompt as in:
'
'        LinkConsole.vbs <EXEpath&file>
'
'Be sure to set up strLINK to match your VB6 installation.

Dim strLINK, strEXE, WSHShell

strLINK = _
  """C:\Program Files\Microsoft Visual Studio\VB98\LINK.EXE"""
strEXE = """" & WScript.Arguments(0) & """"
Set WSHShell = CreateObject("WScript.Shell")

WSHShell.Run _
  strLINK & " /EDIT /SUBSYSTEM:CONSOLE " & strEXE

Set WSHShell = Nothing
WScript.Echo "Complete!"

You only need to compile and relink CGIStub32 once. You can then make a copy of the console EXE as a .CGI for every compiled QB .EXE you want to use as a CGI EXE.

This multiple-copy strategy was used to make it easy for CGIStub32 to figure out what QB EXE to execute. As written, it uses it's own name and just adds .EXE to it.


Simple Example

I had to try it out, of course.

I installed SimpleServer:WWW from AnalogX (a quick Google and you'll easily find this lightweight, free web server for all 32-bit Windows versions). I set up the web root (trivial in SSWWW), created a cgi-bin folder in it.

Then I copied my CGIStub32.exe into cgi-bin as CGI.CGI, and I was ready for my QB EXE.

I used VBDOS, the only compiler for "QB" I had handy. Probably the best too, certainly the latest in the family.

Then I wrote a simple CGI EXE in QB:

CGI.BAS

Code:

OPTION EXPLICIT
DECLARE SUB WriteHeader ()
DECLARE SUB EmitHTML ()
DECLARE FUNCTION GetParam$ (BYVAL PName$)
DECLARE FUNCTION ParseParams (BYVAL Par$) AS INTEGER
DECLARE FUNCTION URIDecode$ (BYVAL URI$)

DIM SHARED PMax AS INTEGER
DIM SHARED Params$(9, 1) 'Up to 10 GET/POST parameters.
DIM PostChars AS INTEGER
DIM PostData$
DIM Script$

IF ENVIRON$("REQUEST_METHOD") = "POST" THEN
  'Script name is typically:
  '            /cgi-bin/name.exe
  'Using SimpleServer:WWW and CGIStub32 it will
  'look like:
  '            /cgi-bin/name.cgi
  Script$ = MID$(ENVIRON$("SCRIPT_NAME"), 2)
  Script$ = MID$(Script$, INSTR(Script$, "/") + 1)
  PostChars = VAL(ENVIRON$("CONTENT_LENGTH"))
  PostData$ = INPUT$(PostChars)
  PMax = ParseParams(PostData$)

  WriteHeader
  RESTORE 800
  EmitHTML
  PRINT GetParam$("a"); " + "; GetParam$("b"); " = ";
  PRINT VAL(GetParam$("a")) + VAL(GetParam$("b"))
  PRINT "<br>"
  PRINT "<a href="""; Script$; """>Play again.</a>"
  RESTORE 900
  EmitHTML
ELSE
  WriteHeader
  RESTORE 100
  EmitHTML
END IF

100
DATA <html>
DATA <head>
DATA </head>
DATA <body>
DATA <form name="frmAdd" method="POST">
DATA "Enter two numbers, submit for the sum:<br>"
DATA <input type="text" name="a" size="5"> A<br>
DATA <input type="text" name="b" size="5"> B<br>
DATA <input type="submit" value="Submit">
DATA </form>
DATA </body>
DATA </html>
DATA $STOP$

800
DATA <html>
DATA <head>
DATA </head>
DATA <body>
DATA $STOP$

900
DATA </body>
DATA </html>
DATA $STOP$

SUB EmitHTML ()
  DIM HTML$

  READ HTML$
  DO
    PRINT HTML$
    READ HTML$
  LOOP UNTIL HTML$ = "$STOP$"
END SUB

FUNCTION GetParam$ (BYVAL PName$)
  DIM P AS INTEGER

  FOR P = 0 TO PMax
    IF Params$(P, 0) = PName$ THEN
      GetParam$ = Params$(P, 1)
      EXIT FOR
    END IF
  NEXT
END FUNCTION

FUNCTION ParseParams (BYVAL Par$) AS INTEGER
  DIM P AS INTEGER
  DIM SSStart AS INTEGER
  DIM SSEnd AS INTEGER

  P = -1
  SSStart = 1
  DO
    SSEnd = INSTR(SSStart, Par$, "=")
    IF SSEnd > 0 THEN
      P = P + 1
      Params$(P, 0) = MID$(Par$, SSStart, SSEnd - SSStart)
      SSStart = SSEnd + 1
      SSEnd = INSTR(SSStart, Par$, "&")
      IF SSEnd = 0 THEN SSEnd = LEN(Par$) + 1
      Params$(P, 1) = URIDecode$(MID$(Par$, SSStart, SSEnd - SSStart))
      SSStart = SSEnd + 1
    END IF
  LOOP UNTIL SSEnd = 0
  ParseParams = P
END FUNCTION

FUNCTION URIDecode$ (BYVAL URI$)
  DIM Dec$
  DIM SSStart AS INTEGER
  DIM SSEnd AS INTEGER

  SSStart = 1
  DO
    SSEnd = INSTR(SSStart, URI$, "+")
    IF SSEnd > 0 THEN
      MID$(URI$, SSEnd, 1) = " "
      SSStart = SSEnd + 1
    END IF
  LOOP UNTIL SSEnd = 0

  SSStart = 1
  Dec$ = ""
  DO
    SSEnd = INSTR(SSStart, URI$, "%")
    IF SSEnd > 0 THEN
      Dec$ = Dec$ + MID$(URI$, SSStart, SSEnd - SSStart)
      Dec$ = Dec$ + CHR$(VAL("&H" + MID$(URI$, SSEnd + 1, 2)))
      SSStart = SSEnd + 3
    END IF
  LOOP UNTIL SSEnd = 0
  URIDecode$ = Dec$ + MID$(URI$, SSStart)
END FUNCTION

SUB WriteHeader ()
  PRINT "Content-type: text/html"
  PRINT
END SUB

I compiled this, and copied CGI.EXE into cgi-bin.

Then I made sure SSWWW was running, and fired up a browser. Next I typed in:

http://localhost/cgi-bin/cgi.cgi

Eureka!

Easy, peasy, one-two-threesy. Dynamic web pages in QB.

What a wacky little project, using "three generations" of MS Basic:

• VBDOS (QB)
  VB6
  VBScript (hosted in WSH)