PC World Komputer 1998 October A/Pcwk10a98.iso/Lotus/LOTUS/SMASTERS/APPROACH/DB2WWW.MPR/SCRIPT/A007ApprGlobObj897.s

Null Bytes Alternating | 1997-01-09 | 182.4 KB | 2,691 lines

'++LotusScript Development Environment:2:5:(Options):0:74
Option Public
'++LotusScript Development Environment:2:5:(Forward):0:1
Declare Sub NextPage
Declare Sub PrevPage
Declare Function GetObjIndex(Objname As String) As Integer
Declare Function GetForms(DocIndex As Integer, frmlist() As String) As Integer
Declare Function GetRpts(DocIndex As Integer, rptlist() As String) As Integer
Declare Function GetDocIndex(AprFile As String) As Integer
Declare Sub CancelWWWAssist
Declare Function GetViewsIndex(ViewName As String, DocIndex As Integer) As Integer
Declare Sub FindAprs
Declare Function GetUserIds(DocIndex As Integer, aryUserId() As String) As Integer
Declare Function GetViewObj(ViewName As String, docindex As Integer) As Variant
Declare Sub CollectObjs(frmName As String, rptName As String)
Declare Sub DoneBtn(dbutton As Variant)
Declare Function Generate(strDatabaseName As String, strUserid As String, strPassword As String, intShowSQL As Integer, strMacroFile As String, strMacroFileSubDirectory As String, strImagesDirectory As String, intMaxRows As Integer, intDBCase As Integer, intSearchType As Integer, strDefaultMessage As String, intFormMethod As Integer, frmForm As Variant, rptReport As Report, strExecutableName As String, arrUserid() As String, intUserid As Integer, intPassword As Integer, WebTemplate As String) As Integer
Declare Function GenerateDefineVars(strDatabaseName As String, strUserid As String, strPassword As String, intShowSQL As Integer, intMaxRows As Integer, intDBCase As Integer, intUserid As Integer, intPassword As Integer ) As Integer
Declare Function CreateHeader As Integer
Declare Function GetSQLAssistant( arrWhereClauses() As String, arrTables() As String, arrColumns() As String, frmForm As Variant )
Declare Function GetJoins(  arrWhereClauses() As String, arrTables() As String, frmForm As Variant, arrUserid() As String ) As Integer
Declare Function SmartAdd( arr() As String, item As String ) As Integer
Declare Function GenerateDefineBegin() As Integer
Declare Function GenerateDefineEnd() As Integer
Declare Function GenerateDefineClauses( intSearchType As Integer, arrWhereClauses() As String, frmForm As Variant, arrTables() As String, arrUserid() As String ) As Integer
Declare Function GenerateDefineTables(arrTables() As String) As Integer
Declare Function GenerateDefineColumns(rptReport As Report, arrColumns() As String, arrUserid() As String) As Integer
Declare Function GenerateHTML_REPORT( strCmdName As String ) As Integer
Declare Function GenerateHTML_INPUT(strMacroFile As String, strMacroFileSubDirectory As String, strImagesDirectory As String,  intShowSQL As Integer, intSearchType As Integer, intFormMethod As Integer, frmForm As Variant, strExecutableName As String, intUserid As Integer, intPassword As Integer, WebTemplate As String) As Integer
Declare Function GetAfterLastSlash( strString As String ) As String
Declare Function GenerateSQL( rptReport As Report, strCmdName As String, strDefaultMessage As String, WebTemplate As String, imagePath As String) As Integer
Declare Function ParseString( arrArray() As String, strString As String) As Integer
Declare Function GetFullTableName( strTableName As String, aryLookup() As String ) As String
Declare Function GenerateDefineClause( control As Variant, arrTables() As String, arrUserid() As String) As Integer
Declare Sub PrintFrmHtml(fileNum As Integer, frmObject As Variant, frmMethod As Integer, frmAction As String, imagePath As String, SearchType As Integer, ShowSQL As Integer,  XtraHtml As String, WebTemplate As String)
Declare Sub PrintFormTitle(numFile As Integer, vartextbox As Variant)
Declare Sub PrintFldBx(numFile As Integer, varfldbx As Variant)
Declare Sub PrintRadioBtn(NumFile As Integer, varrdobtn As Variant)
Declare Sub PrintCbx(numFile As Integer, varCbx As Variant)
Declare Function GetObj(objary As Variant)
Declare Sub SortItByY
Declare Sub GroupRdoBtn
Declare Sub PrintHtmlGood
Declare Function PrintLbx(numFile As Integer, varlbx As Variant)
Declare Sub SortItByX
Declare Sub PrintRptHtml(filenum As Integer, rptObject As Variant, WebTemplate As String, imagePath As String)
Declare Sub PrintFldBx2(numFile As Integer, varfldbx As Variant)
Declare Function PrintPic(numFile As Integer, varpic As Variant, iPath As String)
Declare Function PrintTextBox(numFile As Integer, vartextbox As Variant)
Declare Function htmlString3(vartext As String) As String
Declare Function GetMethod(frmMethod As Integer) As String
Declare Function GetColumns(myTable As Variant)
Declare Sub FindTest
Declare Function PrintDropbx(numFile As Integer, varDropbx As Variant)
Declare Function GetTable(strTablename As String, docindex As Integer) As Variant
Declare Sub PrintSearch(filenum As Integer, Searchtype As Integer)
Declare Function HtmlFntSz(fntSize As Integer) As Integer
Declare Function chkRadioPrinted(objDataField As String) As Integer
Declare Sub PrintActionBtns(numFile As Integer)
Declare Function NoSpaceStr(StrLabelText As String) As String
Declare Sub chkLineNumber(numFile As Integer, objvar As Variant)
Declare Function strLblByPosition(objvar As Variant, txtPos As Integer) As String
Declare Sub PrintShowSQL(filenum As Integer, ShowSQL As Integer)
Declare Function GetTableIndex(strTablename As String, docName As Variant) As Integer
Declare Function htmlString(vartext As String) As String
Declare Function FormatPath(imagepath As String) As String
Declare Function strLblByPosition2(objvar As Variant, txtPos As Integer) As String
Declare Sub ReturnWinTitle
Declare Function ParseUserid(FullTablePath As String) As String
Declare Sub PrintCredits(FileNum As Integer)
Declare Sub GetWebTemplate(PicName As String)
Declare Sub Sub1
Declare Sub QuitAssistant
Declare Function ParseSQLUserid(strSQL As String, aryUserid() As String) As Variant
Declare Function SortByPos(aryPos() As Integer)
Declare Function ReplaceAliases(strSQLOriginal As String, strSQLclause As String) As String

'++LotusScript Development Environment:2:5:(Declarations):0:10

'****************************Variable Declarations**********************************************

'Dim aryFieldnames() As String
Dim ObjSorted () As Variant
Dim lastradio() As String

Dim lastLineNo As Integer 'to keep track of which line we're on in the html doc
Dim CurXCoor As Integer 'to keep track of the current column

Dim aryRadioBtn() As Variant
Dim NumRadioButtons As Integer 'Used while collecting all of the radiobuttons
Dim RadioCounter As Integer ' Used to count through the lastradio array
Dim TotalObjs As Integer 'Used to count the number of objects we selected in GetObj

'*****************************************************************************************************************************
'Front end gui declarations - some of these are placed here to reset the assistant back to current values
'after returning from error table view
Dim gFlagLoaded As Integer
Dim gPageLoaded As Integer
Dim gCurPage As Integer
'These are the actual view that will be passed to db2www macro generator
Dim frmObject As Variant
Dim rptObject As Report

'Things collected from panel 1
Dim DocIndex As Integer
'Collected from panel 2:
Dim WebTemplate As String
'Collected from panel 3:
Dim MacName As String


'***************************************************************************************************
'Following windows functions will be used to set the window title of the WWW Assistant
Declare Function GetActiveWindow Lib "User32" () As Integer
Declare Sub SetWindowTextA Lib "User32" (Byval hWnd As Integer, Byval LpString As String)

'Declare Function SetCursor Lib "user32" Alias "SetCursor" (Byval hCursor As Long) As Long
'***************************************************************************************************

'Dim searchpath As String ' variable used for opening an apr

'Mike's declarations
Dim intMacroFileHandle As Integer


Dim ColorState As Integer

'Busy cursor functions
Declare Function LoadCursorBynum Lib "user32" Alias "LoadCursorA" (Byval hInstance As Long, Byval lpCursorName As Long) As Long
Declare Function SetCursor Lib "user32" Alias "SetCursor" (Byval hCursor As Long) As Long

Public Const IDC_ARROW = 32512&
Public Const IDC_WAIT = 32514&

'For finding browser and readme:
Declare Public Function GetPrivateProfileString Lib"Kernel" (Byval lpName As String, Byval lpKey As Any, Byval lpDefault As String, Byval lpReturn As String, Byval nSize As Integer, Byval lpFile As String) As Integer
Declare Public Function RegOpenKeyExA Lib "advapi32" Alias "RegOpenKeyExA" (Byval HKEY As Long,Byval lpszSubKey As String,Byval dwreserved As Integer,Byval samDesired As Long, keyresult As Long) As Long
Declare Public Function RegQueryValueExA Lib "advapi32" Alias "RegQueryValueExA" (Byval HKEY As Long,Byval lpszValueName As String,Byval dwreserved As Integer, lpdwtype As Long, Byval lpData As String, readbytes As Long) As Long
Declare Public Function RegCloseKey Lib "advapi32" Alias "RegCloseKey" (Byval HKEY As Long) As Long
Declare Public Function GetPrivateProfileStringA Lib "kernel32" Alias "GetPrivateProfileStringA"(Byval AppName As String,Byval KName As Any, Byval Def As String, Byval RStr As String, Byval nSize As Integer, Byval FName As String) As Integer

Dim gInit As Integer 'To determine if file was opened already - a workaround because the docopen event gets called


'++LotusScript Development Environment:2:2:NextPage:1:8
Sub NextPage
    On Error Resume Next
    ThisPage = currentview.currentpagenum
    Currentview.Currentpagenum = ThisPage + 1

    Err = 0
End Sub
'++LotusScript Development Environment:2:2:PrevPage:1:8
Sub PrevPage
    On Error Resume Next
    ThisPage = currentview.currentpagenum
    Currentview.Currentpagenum = ThisPage - 1

    Err = 0
End Sub
'++LotusScript Development Environment:2:1:GetObjIndex:1:8
Function GetObjIndex(Objname As String) As Integer

    'I have to do this to get around a bug with not being able to access objectnames directly
    'This needs to be used with the objectlist collection

    i = 0
    Forall objects In currentview.objectlist
        If Lcase$(currentview.objectlist(i).name) = Objname$ Then
            GetObjIndex = i
            Exit Function
        End If
        i = i + 1
    End Forall
End Function
'++LotusScript Development Environment:2:1:GetForms:1:8
Function GetForms(DocIndex As Integer, frmlist() As String) As Integer
    'This function will return a value that will tell the user if any forms were retrieved.
    'It takes the apr file name as the argument and returns a value to let
    'the user know if any forms were found.



    i = 0
    GetForms = 0
    arycnt = 0
    Redim FrmList(0 To CurrentApplication.Documents(DocIndex).Views.count)

    Forall Views In CurrentApplication.Documents(DocIndex).Views
        If currentApplication.Documents(DocIndex).Views(i).type = $aprForm Then
            FrmList(arycnt) = currentApplication.Documents(DocIndex).Views(i).name
            arycnt = arycnt + 1
            GetForms=1
        End If
        i = i + 1
    End Forall


End Function
'++LotusScript Development Environment:2:1:GetRpts:1:8
Function GetRpts(DocIndex As Integer, rptlist() As String) As Integer
    'This function will return a value that will tell the user if any reports were retrieved.
    'It takes the apr file name as the argument and returns a value to let
    'the user know if any reports were found.

    i = 0
    arycnt = 0
    Redim RptList(0 To CurrentApplication.Documents(DocIndex).Views.count)


    Forall Views In CurrentApplication.Documents(DocIndex).Views
        If currentApplication.Documents(DocIndex).Views(i).type = $aprReport Then
            RptList(arycnt) = currentApplication.Documents(DocIndex).Views(i).name
            arycnt = arycnt + 1
            GetRpts =1
        End If
        i = i + 1
    End Forall


End Function
'++LotusScript Development Environment:2:1:GetDocIndex:1:8
Function GetDocIndex(AprFile As String) As Integer
    'This function takes the name of an apr file
    'And returns the value of the index number where it
    'is located in the base collection documents

    'Need to get the index number of the file we are looking for

    j = 0

    Forall Documents In currentapplication.Documents

        If currentApplication.documents(j).name = AprFile Then
            GetDocIndex = j
        End If
        j = j + 1
    End Forall

End Function
'++LotusScript Development Environment:2:2:CancelWWWAssist:1:8
Sub CancelWWWAssist
    'Closes the assistant form dialog
    On Error Resume Next    'If there are any errors, ignore them and close the assistant
    Call QuitAssistant

End Sub
'++LotusScript Development Environment:2:1:GetViewsIndex:1:8
Function GetViewsIndex(ViewName As String, DocIndex As Integer) As Integer

    'This function will take the view name that we are looking for and the index number of the apr we
    'should look in.
    'This will return the appropriate index number for the view we are looking for.

    i = 0
    Forall views In CurrentApplication.Documents(DocIndex).views
        If CurrentApplication.Documents(DocIndex).views(i).name = ViewName Then
            GetViewsIndex = i
            Exit Function
        End If
        i = i + 1 'Go to the next item in the array
    End Forall

    'If for some reason the view index is not found - return a value that can't be an index:
    GetViewsIndex = -1
End Function
'++LotusScript Development Environment:2:2:FindAprs:1:8
Sub FindAprs

    ' List all approach files in the specified path
    Dim pathName As String, fileName As String
    pathName$ = searchpath$ & "*.apr"
    fileName$ = Dir$(pathName$, 0)

    Do While fileName$ <> ""
        Print fileName$
        CurrentView.objectlist(0).addlistitem filename$
        fileName$ = Dir$()
    Loop
End Sub
'++LotusScript Development Environment:2:1:GetUserIds:1:8
Function GetUserIds(DocIndex As Integer, aryUserId() As String) As Integer
    'This function will take the Document index of the document selected by the user,
    'and go through to provide all of the tablenames and userids for that document
    'Return value will indicate if this was successfully done or not.
    Dim i%, numtables%, querystate As Integer
    Dim myTables As BaseCollection
    Dim tbl_UserId As String
    Dim rs As resultset

    Const constTable = True
    Const constSQL = False

    i = 0
    GetUserIds = 0 'initially 0 - not done
    'Determine first if we have an apr that is the result of the SQL assistant
    ' or has full tables:
    Set myTables = CurrentApplication.Documents(DocIndex).tables
    Set rs = myTables(i).createresultset
    If rs.query.sql = "" Then
        'Must have tables instead
        QueryState = constTable
    Else
        QueryState = constSQL
    End If

    If QueryState Then

        numTables = myTables.count
        Redim aryUserId(0 To numTables, 0 To 1)
        Forall tables In myTables
            Set rs = myTables(i).createresultset 'Create result set for the current table
            tbl_UserId = ParseUserid(rs.query.tablename)
            aryUserId(i, 0) = tbl_UserId 'store the userid
            aryUserId(i, 1) = myTables(i).tablename 'store the table name
            i = i + 1
        End Forall
    Else
        Call ParseSQLUserid(RS.Query.SQL, aryUserid())
    End If





    GetUserIds = 1 'Finished

End Function
'++LotusScript Development Environment:2:1:GetViewObj:1:8
Function GetViewObj(ViewName As String, docindex As Integer) As Variant
    'Return the view that we're looking for

    Forall views In CurrentApplication.Documents(docindex).views
        If views.name = ViewName Then
            Set GetViewObj = views
            Exit Function
        End If
    End Forall
    'If we don't find the view return an error:
    GetViewObj = -1

End Function
'++LotusScript Development Environment:2:2:CollectObjs:1:8
Sub CollectObjs(frmName As String, rptName As String)
    Set frmObject = GetViewObj(frmName, DocIndex)
    Set rptObject = GetViewObj(rptName, DocIndex)
End Sub
'++LotusScript Development Environment:2:2:DoneBtn:1:8
Sub DoneBtn(dbutton As Variant)
    'Clear any previous errors
    Err = 0
    On Error Goto gnrlError    'Area for handling general errors from here on out...
    Dim waitcursor As Long
    Dim arrowcursor As Long
    Dim prevcursor As Long

    waitcursor = LoadCursorBynum(0, IDC_WAIT)
    arrowcursor = LoadCursorBynum(0, IDC_ARROW)

    prevcursor = SetCursor(waitcursor)



    Dim aryUserId() As String
    Dim ClearIt(0) As String
    'The done button is available on the last three panels
    'Retreive the current values from all the last three panels
    'And doublecheck that the macro file doesn't already exist
    '*********Place values from Panel 3 into global variables:



'Front End (GUI) Declarations
    'From Panel 2


'Things collected from panel 2
    Dim FormSelected As String 'This will hold the name of the form selected
    Dim RptSelected As String 'This will hold the name of the report selected
    Dim RptAsForm As Integer 'This will tell us if user wants to use the report as the html form

'Things that will get retreived from panel 3
    Dim strUserid As String
    Dim strPswd As String
    Dim Pswd_Opt As Integer    'This is the variable that indicates prompt or always use for password
    Dim Userid_opt As Integer    'This is the variable that indicates prompt or always use for userid
    Dim dbname As String
    Dim macname As String 'This is where we'll store the path and name of the macro file

'Things that will get retreived from panel 4
    Dim ShowSearch As Integer
    Dim ShowSql As Integer
    Dim NumRows As Integer 'The number of rows to return in the report

'Things that will get retreived from panel 5
    Dim imagepath As String
    Dim macpath As String
    Dim exename As String
    Dim case_conv As Integer
    Dim FormMethod As Integer

    'Grey out the done button

    dbutton.font.color.setrgb color_30_gray

    '*******************************************Start Retreiving Values*************************************************************************8
    'Retreive values from panel 2:
    With CurrentDocument.WWW~ Assistant.body
        rptAsForm = Val(.cbxRptAsForm.value)
        If rptAsForm = 1 Then
            FormSelected =  .lbReportsP2.text
        Else
            FormSelected = .lbformsP2.text
        End If
        RptSelected = .lbReportsP2.text
    End With

    'Retreive values from panel 3:
    With CurrentDocument.WWW~ Assistant.body
        MacName$ = .txtMacName.text
        strUserid = .txtUserid.text
        strPswd  = .txtPswd.text
        Pswd_Opt = Val(.cbxPromptPswd.value)
        Userid_opt = Val(.cbxPromptUserid.value)
        dbname = .txtDbName.text
        'Make sure that we have a database name
        If dbname=""  Then' No database name was entered
            dbname = Inputbox("You must enter a valid database name", "Enter Database Name",,300, 300)
            If dbname=""  Then  'Empty string means cancel
                dbutton.font.color.setrgb color_black
                Exit Sub
            Else
                .txtDbName.text = dbname
            End If
        End If

    End With


    'Let's check if the macro file already exists so that we don't accidentally overwrite something the user may want to keep:
    On Error Goto whatnow
    If Dir$(MacName$) <>"" Then
        Beep 'If we find it warn the user
        answ% = Messagebox("Do you want to overwrite the existing macro file " & Chr(10) & MacName$ & "?", 4 + 16 + 256 + 0, "Macro File Exists") 'the default in the msgbox is NO
        If answ% <> 6 Then 'If they don't choose YES,
            MacName$ = Inputbox("Macro file name", "MacroFile",CurrentDocument.path & "myMacro.d2w",200,200)  'If they choose NO get a new macro file name
            If MacName$="" Then 'user chose cancel
                dbutton.font.color.setrgb color_black
                Exit Sub
            End If
        End If
    End If
    'Check that there is a drive letter:
    If Mid$(MacName$,2, 1) <> ":" Then
        strPath$=Inputbox("Please enter a valid drive letter:", "Error Creating Macro File", "C:",300, 300)
    End If
    MacName$=strPath$ + MacName$

    'Check that the third character in the macro name is a backslash:
    If Mid$(MacName$,3, 1) <> "\" Then
        MacLeft$ = Left$(MacName$, 2)
        MacRight$ = Right(MacName$, Len(MacName$) - 2)
        MacName$ = MacLeft$ + "\" + MacRight$
    End If

    'Retreive the values from panel 4:
    With CurrentDocument.WWW~ Assistant.body
        ShowSearch = Val(.rdoSearchPrompt.value) ' value for the group of radio buttons
        ShowSql  = Val(.rdoSqlPrompt.value)
        NumRows  =  Val(.txtNumRows.text)  'The number of rows to return in the report
    End With

    'Retreive the values from panel 5:

    With CurrentDocument.WWW~ Assistant.body
        imagepath  =FormatPath( .txtImagePath.text)

        macpath  = .txtMacroPath.text
        exename  = .txtExeName.text
        case_conv = Val(.rdoNoConvert.value) 'This will provide the value for the group of radio buttons
        FormMethod  = Val(.rdoFormPost.value) ''This will provide the value for the group of radio buttons
    End With

    'Reset values in the assistant:
    With CurrentDocument.WWW~ Assistant.body
        .lbopenapps.setlist(ClearIt)
        .lbformsP2.background.color.setrgb color_white
        .lbformsP2.readonly = False
    End With



    prevcursor = SetCursor(waitcursor)

    'Retreive the userids for all of the tables
    Call GetUserids(DocIndex, aryUserid)

    'Get the form and report objects:

    Call CollectObjs(formSelected, RptSelected)

    'Get the default Message
    Dim strDefaultMsg As String
    Dim myRs As Resultset
    Set myRs = CurrentDocument.tables(0).createresultset
    myRs.firstrow
    strDefaultMsg = myRs.GetValue("defaultMsg")

'Call the "Back end"

    rc = Generate(dbname, strUserid, strPswd, ShowSQL, MacName$, macpath, imagepath, NumRows, case_conv, ShowSearch, strDefaultMsg, FormMethod, frmObject, rptObject, exeName, aryUserid, Userid_Opt, Pswd_opt, WebTemplate )
    If rc <>-2 Then
        rval = Messagebox ("DB2 WWW macro: " & MacName$ & " created successfully!", MB_OK + MB_ICONEXCLAMATION, "DB2 Web Sizing Assistant")
        Err=0
    Else 'This means the file could not be opened for some reason so reload the assistant:
        Set CurrentWindow.Activeview= Currentdocument.www~ assistant
        currentview.currentpagenum = 3
        Exit Sub
    End If
    'Close the assistant dialogue

    Call QuitAssistant()

%REM
    If CurrentApplication.ApplicationWindow.IsCommandEnabled(IDM_SAVE) Then
        Sendkeys "{tab}~",0
    End If
    'CurrentApplication.visible = True


    'CurrentApplication.db2www.window.close
%END REM
    prevcursor = SetCursor(arrowcursor)

Whatnow:
    If Error$ = "Path not found" Then
        Msgbox "Path not found" & Chr(10) & "Please enter valid path and filename",,"Error"
        Err=0    'Reset the current error to nothing!
        Currentview.currentpagenum = 3
        dbutton.font.color.setrgb color_black
        Exit Sub
    End If

gnrlError:
    If Err<>0 Then
        Msgbox "The following Lotus Script error occured: " & Chr(10) & Error$, ,"Lotus Script Error"
        Msgbox "The Web Sizing Assistant will close", ,"Lotus Script Error"
        CurrentApplication.activedocwindow.close    'Close the dialog
        CurrentApplication.applicationwindow.domenucommand(IDM_CLOSEANDDISC) 'close the document
        End
    End If
End Sub
'++LotusScript Development Environment:2:1:Generate:1:8
Function Generate(strDatabaseName As String, strUserid As String, strPassword As String, intShowSQL As Integer, strMacroFile As String, strMacroFileSubDirectory As String, strImagesDirectory As String, intMaxRows As Integer, intDBCase As Integer, intSearchType As Integer, strDefaultMessage As String, intFormMethod As Integer, frmForm As Variant, rptReport As Report, strExecutableName As String, arrUserid() As String, intUserid As Integer, intPassword As Integer, WebTemplate As String) As Integer
    Dim rc As Integer 'Return Code
    Dim arrWhereClauses(100) As String
    Dim arrTables(100) As String
    Dim arrColumns(100) As String

    'Initialize the WhereClauses and Tables collections
    arrWhereClauses(0) = "0"
    arrTables(0) = "0"

    'Open the Macro File for Write Access
    intMacroFileHandle = Freefile()
    On Error Goto Whatnow
    Open strMacroFile For Output Access Write Lock Write As intMacroFileHandle

    'Get SQL Assistant parts (where clauses, orders, groups)
    rc = GetSQLAssistant( arrWhereClauses, arrTables, arrColumns, frmForm )

    'Get Join Information
    rc = GetJoins( arrWhereClauses, arrTables, frmForm, arrUserid )

    'Create Header Information
    rc = CreateHeader()

    'Create a DEFINE section
    rc = GenerateDefineBegin()
    rc = GenerateDefineVars( strDatabaseName, strUserid, strPassword, intShowSQL, intMaxRows, intDBCase, intUserid, intPassword )
    rc = GenerateDefineClauses(  intSearchType, arrWhereClauses, frmForm,  arrTables, arrUserid )
    'Rewritten on 12/17/96 -gf
    'rc = GenerateDefineTables(  arrTables )
    rc = GenerateDefineTables(arrUserid)
    rc = GenerateDefineColumns( rptReport, arrColumns, arrUserid )
    rc = GenerateDefineEnd()

    'Create an SQL section
    rc = GenerateSQL( rptReport, "sql1",  strDefaultMessage, WebTemplate, strImagesDirectory)

    'Create an HTML_INPUT section
    rc = GenerateHTML_INPUT( strMacroFile, strMacroFileSubDirectory, strImagesDirectory, intShowSQL, intSearchType, intFormMethod, frmForm, strExecutableName, intUserid, intPassword , WebTemplate)

    'Create an HTML_REPORT section
    rc = GenerateHTML_REPORT( "sql1" )

    'Close the macro file
    Close intMacroFileHandle

    Generate = rc
Whatnow:
    If Error="Unable to open file" Or Error = "Path not found" Then
        Msgbox "Unable to open file",, "Error Opening Macro File"
        Generate = -2
        Err=0 'Reset the error code
        Exit Function
    End If
End Function
'++LotusScript Development Environment:2:1:GenerateDefineVars:1:8
Function GenerateDefineVars(strDatabaseName As String, strUserid As String, strPassword As String, intShowSQL As Integer, intMaxRows As Integer, intDBCase As Integer, intUserid As Integer, intPassword As Integer ) As Integer
    Dim rc As Integer

    rc = 0

    'First, let's set some simple variables
    Print #intMacroFileHandle, ,"DATABASE=", """" strDatabaseName """"

    Select Case intUserid
    Case 0 : 'Prompt the User
        'Do nothing here.  We will add an input field on the form
    Case 1 : 'Hard-code the value passed in
        Print #intMacroFileHandle, ,"LOGIN=",  """" strUserid """"
    End Select

    Select Case intPassword
    Case 0 : 'Prompt the User
        'Do nothing here.  We will add an input field on the form
    Case 1 : 'Hard-code the value passed in
        Print #intMacroFileHandle, ,"PASSWORD=", """" strPassword """"
    End Select

    Print #intMacroFileHandle, ,"RPT_MAX_ROWS=", """" Trim$(Str$(intMaxRows)) """"

    Select Case intShowSQL
    Case 0 : 'Prompt the User
        'Do nothing here.  We will add an input field on the input form.
    Case 1 : 'Always On
        Print #intMacroFileHandle, ,"SHOWSQL=", """YES"""
    Case 2 : 'Always Off
        Print #intMacroFileHandle, ,"SHOWSQL=", """NO"""
    Case Else :
        rc = 999
    End Select

    Select Case intDBCase
    Case 0 : 'Do not set the variable -- no conversion
        'Do nothing here.
    Case 1 : 'Convert to lower case
        Print #intMacroFileHandle, ,"DB_CASE=", """LOWER"""
    Case 2 : 'Convert to upper case
        Print #intMacroFileHandle, ,"DB_CASE=", """UPPER"""
    Case Else :
        rc = 998
    End Select

    GenerateDefineVars = rc
End Function
'++LotusScript Development Environment:2:1:CreateHeader:1:8
Function CreateHeader As Integer
    CreateHeader = 0

    Print #intMacroFileHandle, "%{"
    Print #intMacroFileHandle, "This macro file was generated by the DB2 Web Sizing Assistant for Lotus Approach"
    Print #intMacroFileHandle,  "on " Date$ " at " Time$ "."
    Print #intMacroFileHandle, "%}"
    Print #intMacroFileHandle,

End Function
'++LotusScript Development Environment:2:1:GetSQLAssistant:1:8
Function GetSQLAssistant( arrWhereClauses() As String, arrTables() As String, arrColumns() As String, frmForm As Variant )
    Dim rs As ResultSet
    Dim strSQL As String
    Dim strColumns As String
    Dim strTables As String
    Dim strClauses As String
    Dim i,j As Integer

    Set rs = frmForm.Document.Tables(0).CreateResultSet()
    strSQL = rs.Query.SQL

    If( strSQL<> "" ) Then

        strColumns = ""
        strTables = ""
        strClauses = ""

        i = Instr( strSQL, " FROM " )
        'Commented out on12/17/96
        'strColumns = Mid$( strSQL, 8, i-9 ) 'Everything between "SELECT " and "FROM"
        j = Instr( i+5, strSQL, " WHERE " )
        If( j=0 ) Then
            j = Instr( i+5, strSQL, " ORDER " )
        End If
        If( j<>0 ) Then
            strTables = Mid$( strSQL, i+5, j -i-6) 'Everything between "FROM" and "WHERE"
            'Need to  replace aliases in the following string: 12/17/96 -gf
            strClauses = Mid$( strSQL, j+6 )
            strClauses = ReplaceAliases(strSQL, strClauses)
        End If
        'Commented out on 12/17/96 -gf
        'rc = ParseString( arrColumns, strColumns )
        rc = ParseString( arrTables, strTables )
        rc = ParseString( arrWhereClauses, strClauses )
    End If

    GetSQLAssistant = 0
End Function
'++LotusScript Development Environment:2:1:GetJoins:1:8
Function GetJoins(  arrWhereClauses() As String, arrTables() As String, frmForm As Variant, arrUserid() As String ) As Integer
    Dim joins As Variant
    Dim strTable1 As String
    Dim strTable2 As String
    Dim strWhereClause As String
    Dim intJoinIndx, i, intNumJoins As Integer

    GetJoins = 0

    intJoinIndx = -1
    joins = frmForm.Parent.JoinsInternal

    'If there is join information, then the IsArray function will return TRUE.  Otherwise, it will return FALSE.
    If( Isarray(joins)  ) Then
        While( intJoinIndx < Ubound(joins))
            intJoinIndx = intJoinIndx + 1
            strTable1 = GetFullTableName( frmForm.Parent.Tables(Val(joins(intJoinIndx))).TableName, arrUserid ) 'Val added by Grace to convert string to numeric value
            rc = SmartAdd( arrTables, strTable1 )
            intJoinIndx = intJoinIndx + 1
            strTable2 = GetFullTableName( frmForm.Parent.Tables(Val(joins(intJoinIndx))).TableName, arrUserid )
            intJoinIndx = intJoinIndx + 1
            rc = SmartAdd( arrTables, strTable2 )
            intNumJoins =Val(joins(intJoinIndx))
            For i=1 To intNumJoins
                intJoinIndx = intJoinIndx + 1
                strWhereClause = strTable1 +  "." + joins(intJoinIndx) +  "=" + strTable2 + "." +  joins(intJoinIndx+1)
                rc = SmartAdd( arrWhereClauses,  strWhereClause )
                intJoinIndx = intJoinIndx + 1
            Next
        Wend
    End If

End Function
'++LotusScript Development Environment:2:1:SmartAdd:1:8
Function SmartAdd( arr() As String, item As String ) As Integer
    Dim found As Integer

    found = False
    i  = 1
    While (Not found) And ( i <= Val( arr(0) ) )
        If arr(i) = item Then
            found = True
        Else
            i = i + 1
        End If
    Wend

    If Not found Then
        arr(0) = Str$( Val( arr(0) ) + 1 )
        arr( Val( arr(0) ) ) = Trim$(item)
    End If

End Function
'++LotusScript Development Environment:2:1:GenerateDefineBegin:1:8
Function GenerateDefineBegin() As Integer

    Print #intMacroFileHandle, "%DEFINE{"

    GenerateDefineBegin = 0
End Function
'++LotusScript Development Environment:2:1:GenerateDefineEnd:1:8
Function GenerateDefineEnd() As Integer

    Print #intMacroFileHandle, "%}"

    GenerateDefineEnd = 0
End Function
'++LotusScript Development Environment:2:1:GenerateDefineClauses:1:8
Function GenerateDefineClauses( intSearchType As Integer, arrWhereClauses() As String, frmForm As Variant, arrTables() As String, arrUserid() As String ) As Integer
    Dim rc As Integer
    Dim i,j As Integer
    Dim intRadioFound As Integer
    Dim aryRadioNames(100) As String

    rc = 0

    Print #intMacroFileHandle,

    'The AndOr variable is the "connector" for the where clauses
    'used via user-input on the input form.
    Select Case intSearchType
    Case 0 : 'Prompt the User
        'Do nothing here.  We will add an input field on the input form.
    Case 1 : 'Always On
        Print #intMacroFileHandle, ,"ANDOR=", """AND"""
    Case 2 : 'Always Off
        Print #intMacroFileHandle, ,"ANDOR=", """OR"""
    Case Else :
        rc = 999
    End Select

    'The c2 variable is a list variable which will be instantiated
    'by input criteria selected on the input form.
    Print #intMacroFileHandle, ,"%LIST "" $(ANDOR) "" c2"

    'The c1 variable is a list variable which will be instantiated
    'by clauses from the SQL Assistant and the Joins
    Print #intMacroFileHandle, ,"%LIST "" AND "" c1"
    Print #intMacroFileHandle,

    For i=1 To  Val( arrWhereClauses(0) )
        Print #intMacroFileHandle, ,"c1 = """ arrWhereClauses(i) """"
    Next

    Print #intMacroFileHandle,
    Print #intMacroFileHandle, ,"wc2 = ? ""WHERE $(c2)"""
    Print #intMacroFileHandle, ,"andc2 = ? ""AND ($(c2))"""

    Print #intMacroFileHandle, ,"WHERELIST = c1 ? ""WHERE $(c1) $(andc2)"" : ""$(wc2)"""
    Print #intMacroFileHandle,

    'For each input control that maps to a database field on the input form,
    'add a conditional clause that assigns a value to the c2 variable
    For i=0 To frmForm.ObjectList.Count - 1
        Select Case frmForm.ObjectList(i).Type
        Case $AprFieldBox, $AprCheckBox, $AprListBox, $AprDropDownBox :
            If frmForm.ObjectList(i).DataTable <> "" Then
                rc = GenerateDefineClause( frmForm.ObjectList(i), arrTables, arrUserid )
            End If
        'Each radio button on the form is considered a separate control.  However, we only want to
        'add an assignment statement to the macro file once per "group" of buttons (all which map to the same datafield)"
        Case $AprRadioButton :
            If frmForm.ObjectList(i).DataTable <> "" Then
                intRadioFound = False
                'Loop through the RadioNames array to see if we have hit this datafield before
                j=0
                While  (j <= intRadioIndex) And (Not intRadioFound)
                    If aryRadioNames(j) = frmForm.ObjectList(i).DataField Then
                        intRadioFound = True
                    Else
                        j = j + 1
                    End If
                Wend
                'If we have not seen this datafield, then add an assignment statement
                If Not intRadioFound Then
                    intRadioIndex = intRadioIndex + 1
                    aryRadioNames(intRadioIndex) = frmForm.ObjectList(i).DataField
                    rc = GenerateDefineClause( frmForm.ObjectList(i), arrTables, arrUserid )
                End If
            End If
        Case Else :
            'Do nothing
        End Select
    Next

    GenerateDefineClauses = rc
End Function
'++LotusScript Development Environment:2:1:GenerateDefineTables:1:8
Function GenerateDefineTables(arrTables() As String) As Integer
    Dim rc As Integer

    rc=0

    'Create the TABLES list variable and populate it.
    Print #intMacroFileHandle,
    Print #intMacroFileHandle, ,"%LIST "",""  TABLES"

%REM re-written on 12/17/96 -gf
    For i=1 To Val( arrTables(0) )
        Print #intMacroFileHandle, ,"TABLES  =  """ arrTables(i) """"
    Next
%END REM

    For i = 0 To Ubound(arrTables) 'added on 1/16/97 to fix Senan's bug
        If (arrTables(i,0) & arrTables(i,1)) <> "" Then 'check that these elements aren't empty first
            Print #intMacroFileHandle, ,"TABLES  =  """ arrTables(i,0) & "." & arrTables(i,1) """"
        End If

    Next
    GenerateDefineTables = rc
End Function
'++LotusScript Development Environment:2:1:GenerateDefineColumns:1:8
Function GenerateDefineColumns(rptReport As Report, arrColumns() As String, arrUserid() As String) As Integer
    Dim rc As Integer
    Dim i As Integer

    rc=0

    'Create the COLUMNS list variable and populate it.
    Print #intMacroFileHandle,
    Print #intMacroFileHandle, ,"%LIST "",""  COLUMNS"

    For i=0 To rptReport.ObjectList.Count - 1
        Select Case rptReport.ObjectList(i).Type
        Case $AprFieldBox, $AprCheckBox :
            If rptReport.ObjectList(i).DataTable <> "" Then
                rc = SmartAdd( arrColumns, GetFullTableName( rptReport.ObjectList(i).DataTable, arrUserid ) & "." & Ucase$(rptReport.ObjectList(i).DataField ))
            End If
        Case Else :
            'Do nothing
        End Select
    Next

    For i=1 To Val( arrColumns(0) )
        Print #intMacroFileHandle, ,"COLUMNS  =  """ arrColumns(i) """"
    Next

    GenerateDefineColumns = rc
End Function
'++LotusScript Development Environment:2:1:GenerateHTML_REPORT:1:8
Function GenerateHTML_REPORT( strCmdName As String ) As Integer
    Dim rc As Integer

    rc=0

    Print #intMacroFileHandle,
    Print #intMacroFileHandle, "%HTML_REPORT{"
    'Print #intMacroFileHandle, "<HTML>"
    Print #intMacroFileHandle, "%EXEC_SQL(" strCmdName ")"
    'Print #intMacroFileHandle, "</HTML>"
    Print #intMacroFileHandle, "%}"

    GenerateHTML_REPORT = rc

End Function
'++LotusScript Development Environment:2:1:GenerateHTML_INPUT:1:8
Function GenerateHTML_INPUT(strMacroFile As String, strMacroFileSubDirectory As String, strImagesDirectory As String,  intShowSQL As Integer, intSearchType As Integer, intFormMethod As Integer, frmForm As Variant, strExecutableName As String, intUserid As Integer, intPassword As Integer, WebTemplate As String) As Integer
    Dim rc As Integer 'Return Code
    Dim strFormMethod As String
    Dim strAction As String
    Dim strMacroName As String
    Dim strExtraFields As String
    rc = 0

    If intFormMethod = 0 Then
        strFormMethod = "POST"
    Else
        strFormMethod= "GET"
    End If

    strMacroName = GetAfterLastSlash( strMacroFile )

    If strMacroFileSubDirectory = "" Then
        strAction = strExecutableName & "/" & strMacroName & "/report"
    Else
        strAction = strExecutableName & "/" & strMacroFileSubDirectory & "/" & strMacroName & "/report"
    End If

    strExtraFields = ""

    If intUserid = 0 Then
        strExtraFields = strExtraFields & "<Font Size=2>Userid: <INPUT TYPE=""text"" NAME=""LOGIN""><br>"
    End If

    If intPassword = 0 Then
        strExtraFields = strExtraFields & "<Font Size=2>Password: <INPUT TYPE=""password"" NAME=""PASSWORD""><br>"
    End If

    If intSearchType = 0 Then
        strExtraFields = strExtraFields & "<Font Size=2>Search Type: <INPUT TYPE=""radio"" NAME=""ANDOR"" VALUE="" AND "" CHECKED> And <INPUT TYPE=""radio"" NAME=""ANDOR"" VALUE="" OR "" > Or <br>"
    End If

    If ( intShowSQL = 0 ) Then
        strExtraFields = strExtraFields & "<Font Size=2>Show SQL Statement: <INPUT TYPE=""radio"" NAME=""SHOWSQL"" VALUE=""YES""> Yes <INPUT TYPE=""radio"" NAME=""SHOWSQL"" VALUE=""NO""  CHECKED> No <br>"
    End If

    'Add some space between these added fields and the rest of the input form.
    If( strExtraFields <> "" ) Then
        strExtraFields = strExtraFields & "<P>"
    End If

    Print #intMacroFileHandle,
    Print #intMacroFileHandle, "%HTML_INPUT{"

'    Print #intMacroFileHandle, SaveViewAsHTML( frmForm, strFormMethod, strAction, strExtraFields )

    Call  PrintFrmHtml(intMacroFileHandle, frmForm, intFormMethod, strAction , strImagesDirectory, 1,1, strExtraFields, WebTemplate ) 'Note: image directory must have forward slash

    Print #intMacroFileHandle, "%}"

    GenerateHTML_INPUT = rc
End Function
'++LotusScript Development Environment:2:1:GetAfterLastSlash:1:8
Function GetAfterLastSlash( strString As String ) As String
    Dim intLastSlash As Integer
    Dim begin, temp As Integer

    intLastSlash = 0
    begin = 1

    Do
        temp = Instr( begin, strString, "\" )
        If( temp > intLastSlash ) Then
            intLastSlash = temp
            begin = temp + 1
        End If
    Loop Until (temp=0)

    GetAfterLastSlash = Mid$( strString, intLastSlash+1 )

End Function
'++LotusScript Development Environment:2:1:GenerateSQL:1:8
Function GenerateSQL( rptReport As Report, strCmdName As String, strDefaultMessage As String, WebTemplate As String, imagePath As String) As Integer
    Dim rc As Integer
    Dim i As Integer
    Dim rs As ResultSet
    Dim intNumRows As Integer
    Dim strErrorCode As String
    rc=0

    Print #intMacroFileHandle,
    Print #intMacroFileHandle, "%SQL(" strCmdName ") {"
    Print #intMacroFileHandle, ,"SELECT $(COLUMNS) FROM $(TABLES) $(WHERELIST)"

    'Generate the SQL_REPORT section, which includes converting the Approach form to HTML


    Call PrintRptHtml(intMacroFileHandle, rptReport, WebTemplate, imagePath)

    'Print the SQL Message Section, if necessary

    'Set rs = CurrentDocument.Tables(0).CreateResultSet()    Commented out and modiified by Grace 7/19 - app tried to create rs from the wrong apr
    Set rs = CurrentDocument.Tables(0).CreateResultSet()

    intNumRows = rs.NumRows()
    If (intNumRows > 0) Or (Trim$(strDefaultMessage) <> "") Then  'Trim added on 7/23 by G.
        rs.FirstRow
        chkEmpty$ = rs.GetValue("ErrorCode")
        If chkEmpty$ <> "" Then
            Print #intMacroFileHandle, "%SQL_MESSAGE{"

            For i=1 To intNumRows
                strErrorCode = rs.GetValue("ErrorCode")

            'There is a bug in db2www where it considers ":Exit" following a negative error code to
            'be an error.  Until this is fixed, we must ignore the action for negative return codes to
            'avoid the syntax error message is fixed.  Once the db2www bug is fixed, this if test
            'can be removed and the "Else" condition should always be executed.
                If( Left$(strErrorCode, 1) = "-" ) Then
                    Print #intMacroFileHandle, strErrorCode " : " """" rs.GetValue("Message") """"
                Else
                    Print #intMacroFileHandle, strErrorCode " : " """" rs.GetValue("Message") """" rs.GetValue("SQL_Action")
                End If


                rs.NextRow
            Next

            'If a Default Message was specified (it is not NULL) then print it in the SQL_Message section
            If( strDefaultMessage <> "" ) Then
                Print #intMacroFileHandle, "default : " """" strDefaultMessage """"
            End If
            Print #intMacroFileHandle, "%}"
        End If
    End If


    Print #intMacroFileHandle, "%}"

    GenerateSQL = rc
End Function
'++LotusScript Development Environment:2:1:ParseString:1:8
Function ParseString( arrArray() As String, strString As String) As Integer
    Dim rc As Integer
    Dim temp As Integer

    rc= 0

    Do
        temp = Instr( strString, "," )
        If temp = 0 Then
            rc = SmartAdd( arrArray, strString )
        Else
            rc = SmartAdd( arrArray, Left$(strString, temp-1)    )
            strString = Right$( strString, Len(strString) - temp )
        End If
    Loop Until (temp=0)

    ParseString = rc
End Function
'++LotusScript Development Environment:2:1:GetFullTableName:1:8
Function GetFullTableName( strTableName As String, aryLookup() As String ) As String
    Dim i As Integer

    GetFullTableName = ""

    i=0
    While( (aryLookup(i,1) <> strTableName) And (aryLookup(i,1) <> "") )
        i = i+1
    Wend
    GetFullTableName =  aryLookup(i,0) & "." & aryLookup(i,1)

End Function
'++LotusScript Development Environment:2:1:GenerateDefineClause:1:8
Function GenerateDefineClause( control As Variant, arrTables() As String, arrUserid() As String) As Integer
    Dim rc As Integer
    Dim strFullTableName As String
'    Dim rs As ResultSet
'    Dim i As Integer
    Dim strVariableName As String
    rc=0

    strFullTableName = GetFullTableName( control.DataTable, arrUserid )
    rc = SmartAdd( arrTables,  strFullTableName )   'Add to the list of Tables

'    i=0
'    While( ( i < control.Parent.Parent.Document.Tables.Count ) And ( control.Parent.Parent.Document.Tables(i).Tablename <> control.DataTable ) )
'        i = i+1
'    Wend

'    Set rs = control.Parent.Parent.Document.Tables(i).CreateResultSet()

'    Select Case rs.FieldNativeDataType( control.DataField )
    'Print control.DataTable "." control.DataField control.Parent.Parent.Document.Tables(i).GetFieldType( control.DataField )
'    Forall elements In currentapplication.documents(0).tables(0).fieldnames
'        Ftype= currentapplication.documents(0).tables(0).getfieldtype(elements)
'        Print Ftype
'    End Forall

    strVariableName = control.DataTable + "_" + control.DataField
'    Select Case control.Parent.Parent.Document.Tables(i).GetFieldType( control.DataField )
'    Case SQL_CHAR, SQL_VARCHAR, SQL_DATE, SQL_TIME : 'Prompt the User
'    Case aprFieldText, aprFieldDate, aprFieldTime : 'Prompt the User
    Print #intMacroFileHandle, ,"c2 = ? """  strFullTableName "." control.DataField " LIKE '%$(" strVariableName ")%'"""
'    Case Else :
'        Print #intMacroFileHandle, ,"c2 = ? """  strFullTableName "." control.DataField " = $(" strVariableName ")"""
'    End Select


    GenerateDefineClause = rc
End Function
'++LotusScript Development Environment:2:2:PrintFrmHtml:1:8
Sub PrintFrmHtml(fileNum As Integer, frmObject As Variant, frmMethod As Integer, frmAction As String, imagePath As String, SearchType As Integer, ShowSQL As Integer,  XtraHtml As String, WebTemplate As String)
    Dim lStr, rStr As String
    aryCounter = 0
    flag = 0
    radioCounter = 0


    'Store the objects in an array
    Call GetObj(frmObject.objectlist)    'The form I picked
    'To be used to get best-guess datafield for dropdownboxes and listboxes
    'GetColumns(frmObject.parent.tables(GetTableIndex(frmObject.maintable, frmObject.parent))) 'need to adjust
    'Sort the array by its y coordinate first
    SortItByY
    'Now let's split the objects line by line and sort by x coordinate
    SortItByX
    'Have to group the radiobuttons in order to group them correctly in the cells
    GroupRdoBtn
    Redim lastradio(0 To numRadioButtons)

    'Determine the form method first:
    frmMethodstr = GetMethod(frmMethod)




    Print #fileNum%,"<HTML>"
    Print #fileNum%, "<Head><Title>" & frmObject.name & "</Title></Head>"
    If WebTemplate <> "" Then 'Must mean that user selected a background
        Print #fileNum%, "<Body Background=""" & imagepath & WebTemplate & """>"
    Else
        'Get the background color for the form:
        frmColor = frmObject.body.background.color.getrgb()
        'Convert to hex
        tempColor = Hex$(frmColor)
        WebColor = Right (tempColor, Len(tempColor) - 1)
        If WebColor = "0C0C0" Then 'This is an incorrect value for the default background color
            WebColor = "C0C0C0"
        End If
        Print #fileNum%, "<Body BGColor=""" & WebColor & """>"
    End If
    'Form method and action
    Print #fileNum%, "<form method=""" & frmMethodstr &  """ action=""" & frmaction$ & """>"


    objPos = 0
    headerPos = 0

    '*****Print the header if there is one - it must be at the top
    Print #fileNum%, "<hr><h1 align=""" & "center" & """>"
    For c = 0 To TotalObjs - 1
        Select Case objsorted(c).type
        Case $aprtextbox
            If objsorted(c).font.size >= 14 And objsorted(c).width > 5000 And objsorted(c).top < 900 Then

                'Get the text color of the header:
                headerColor = objsorted(c).font.color.getrgb()
                'Convert to hex
                tempColor = Hex$(headerColor)
                WebColor = Right (tempColor, Len(tempColor) - 1)
                'Convert the String
                newstring = htmlString(objsorted(c).text)



                If objsorted(c).font.italic = True Then
                    lStr = "<I>"
                    rStr="</I>"
                End If

                If objsorted(c).font.bold = True Then
                    lStr = lstr + "<B>"
                    rStr = rStr + "</B>"
                End If
                Print #fileNum%, lStr + "<Font Size=" & htmlfntsz(objsorted(c).font.size) & "><Font Color=""" & WebColor & """>" & newstring &  "</Font>" + rStr
                'If a header is found, flag it so that it is not reprinted in the body:
                headerIndex = c
                flag = 1
                headerPos = Round(objsorted(c).top/objsorted(c).height, 0)
                Exit For
            End If
        End Select
    Next

    '************Print the logo if there is one - it must have the same line number as the header block

    For c = 0 To TotalObjs - 1
        Select Case objsorted(c).type
        Case $aprpicture
            objPos = Round ((objsorted(c).top/objsorted(c).height), 0)
            If objPos = headerPos Then
                Print #fileNum%, "<img src=""" imagePath$ & objsorted(c).name & ".gif"  & """ ALT=""" & "[LOGO]" & """>"
                'If a logo is found, flag it so that it isn't reprinted in the body:
                logoIndex = c
                flag = 1
                Exit For
            End If
        End Select
    Next

    'If we found neither a logo or title block, then use the approach view name as the title
    '************need to modify this with the actual view argument
    If flag=0 Then
        Print #fileNum%, frmObject.name
    End If

    'End the header block:
    Print #fileNum%, "</h1><hr><p>"

    '***************************************************************************

    '-----------------Need to add a place holder here for printing anything extra Mike wants to throw in...
    Print #fileNum%, XtraHtml    '*****This string is needs to be valid HTML****



    Print #fileNum%, "<table cellpadding=8>"
    Print #fileNum%, "<tr>"
    For c = 0 To Totalobjs - 1
        typeParent = objsorted(c).parent.type
        If typeParent  = $aprbodypanel Then
            'Go to the next object - we're not translating repeating panels

            Select Case objSorted(c).type
            Case $aprfieldbox
                Printfldbx filenum%, ObjSorted(c)
            '***********radio buttons are special cases
            Case $aprradiobutton


                'Check if we ran into this radio button before
                radioPrinted = chkRadioPrinted( ObjSorted(c).datafield)

                If radioPrinted <> 1 Then 'check if we already ran into this radio button before
                    'Check the line number
                    chkLineNumber fileNum%, objsorted(c)
                    Print #fileNum%, "<td>" 'Start the table cell
                    For rcounter = 0 To NumRadioButtons - 1 'If not, then we need to go through and print a radio button for each in the group
                        If objSorted(c).datafield = aryRadioBtn(rcounter).datafield Then
                            Printradiobtn filenum%, aryRadioBtn(rcounter)
                            'aryCounter = aryCounter + 1
                        End If
                    Next
                End If
                lastradio(radioCounter) = objSorted(c).datafield
                radioCounter = radioCounter + 1
                lastradiobtn = objSorted(c).datafield
                aryCounter = 0 'reset my counters
                radioPrinted = 0

            '**********End of radiobuttons***********************************************

            Case $aprcheckbox
                PrintCbx filenum%, objSorted(c)

            'Listboxes and dropdownboxes will be treated as fieldboxes for now
            'Limitations:
            'Can't get the value list for these objects
            'Can't retreive the datafield for these objects in this version.
            Case $aprlistbox
                Printlbx filenum%, objsorted(c)
            Case $aprdropdownbox
                PrintDropbx filenum%, objsorted(c)

            'I'm only putting a place holder for pictures
            'The user will have to convert their pictures to *.gif (or other filetype viewable by web browsers)
            ' and place it in the appropriate image directory.

            Case $aprpicture, $aprpictureplus
                If c <>logoIndex Then
                    'Have to check if this picture was a logo in the header - if so don't print again
                    PrintPic filenum%, objSorted(c), imagePath$
                End If
            Case $aprtextbox
                'Have to check if this textblock was the header - if so don't print again
                If c <> headerindex Then
                    Printtextbox filenum%, objsorted    (c)
                End If

            End Select
        End If
    Next
    Print #fileNum%, "<tr>"
    Print #fileNum%, "</table>"

    'Print Action Buttions
    PrintActionBtns filenum%

    Print #fileNum%, "</Form>"
    Print #fileNum%, "</Body>"
    Print #fileNum%, "<Footer>"
    PrintCredits filenum%
    Print #fileNum%, "</Footer>"
    Print #fileNum%,"</HTML>"

    'Empty the arrays...
    Erase objSorted() 'Start over again for the report
    Erase aryRadioBtn()
    Erase lastradio()

End Sub
'++LotusScript Development Environment:2:2:PrintFormTitle:1:8
Sub PrintFormTitle(numFile As Integer, vartextbox As Variant)
    Print #numfile, vartextbox.text
End Sub
'++LotusScript Development Environment:2:2:PrintFldBx:1:8
Sub PrintFldBx(numFile As Integer, varfldbx As Variant)

    '******************************************************
    'A different strategy by line number

    linenumber = Round(varfldbx.top /560, 0)

    If lineNumber <> lastLineNo Then
        Print #numfile, "<tr></table><table cellpadding=8>"
        CurXCoor=0
    End If
    lastLineNo = lineNumber
    '*******************************************************
    objx = Round(varfldbx.left/1200,0)
    While objX < CurXCoor - 10  Or  objX > CurXCoor + 10
        'Put a spacer
        Print #numfile, "<td colspan=20><!-- Spacer --> </td>"
        objX= objX + 1
    Wend
    CurXCoor=objx
    '******************************************************
    'Get fontsize for the label:
    fntSize = HtmlFntSz(varfldbx.labelfont.size)

    'Let's check for labelposition
    labelleft$ = strlblByPosition(varfldbx, 0)
    labelright$ = strlblByPosition(varfldbx, 1)


    If varfldbx.height <= 630 Then 'We'll assume this is not a memofield - 625 is the default height of fieldboxes in Approach
        Print #numfile, "<td>"
        Print #numFile, "<Font Size=" & fntSize &">" & labelleft$ "<Input type=""" & "text""" & "  name=""" & varfldbx.datatable & "_" & varfldbx.datafield & """size =" & Str(Round(varfldbx.width/94,0))  & ">" & labelright$
    Else
        Print #numfile, "<td rowspan=" & Str(Round((varfldbx.height/1000), 0)) &">"
        Print #numFile,  "<Font Size=" & fntSize &">" & labelleft$ & "<textarea" & "  name=""" & varfldbx.datatable & "_" & varfldbx.datafield & """rows=" & Str(Round((varfldbx.height/94)/4,0))  & " cols=" &Str(Round((varfldbx.width/94),0))  & "></textarea>" & labelright$

    End If
End Sub
'++LotusScript Development Environment:2:2:PrintRadioBtn:1:8
Sub PrintRadioBtn(NumFile As Integer, varrdobtn As Variant)


    'Get fontsize for the label:
    fntSize = HtmlFntSz(varrdobtn.labelfont.size)

    'Get labelposition
    labelLeft$= strLblByPosition(varrdobtn, 0)
    labelRight$= strLblByPosition(varrdobtn, 1)

    Print #numFile,  "<Font Size=" & fntSize &">"  &  labelleft$ & "<Input type=""" & "radio""" & "  name=""" & varrdobtn.datatable & "_" & varrdobtn.datafield & """value="""&varrdobtn.clickedvalue &"""size =" & Str(Round(varrdobtn.width/85, 0))  & ">" & "<Font Size=" & fntSize &">" & labelRight$ &"<br>"


End Sub
'++LotusScript Development Environment:2:2:PrintCbx:1:8
Sub PrintCbx(numFile As Integer, varCbx As Variant)

    'A different strategy by line number

    'linenumber = Round(varcbx.top /varcbx.height, 0)
    'linenumber = Round(varcbx.top /625, 0)
    linenumber = Round(varcbx.top /560, 0)
    If lineNumber <> lastLineNo Then
        Print #numfile, "<tr></table><table cellpadding=8>"
    End If
    lastLineNo = lineNumber
    '*******************************************************

    'Get fontsize for the label:
    fntSize = HtmlFntSz(varcbx.labelfont.size)
    'Determine position of label
    labelLeft$ = strlblByPosition(varcbx,0)
    labelRight$= strlblByPosition(varcbx, 1)

    'Print #numFile, "" & varfldbx.labeltext
    Print #numfile, "<td>"
    Print #numFile, labelLeft$ & "<Input type=""" & "checkbox""" & "  name=""" & varcbx.datatable & "_" & varcbx.datafield & """ value=""" & varcbx.checkedvalue & """size =" & Str(Round(varCbx.width/94, 0))  & ">" & "<Font Size=" & fntSize &">" & labelRight$
    Print #numfile, "</td>"
End Sub
'++LotusScript Development Environment:2:1:GetObj:1:8
Function GetObj(objary As Variant)

    Redim objSorted(0 To objary.count - 1)  'Redimension the array appropriately

    i = 0
    arycounter = 0

    Forall objects In objary
        Select Case objary(i).type
        Case $aprfieldbox, $aprtextbox
            Set Objsorted(arycounter) = objary(i)  'Get the types of objects specified above
            arycounter = arycounter + 1
        Case  $aprcheckbox, $aprradiobutton, $aprpicture, $aprlistbox, $aprdropdownbox, $aprpictureplus
            Set Objsorted(arycounter) = objary(i)  'Get the types of objects specified above
            arycounter = arycounter + 1
        End Select

        i = i + 1 'Go to the next object in the list
    End Forall

    TotalObjs = arycounter 'Keep track of the number of objects we collected

End Function
'++LotusScript Development Environment:2:2:SortItByY:1:8
Sub SortItByY
    i = 0
    j = 0
    For i = 0 To TotalObjs -1
        Set temp = objSorted(i)


        For j = i + 1 To TotalObjs -1
            If objSorted(j).top < objSorted(i).top Then
                Set objSorted(i) = objSorted(j)


                Set objSorted(j) = temp

                Set temp = objSorted(i)


            End If
        Next
    Next


End Sub
'++LotusScript Development Environment:2:2:GroupRdoBtn:1:8
Sub GroupRdoBtn
    j = 0
    Redim aryRadioBtn(0 To Ubound(objsorted))
    For i = 0 To TotalObjs - 1
        If objsorted(i).type = $aprradiobutton Then

            Set aryRadioBtn(j) = objsorted(i)
            j = j + 1
        End If
    Next

    NumRadioButtons = j
End Sub
'++LotusScript Development Environment:2:2:PrintHtmlGood:1:8
Sub PrintHtmlGood
    ' Get an unused file number so LotusScript can open a file.
    fileNum% = Freefile()
    aryCounter = 0
    flag = 0


    Redim lastradio(numRadioButtons)
    radioCounter = 0

    Open "c:\win95\desktop\test5.htm" For Output As fileNum%

    Print #fileNum%,"<HTML>"
    Print #fileNum%, "<Body>"

    '------------------Need to replace the form method and action later...
    Print #fileNum%, "<form method=post action=""" & "mailto:[e-mail]""" & ">"

    '-----------------Need to add a place holder here for printing anything extra Mike wants to throw in...


    '----------------Search Type-----------------------------------------------------
    PrintSearch filenum%, 0 ' 0 here needs to be changed to an argument variable

    objPos = 0
    headerPos = 0

    '*****Print the header if there is one - it must be at the top
    Print #fileNum%, "<hr><h1 align=""" & "center" & """>"
    For c = 0 To TotalObjs - 1
        Select Case objsorted(c).type
        Case $aprtextbox
            If objsorted(c).font.size >=12 Then
                newstring = htmlString(objsorted(c).text)
                Print #fileNum%, "<Font Size=" & htmlfntsz(objsorted(c).font.size) & ">" & newstring
                'If a header is found, flag it so that it is not reprinted in the body:
                headerIndex = c
                flag = 1
                headerPos = Round(objsorted(c).top/objsorted(c).height, 0)
                Exit For
            End If
        End Select
    Next

    '************Print the logo if there is one - it must have the same line number as the header block

    For c = 0 To TotalObjs - 1
        Select Case objsorted(c).type
        Case $aprpicture
            objPos = Round ((objsorted(c).top/objsorted(c).height), 0)
            If objPos = headerPos Then
                Print #fileNum%, "<img src=""" & objsorted(c).name & ".gif"  & """ ALT=""" & "[LOGO]" & """>"
                'If a logo is found, flag it so that it isn't reprinted in the body:
                logoIndex = c
                flag = 1
                Exit For
            End If
        End Select
    Next

    'If we found neither a logo or title block, then use the approach view name as the title
    '************need to modify this with the actual view argument
    If flag=0 Then
        Print #fileNum%, currentview.name
    End If

    'End the header block:
    Print #fileNum%, "</h1><hr><p>"

    '***************************************************************************

    Print #fileNum%, "<table cellpadding=8>"
    Print #fileNum%, "<tr>"
    For c = 0 To Totalobjs - 1
        Print c
        If objsorted(c).parent.type <> $aprrepeatingpanel Then
            'Go to the next object - we're not translating repeating panels

            Select Case objSorted(c).type
            Case $aprfieldbox
                Printfldbx filenum%, ObjSorted(c)
            '***********radio buttons are special cases
            Case $aprradiobutton


                'Check if we ran into this radio button before
                radioPrinted = chkRadioPrinted( ObjSorted(c).datafield)

                If radioPrinted <> 1 Then 'check if we already ran into this radio button before
                    'Check the line number
                    chkLineNumber fileNum%, objsorted(c)
                    Print #fileNum%, "<td>" 'Start the table cell
                    For rcounter = 0 To NumRadioButtons - 1 'If not, then we need to go through and print a radio button for each in the group
                        If objSorted(c).datafield = aryRadioBtn(rcounter).datafield Then
                            Printradiobtn filenum%, aryRadioBtn(rcounter)
                            'aryCounter = aryCounter + 1
                        End If
                    Next
                End If
                lastradio(radioCounter) = objSorted(c).datafield
                radioCounter = radioCounter + 1
                lastradiobtn = objSorted(c).datafield
                aryCounter = 0 'reset my counters
                radioPrinted = 0

            '**********End of radiobuttons***********************************************

            Case $aprcheckbox
                PrintCbx filenum%, objSorted(c)

            'Listboxes and dropdownboxes will be treated as fieldboxes for now
            'Limitations:
            'Can't get the value list for these objects
            'Can't retreive the datafield for these objects in this version.
            Case $aprlistbox
                Printlbx filenum%, objsorted(c)
            Case $aprdropdownbox
                PrintDropbx filenum%, objsorted(c)

            'I'm only putting a place holder for pictures
            'The user will have to convert their pictures to *.gif (or other filetype viewable by web browsers)
            ' and place it in the appropriate image directory.

            Case $aprpicture, $aprpictureplus
                If c <>logoIndex Then
                    'Have to check if this picture was a logo in the header - if so don't print again
                    PrintPic filenum%, objSorted(c), ""
                End If
            Case $aprtextbox
                'Have to check if this textblock was the header - if so don't print again
                If c <> headerindex Then
                    Printtextbox filenum%, objsorted    (c)
                End If

            End Select
        End If
    Next
    Print #fileNum%, "<tr>"
    Print #fileNum%, "</table>"

    'Print Action Buttions
    PrintActionBtns filenum%

    Print #fileNum%, "</Form>"
    Print #fileNum%, "</Body>"
    Print #fileNum%,"</HTML>"

    Close fileNum%

End Sub
'++LotusScript Development Environment:2:1:PrintLbx:1:8
Function PrintLbx(numFile As Integer, varlbx As Variant)

        '******************************************************
    'A different strategy by line number

    linenumber = Round(varlbx.top /560, 0)


    If lineNumber <> lastLineNo Then
        Print #numfile, "<tr></table><table cellpadding=8>"
    End If
    lastLineNo = lineNumber
    '*******************************************************

    'Get a similar datafield for this type of object since there is no datafield property for this object:
    msgValue = ""

    'strLabel = NoSpaceStr(varlbx.labeltext)
'    Forall elements In aryFieldnames
'        If Lcase$(Left$(strLabel, 5)) Like Lcase$(Left$(elements, 5)) Then
'            datafield = elements
'        End If
'    End Forall

'    If datafield = "" Then
'        datafield = strLabel
'        msgValue = "Could not find the datafield for this field - do not use for query"
'    End If

    'Get fontsize for the label:
    fntSize = HtmlFntSz(varlbx.labelfont.size)

    'Determine label position
    labelLeft$ = strLblByPosition(varlbx, 0)
    labelRight$ = strLblByPosition(varlbx, 1)
    If varlbx.height <= 630 Then 'We'll assume this is not a memofield - 625 is the default height of fieldboxes in Approach
        Print #numfile, "<td>"
        Print #numFile, "<Font Size=" & fntSize &">" labelLeft$ & "<Input type=""" & "text""" & "  name=""" & varlbx.datatable & "_" & varlbx.datafield & """Value=""" & msgValue & """size =" & Str(Round(varlbx.width/94,0))  & ">" &"<Font Size=" & fntSize &">" & labelRight$
    Else
        Print #numfile, "<td rowspan=" & Str(Round((varlbx.height/1000), 0)) &">"
        Print #numFile, "<Font Size=" & fntSize &">" & labelLeft$ & "<textarea" & "  name="""  & varlbx.datatable & "_" & varlbx.datafield & """Value=""" & msgValue & """rows=" & Str(Round((varlbx.height/94)/4,0))  & " cols=" &Str(Round((varlbx.width/94)/2,0))  & "></textarea>" &"<Font Size=" & fntSize &">" & labelRight$
    End If
End Function
'++LotusScript Development Environment:2:2:SortItByX:1:8
Sub SortItByX
    i = 0
    j = 0
    For i = 0 To TotalObjs - 1
        Set temp = objSorted(i)


        For j = i + 1 To TotalObjs - 1

            'If objSorted(j).left < objSorted(i).left And Round((objSorted(j).top/objSorted(j).height), 0) = Round((objSorted(i).top/objsorted(j).height), 0) Then
            If objSorted(j).left < objSorted(i).left And Round((objSorted(j).top/560), 0) = Round((objSorted(i).top/560), 0) Then
                Set objSorted(i) = objSorted(j)


                Set objSorted(j) = temp

                Set temp = objSorted(i)


            End If
        Next
    Next



End Sub
'++LotusScript Development Environment:2:2:PrintRptHtml:1:8
Sub PrintRptHtml(filenum As Integer, rptObject As Variant, WebTemplate As String, imagePath As String)
    Dim c, aryCounter, headerindex, logoIndex, headerPos, ObjPos, flag  As Integer
    Dim lStr, rStr As String
    Dim newstring As String
    Dim rptcolor, WebColor, colHeight As Long
    '*******************************************************************************************************
    'Only objects in the bodypanel, headerpanel, and footerpanel will be printed out
    'to html.
    'Only Fieldboxes,  textboxes, and pictures will be printed
    '*******************************************************************************************************
    'Store the objects in an array
    GetObj(rptObject.objectlist)    'The report I picked
    'To be used to get best-guess datafield for dropdownboxes and listboxes

    'GetColumns(rptObject.parent.tables(GetTableIndex(rptObject.maintable, rptObject.parent)))  'Needs to be adjusted
    'Sort the array by its y coordinate first
    SortItByY
    'Now let's split the objects line by line and sort by x coordinate
    SortItByX

    '------------------------------------------------------------------------------------------------------------------------------------------


    aryCounter = 0

    'Mark the beginning of the SQL_REPORT Section:
    Print #fileNum%, "%SQL_REPORT{"

    Print #fileNum%,"<HTML>"
    Print #fileNum%, "<Head><Title>" & rptObject.name & "</Title></Head>"
    If WebTemplate <> "" Then 'Must mean that user selected a background
        Print #fileNum%, "<Body Background=""" & imagepath & WebTemplate & """>"
    Else
        'Get the background color for the form:
        rptColor = rptObject.body.background.color.getrgb()
        'Convert to hex
        tempColor = Hex$(rptColor)
        WebColor = Right (tempColor, Len(tempColor) - 1)
        If WebColor = "0C0C0" Then 'This is an incorrect value for the default background color
            WebColor = "C0C0C0"
        End If
        Print #fileNum%, "<Body BGColor=""" & WebColor & """>"
    End If
    '*****Print the header if there is one - it must be at the top
    Print #fileNum%, "<hr><h1 align=""" & "left" & """>"
    For c = 0 To TotalObjs - 1
        Select Case objsorted(c).type
        Case $aprtextbox
            If objsorted(c).font.size >=12 And objsorted(c).namedstyle = ":116 Default Report Title" Then
                newstring = htmlString(objsorted(c).text)

                    'Get the text color of the header:
                headerColor = objsorted(c).font.color.getrgb()
                'Convert to hex
                tempColor = Hex$(headerColor)
                WebColor = Right (tempColor, Len(tempColor) - 1)
                'Convert the String
                newstring = htmlString(objsorted(c).text)



                If objsorted(c).font.italic = True Then
                    lStr = "<I>"
                    rStr="</I>"
                End If

                If objsorted(c).font.bold = True Then
                    lStr = lstr + "<B>"
                    rStr = rStr + "</B>"
                End If
                Print #fileNum%, lStr + "<Font Size=" & htmlfntsz(objsorted(c).font.size) & "><Font Color=""" & WebColor & """>" & newstring &  "</Font>" + rStr

                  'If a header is found, flag it so that it is not reprinted in the body:
                headerIndex = c
                flag = 1
                headerPos = Round(objsorted(c).top/560, 0)
                Exit For
            End If
        End Select
    Next

     '***************************************************************************

     '************Print the logo if there is one - it must have the same line number as the header block

    For c = 0 To TotalObjs - 1
        Select Case objsorted(c).type
        Case $aprpicture
            objPos = Round ((objsorted(c).top/560), 0)
            If objPos = headerPos And objsorted(c).parent.namedstyle = ":107 Default Columns"  Then
                Print #fileNum%, "<img src=""" & objsorted(c).name & ".gif"  & """ ALT=""" & "[LOGO]" & """>"
                   'If a logo is found, flag it so that it isn t reprinted in the body:
                logoIndex = c
                flag = 1
                Exit For
            End If
        End Select
    Next

    'If we found neither a logo or title block, then use the approach view name as the title
    '************need to modify this with the actual view argument
    If flag=0 Then
        Print #fileNum%, rptObject.name
    End If

    'End the header block:
    Print #fileNum%, "</h1><hr><p>"

    'Determine what we'll consider a column header for this report
    For c = 0 To TotalObjs -1
        Select Case objsorted(c).type
        Case $aprtextbox
            If objsorted(c).namedstyle = ":107 Default Columns"  Then
              'Get the height of the first column header to distinguish it from other objects in the header:
                colHeight = objsorted(c).height
                Exit For
            End If
        End Select

    Next

    '***************************************************************************
    'Let's print any miscellaneous objects in the header here:

    Print #fileNum%, "<table cellpadding=8>"
    Print #fileNum%, "<tr>"
    For c = 0 To TotalObjs -1
        If objsorted(c).namedstyle = ":107 Default Columns"  And objsorted(c).height <> colHeight Then
            Select Case objSorted(c).type
            Case $aprpicture, $aprpictureplus
                If c <>logoIndex Then
                       'Have to check if this picture was a logo in the header - if so don t print again
                    PrintPic filenum%, objSorted(c), imagePath
                End If
            Case $aprtextbox
                   'Have to check if this textblock was the header - if so don't print again
                If c <> headerindex Then
                    Printtextbox filenum%, objsorted    (c)
                End If
            End Select
        End If
    Next
    Print #fileNum%, "<tr>"


    '********************Print the column headings: **************************************************

    Print #fileNum%, "<table cellpadding=8>"
    Print #fileNum%, "<tr>"
    For c = 0 To TotalObjs -1
        Select Case objsorted(c).type
        Case $aprtextbox
            If objsorted(c).namedstyle = ":107 Default Columns" And objsorted(c).height = colHeight Then
                Print #fileNum%, "<TH>" &  objsorted(c).text
            End If
        End Select
    Next
    Print #fileNum%, "<tr>"
    '*******************************************************************************************************

    '*****************Print the body of the report:******************************************************************
    'Mark the beginning of repeating object row:
    Print #fileNum%, "%ROW{"

    For c = 0 To TotalObjs - 1
        If ObjSorted(c).parent.type = $aprbodypanel  Then
            Select Case objSorted(c).type
            Case $aprfieldbox
                Printfldbx2 filenum%, ObjSorted(c)
            Case $aprpicture, $aprpictureplus
                If c <>logoIndex Then
                    'Have to check if this picture was a logo in the header - if so don't print again
                    PrintPic filenum%, objSorted(c), imagePath$
                End If
            Case $aprtextbox
                'Have to check if this textblock was the header - if so don't print again
                If c <> headerindex Then
                    Printtextbox filenum%, objsorted    (c)
                End If
            End Select
        End If
    Next
    Print #fileNum%, "<tr>"
    Print #fileNum%, "%}"
    Print #fileNum%, "</table><br>"
    Print #fileNum%, "</Body>"

    '************************************Footer Section*****************************************************
    Print #fileNum%, "<Footer><hr><small>"
    Print #fileNum%, "<table><td><small>"
    Print #fileNum%, "<Script Language=""" & "JavaScript" & """>"
    Print #fileNum%, "document.write(Date())"
    Print #fileNum%, "</Script>"
    Print #fileNum%, "</table>"


    Print #fileNum%, "<table cellpadding=8>"
    Print #fileNum%, "<tr>"
    For c = 0 To TotalObjs -1
        If objsorted(c).parent.namedstyle = ":117 Default Footer left"  Or objsorted(c).parent.namedstyle = ":118 Default Footer right" Then
            Select Case objSorted(c).type
            Case $aprpicture, $aprpictureplus
                If c <>logoIndex Then
                    'Have to check if this picture was a logo in the header - if so don't print again
                    PrintPic filenum%, objSorted(c), imagePath
                End If
            Case $aprtextbox
                'Have to check if this textblock was the header - if so don't print again
                If c <> headerindex Then
                    Printtextbox filenum%, objsorted    (c)
                End If
            End Select
        End If
    Next
    Print #fileNum%, "</table>"
    PrintCredits filenum%
    Print #fileNum%, "</Footer><hr>"
    '***********************************************************************************************************

    Print #fileNum%,"</HTML>"

    'Mark the end of the SQL_REPORT Section
    Print #fileNum%, "%}"

        'Empty the arrays...
    Erase objSorted() 'Start over again.
    Erase aryRadioBtn()
    Erase lastradio()

End Sub
'++LotusScript Development Environment:2:2:PrintFldBx2:1:8
Sub PrintFldBx2(numFile As Integer, varfldbx As Variant)

    '******************************************************
    'A different strategy by line number

    linenumber = Round(varfldbx.top /560, 0)

    If lineNumber <> lastLineNo Then
        'Print #numfile, "<tr></table><table cellpadding=8>"
        Print #numfile, "<tr>"
        CurXCoor=0
    End If
    lastLineNo = lineNumber
    '*******************************************************
    'Get fontsize for the label:
    fntSizeLabel = HtmlFntSz(varfldbx.labelfont.size)
    'Get fontsize for the text
    fntSizeData = HtmlFntSz(varfldbx.font.size)

    'Let's check for labelposition
    labelleft$ = strlblByPosition2(varfldbx, 0)
    labelright$ = strlblByPosition2(varfldbx, 1)


    Print #numfile,"<td>"
    Print #numFile,  "<Font=" & fntSizeLabel & ">" & labelLeft$ & "<Font Size=" &  fntSizeData & ">" & "$(V_" & varfldbx.datafield & ")" & "<Font Size=" & labelRight$ & ">"

End Sub
'++LotusScript Development Environment:2:1:PrintPic:1:8
Function PrintPic(numFile As Integer, varpic As Variant, iPath As String)
    linenumber = Round(varpic.top /560, 0)

    If lineNumber <> lastLineNo Then
        Print #numfile, "<tr></table><table cellpadding=8>"
    End If
    lastLineNo = lineNumber
    '*******************************************************


    Print #numfile, "<td rowspan=" & Str(Round((varpic.height/1000), 0)) &">"
    Print #numFile, "<image src =""" & iPath$ & varpic.name & ".gif" & """ Alt=""" & varpic.name &".gif"  & """>"


End Function
'++LotusScript Development Environment:2:1:PrintTextBox:1:8
Function PrintTextBox(numFile As Integer, vartextbox As Variant)

    linenumber = Round(vartextbox.top/560, 0)

    If lineNumber <> lastLineNo Then
        Print #numfile, "</tr><tr>"
    End If
    lastLineNo = lineNumber
    '*******************************************************

    'Get fontsize for the label:
    fntSize = HtmlFntSz(vartextbox.font.size)

    newstring = htmlString(vartextbox.text)

    'Get the font color
    fntColor = vartextbox.font.color.getrgb()
    'Convert to hex
    tempColor = Hex$(fntColor)
    WebColor = Right (tempColor, Len(tempColor) - 1)

    'Check for text formatting:
    If Abs(vartextbox.font.bold) = 1 And  Abs(vartextbox.font.italic) = 1 Then
        LeftStr$="<B><I>"
        RightStr$= "</I></B>"
    Elseif Abs(vartextbox.font.bold) = 1 Then
        LeftStr$="<B>"
        RightStr$= "</B>"
    Elseif Abs(vartextbox.font.italic) = 1 Then
        LeftStr$="<I>"
        RightStr$= "</I>"
    Else
        LeftStr$=""
        RightStr$= ""
    End If

    Print #numfile, "<td rowspan=" & Str(Round((vartextbox.height/1000), 0)) &">"
    Print #numFile, LeftStr$ & "<Font Size=" & fntSize &"><font color=""" & WebColor & """>"  & newstring & "</font>" & RightStr$
        'Need to put a place holder in the rows that this takes up!!!
        'How????????????

End Function
'++LotusScript Development Environment:2:1:htmlString3:1:8
Function htmlString3(vartext As String) As String
    newstring = ""
    If Left$(vartext,1) = "<" Then 'Calculated fields cause problems because their text properties have "<"
        htmlString3= "<!--[Approach calculated field] -->"
        Exit Function
    End If

    For c =1 To Len(vartext)
        If Mid$(vartext, c, 1) = Chr(10) Then
            newstring = newstring + "<br>"
        Else
            newstring = newstring + Mid$(vartext, c, 1)
        End If
    Next

    htmlString3 = newstring
End Function
'++LotusScript Development Environment:2:1:GetMethod:1:8
Function GetMethod(frmMethod As Integer) As String
     'GetMethod will return a valid string to PrintFrmHtml fuction
    If frmMethod = 0 Then
        GetMethod ="Post"
    Elseif frmMethod = 1 Then
        GetMethod="Get"
    Else 'the number wasn't valid
        GetMethod="Bad Value"
    End If
End Function
'++LotusScript Development Environment:2:1:GetColumns:1:8
Function GetColumns(myTable As Variant)
    'Need to get all of the fieldnames from the table for the view to use later
    'to get a datafield assoicated with dropdownlist and fieldbox objects
    Redim aryFieldnames(0 To (mytable.numfields-1))
    c= 0
    Forall elements In myTable.Fieldnames
        aryFieldnames(c) =elements
        c= c + 1
    End Forall

End Function
'++LotusScript Development Environment:2:2:FindTest:1:8
Sub FindTest
    Dim myres(0 To 30) As String
    Set myfind = New finddistinct
    'Set mycount = myfind.getcount
    'Redim myres(0 To mycount)
    CurrentFind = myfind.getat(2, "item")
    For c = 0 To mycount
        myres(c) = myfind.getat(c, "item")
    Next
End Sub
'++LotusScript Development Environment:2:1:PrintDropbx:1:8
Function PrintDropbx(numFile As Integer, varDropbx As Variant)

        '******************************************************
    'A different strategy by line number

    linenumber = Round(varDropbx.top /560, 0)

    If lineNumber <> lastLineNo Then
        Print #numfile,  "</table><table cellpadding=8><tr>"
    End If
    lastLineNo = lineNumber
    '*******************************************************


    msgValue = ""
'    strLabel = NoSpaceStr(varDropbx.labeltext)
'    Forall elements In aryFieldnames
'        If Lcase$(Left$(strLabel, 5)) Like Lcase$(Left$(elements,5)) Then
'        datafield = elements
    '    End If
'    End Forall

    'If datafield = "" Then
    '    datafield = strLabel
'        msgValue = "Could not find the datafield for this field - do not use for query"
    'End If


    'Get fontsize for the label:
    fntSize = HtmlFntSz(varDropbx.labelfont.size)

    'Determine Position of Label
    labelLeft$ = strLblByPosition(varDropbx, 0)
    labelRight$ = strLblByPosition(varDropbx, 1)
    If varDropbx.height <= 630 Then 'We'll assume this is not a memofield - 625 is the default height of fieldboxes in Approach
        Print #numfile, "<td>"
        Print #numFile, "<Font Size=" & fntSize &">" & labelLeft$ & "<Input type=""" & "text""" & "  name=""" & vardropbx.datatable & "_" & vardropbx.datafield & """Value=""" & msgValue & """size =" & Str(Round(varDropbx.width/94,0))  & ">" & labelRight$
    Else
        Print #numfile, "<td rowspan=" & Str(Round((varDropbx.height/1000), 0)) &">"
        Print #numFile, "<Font Size=" & fntSize &">" & labelLeft$ & "<textarea" & "  name=""" & vardropbx.datatable & "_" & vardropbx.datafield &  """Value=""" & msgValue & """rows=" & Str(Round((varDropbx.height/94)/4,0))  & " cols=" &Str(Round((varDropbx.width/94)/2,0))  & "></textarea>" & labelRight$
    End If
End Function
'++LotusScript Development Environment:2:1:GetTable:1:8
Function GetTable(strTablename As String, docindex As Integer) As Variant
    c= 0
    Forall tables In CurrentApplication.Documents(docindex).tables
        If CurrentApplication.Documents(docindex).tables(c).tablename = strTablename Then
            Set GetTable =  CurrentApplication.Documents(docindex).tables(c)
            Exit Function
        Else
            c = c + 1 ' Go to the next item
        End If
    End Forall

End Function
'++LotusScript Development Environment:2:2:PrintSearch:1:8
Sub PrintSearch(filenum As Integer, Searchtype As Integer)

    If SearchType = 1 Then
        strAnd = "Checked"
    Elseif SearchType = 2 Then
        strOr = "Checked"
    Else
        strAnd = ""
        strOr = ""
    End If

    Print #filenum, "<!-- Search Type -->"
    Print #filenum, "<table><tr>"
    Print #filenum, "<td>Search Type:"
    Print #filenum, "</table>"
    Print #filenum, "<table><tr>"
    Print #filenum, "<td><Input type=""" & "radio" & """ name=""" & "SearchType" & """ value=""" & "1" & """ " & strAnd & " ><small>And"
    Print #filenum, "<td><Input type=""" & "radio" & """ name=""" & "SearchType" & """ value=""" & "2" & """ " & strOr & " ><small>Or"
    Print #filenum, "</table>"
    Print #filenum, "<!-- End Search Type -->"

End Sub
'++LotusScript Development Environment:2:1:HtmlFntSz:1:8
Function HtmlFntSz(fntSize As Integer) As Integer
    Select Case fntSize
    Case Is <= 8
        HtmlFntSz=2
    Case 10, 11
        HtmlFntSz=3
    Case 12, 13
        HtmlFntSz=4
    Case 14, 15
        HtmlFntSz=5
    Case 16, 17
        HtmlFntSz=6
    Case Is  >= 18
        HtmlFntSz=7

    End Select

End Function
'++LotusScript Development Environment:2:1:chkRadioPrinted:1:8
Function chkRadioPrinted(objDataField As String) As Integer
    j = 0
    Forall elements In  lastradio
        If lastradio(j) = "" Then
            Exit Forall
        End If
        If objDataField= lastradio (j) Then
            chkRadioPrinted = 1 'Found it so don't print it again.
        End If
        j = j + 1
    End Forall

End Function
'++LotusScript Development Environment:2:2:PrintActionBtns:1:8
Sub PrintActionBtns(numFile As Integer)
        '*******************Action buttons for the form
    Print #numFile%, "<p><p><table cellpadding=8>"
    Print #numFile%, "<tr>"
    Print #numFile, "<td> <INPUT TYPE="""& "submit" & """ VALUE=""" & "Submit Query" & """>"
    Print #numFile%, "<td> <INPUT TYPE="""& "reset" & """ VALUE=""" & "Reset" & """></table><P>"
    '****************************************************
End Sub
'++LotusScript Development Environment:2:1:NoSpaceStr:1:8
Function NoSpaceStr(StrLabelText As String) As String
'This will be used to help best guess what datafield to attach to dropdownboxes and fieldboxes

    newstring = ""
    For c=1 To Len(strLabeltext)
        If Mid$(strLabeltext, c, 1) = " " Then
            newstring = newstring + ""            'Note: getting rid of the space will help compare the label to a fieldname in the table
        Else
            newstring = newstring + Mid$(strLabeltext, c, 1)
        End If
    Next

    NoSpaceStr = newstring

End Function
'++LotusScript Development Environment:2:2:chkLineNumber:1:8
Sub chkLineNumber(numFile As Integer, objvar As Variant)
    linenumber = Round(objvar.top /560, 0)
    If lineNumber <> lastLineNo Then
        Print #numfile, "<tr></table><table cellpadding=8>"
    End If
    lastLineNo = lineNumber
    '*******************************************************
End Sub
'++LotusScript Development Environment:2:1:strLblByPosition:1:8
Function strLblByPosition(objvar As Variant, txtPos As Integer) As String
    'This returns a string value with html text determining if the label for the
    'object is on top, bottom, left, or right.
    'txtPos here indicates the position of the place holders I have in the Print Subroutines:
    '$labelLeft &$labelRight
    '0 indicates it's for left
    '1 indicates it is for right.


    'Get the font color
    fntColor = objvar.labelfont.color.getrgb()
    'Convert to hex
    tempColor = Hex$(fntColor)
    WebColor = Right (tempColor, Len(tempColor) - 1)

    'Check for text formatting:
    If Abs(objvar.labelfont.bold) = 1 And  Abs(objvar.labelfont.italic) = 1 Then
        LeftStr$="<Font Color=""" & WebColor &"""><B><I>"
        RightStr$= "</I></B></Font>"
    Elseif Abs(objvar.labelfont.bold) = 1 Then
        LeftStr$="<Font Color=""" & WebColor &"""><B>"
        RightStr$= "</B></Font>"
    Elseif Abs(objvar.labelfont.italic) = 1 Then
        LeftStr$="<Font Color=""" & WebColor &"""><I>"
        RightStr$= "</I></font>"
    Else
        LeftStr$="<Font Color=""" & WebColor &""">"
        RightStr$= "</font>"
    End If


    'Let's check for labelposition
    Select Case objvar.labelposition
    Case $ltsPositionleft
        If txtPos = 0 Then
            strlblByPosition = LeftStr$ & objvar.labeltext & "  " & RightStr$
        Else
            strlblByPosition = ""
        End If
    Case $ltsPositionTop
        If txtPos = 0 Then
            strlblByPosition = LeftStr$ & objvar.labeltext & "<br>" & RightStr$
        Else
            strlblByPosition =""
        End If
    Case $ltsPositionRight
        If txtPos = 1 Then
            strlblByPosition = LeftStr$ & "  " & objvar.labeltext & RightStr$
        Else
            strlblByPosition =""
        End If
    Case $ltsPositionBottom
        If txtPos = 1 Then
            strlblByPosition = LeftStr$ & "<br>" & objvar.labeltext & RightStr$
        Else
            strlblByPosition =""
        End If
    Case Else
        If objvar.parent.parent.type = $aprreport Then 'Treat it as a top label for report as form
            If txtPos = 0 Then
                strlblByPosition = LeftStr$ & objvar.labeltext & "<br>" & RightStr$
            Else
                strlblByPosition =""
            End If
        Else
            strlblByPosition = ""
        End If
    End Select
End Function
'++LotusScript Development Environment:2:2:PrintShowSQL:1:8
Sub PrintShowSQL(filenum As Integer, ShowSQL As Integer)

    If ShowSQL = 1 Then
        strValue = "Checked"
    Else
        strValue= ""
    End If
    Print #filenum, "<!-- ShowSQL -->"
    Print #filenum, "<table><tr>"
    Print #filenum, "<td><Input type=""" & "checkbox" & """ name=""" & "ShowSQL" & """ value=""" & "1" & """ " & strValue & " size = 10><small> Show SQL?"
    Print #filenum, "</table>"
    Print #filenum, "<!-- End ShowSQL -->"
End Sub
'++LotusScript Development Environment:2:1:GetTableIndex:1:8
Function GetTableIndex(strTablename As String, docName As Variant) As Integer
    'This function will return the correct index number for the specified table in the table collection for the specified document
    c = 0
    Forall tables In docName.tables
        If tables.tablename = strTablename Then
            GetTableIndex = c
            Exit Function
        End If
        c= c + 1
    End Forall
End Function
'++LotusScript Development Environment:2:1:htmlString:1:8
Function htmlString(vartext As String) As String
    'This version will return a comment string if it finds a calculated field in the string
    newstring = ""

    For c =1 To Len(vartext)
        Select Case Mid$(vartext, c, 1)
        Case Chr(10)
            newstring = newstring + "<br>"
        Case "<"
            newstring =  "<!--[Approach calculated field] -->" 'Found an Approach Calculated field
            Exit For
        Case Else
            newstring = newstring + Mid$(vartext, c, 1)
        End Select
    Next

    htmlString = newstring
End Function
'++LotusScript Development Environment:2:1:FormatPath:1:8
Function FormatPath(imagepath As String) As String
    If imagepath="" Then Exit Function
    'Strip imagepath of backslashes:
    If Left$(imagepath, 1) <> "\" Then
        imagepath =Right$( imagepath, Len(imagepath) -1)
    End If
    If Right$(imagepath, 1)<> "\" Then
        imagepath =Left$( imagepath, Len(imagepath) -1)
    End If
        'Check that the image directory specified begins and ends with forward slashes:
    If Left$(imagepath, 1) <> "/" Then
        imagepath = "/" + imagepath
    End If
    If Right$(imagepath, 1)<> "/" Then
        imagepath = imagepath + "/"
    End If

    FormatPath = imagepath
End Function
'++LotusScript Development Environment:2:1:strLblByPosition2:1:8
Function strLblByPosition2(objvar As Variant, txtPos As Integer) As String

    'This returns a string value with html text determining if the label for the
    'object is on top, bottom, left, or right.
    'txtPos here indicates the position of the place holders I have in the Print Subroutines:
    '$labelLeft &$labelRight
    '0 indicates it's for left
    '1 indicates it is for right.


    'Get the font color
    fntColor = objvar.labelfont.color.getrgb()
    'Convert to hex
    tempColor = Hex$(fntColor)
    WebColor = Right (tempColor, Len(tempColor) - 1)

    'Check for text formatting:
    If Abs(objvar.labelfont.bold) = 1 And  Abs(objvar.labelfont.italic) = 1 Then
        LeftStr$="<Font Color=""" & WebColor &"""><B><I>"
        RightStr$= "</I></B></Font>"
    Elseif Abs(objvar.labelfont.bold) = 1 Then
        LeftStr$="<Font Color=""" & WebColor &"""><B>"
        RightStr$= "</B></Font>"
    Elseif Abs(objvar.labelfont.italic) = 1 Then
        LeftStr$="<Font Color=""" & WebColor &"""><I>"
        RightStr$= "</I></font>"
    Else
        LeftStr$="<Font Color=""" & WebColor &""">"
        RightStr$= "</font>"
    End If


    'Let's check for labelposition
    Select Case objvar.labelposition
    Case $ltsPositionleft
        If txtPos = 0 Then
            strlblByPosition2 = LeftStr$ & objvar.labeltext & "  " & RightStr$
        Else
            strlblByPosition2 = ""
        End If
    Case $ltsPositionTop
        If txtPos = 0 Then
            strLblByPosition2 = LeftStr$ & objvar.labeltext & "<br>" & RightStr$
        Else
            strLblByPosition2 =""
        End If
    Case $ltsPositionRight
        If txtPos = 1 Then
            strLblByPosition2 = LeftStr$ & "  " & objvar.labeltext & RightStr$
        Else
            strLblByPosition2 =""
        End If
    Case $ltsPositionBottom
        If txtPos = 1 Then
            strLblByPosition2 = LeftStr$ & "<br>" & objvar.labeltext & RightStr$
        Else
            strLblByPosition2 =""
        End If
    Case Else
        'If objvar.parent.parent.type = $aprreport Then 'Treat it as a top label for report as form
        '    If txtPos = 0 Then
        '        strLblByPosition2 = LeftStr$ & objvar.labeltext & "<br>" & RightStr$
        '    Else
        '        strLblByPosition2 =""
        '    End If
        'Else
        strLblByPosition2 = ""
        'End If
    End Select
End Function
'++LotusScript Development Environment:2:2:ReturnWinTitle:1:8
Sub ReturnWinTitle
    'Rename the window title for the dialogue so that it has the title we want instead of the apr file name
    Dim activeWin As Integer, winTitle As String
    activeWin% = GetActiveWindow()
    winTitle$ = "Approach"
    SetWindowTextA activeWin%, winTitle$
End Sub
'++LotusScript Development Environment:2:1:ParseUserid:1:8
Function ParseUserid(FullTablePath As String) As String
    Dim tempStr As String

    tempStr = Left(FullTablePath, Instr(1, FullTablePath, "\") - 1)
    ParseUserid = tempStr


End Function
'++LotusScript Development Environment:2:2:PrintCredits:1:8
Sub PrintCredits(FileNum As Integer)

    Print  #filenum, "<A HREF=""" & "http://www.software.ibm.com/data/net.data/" & """> <font size=1>Web Page Created by Lotus® Approach® DB2 Web Sizing Assistant</font></A>"

End Sub
'++LotusScript Development Environment:2:2:GetWebTemplate:1:8
Sub GetWebTemplate(PicName As String)
    On Error Resume Next

    WebTemplate = Right$(PicName, Len(PicName) -3)
    If WebTemplate = "Cancel" Then
        WebTemplate = ""
    Else
        WebTemplate = WebTemplate + ".gif"
    End If

    'CurrentApplication.visible = False
    CurrentDocument.window.visible = False

    Set CurrentWindow.activeview = CurrentDocument.opening
    Set CurrentWindow.activeview = CurrentDocument.www~ assistant
    'reset error
    Err = 0
End Sub
'++LotusScript Development Environment:2:2:Sub1:1:8
Sub Sub1
    Set CurrentWindow.ActiveView = CurrentDocument.Opening
    CurrentApplication.visible = True
    CurrentDocument.window.visible = False

    CurrentView.visible = True
    currentview.timerinterval=0
End Sub
'++LotusScript Development Environment:2:2:QuitAssistant:1:8
Sub QuitAssistant
    Err=0
    If Lcase$(Left$(CurrentDocument.name,6)) = "db2www"  Then
        'Set the flag for modified to false to bypass UI save dialog
        CurrentDocument.Modified = False
        'FINALLY close just the web sizing assistant!
        CurrentApplication.ApplicationWindow.DoMenuCommand(IDM_CLOSE)
        Doevents
    End If

End Sub
'++LotusScript Development Environment:2:1:ParseSQLUserid:1:8
Function ParseSQLUserid(strSQL As String, aryUserid() As String) As Variant
    'This routine must parse thru the SQL string returned from the SQL property
    'of the query object.  If this routine is called, it's because the apr being
    'translated is the result of SQL Assistant
    'For now, will return alias table for use with
    'GetSQLAssistant routine which has bugs

    Dim intPosSpace%, intPosComma%, intPosPeriod As Integer
    Dim strtemp As String
    Dim intNumTables%, intNumCommas As Integer
    Dim intAryPos(1 To 4) As Integer
    Dim rval As Integer
    Dim intPos As Integer
    Dim strFind As String
    Dim c%, j  As Integer
    Dim aryAlias() As String

    'Remove quotations marks first:
    strFind =Chr(34)
    For c=1 To Len(strSQL)
        If Mid(strSQL, c, 1) = strFind  Then
            strTemp = strTemp
        Else
            strTemp = strTemp + Mid(strSQL, c,1)
        End If
    Next

    strSQL = strTemp
    intPos =Instr(1, Ucase$(strSQL), "FROM")

    strTemp =Right$( strSQL,  Len (strSQL) - intPos - 4)


    'Strip off the rest of the SQL statement that we don't need:
    'Look for key words, such as :
    'ORDER, JOIN, WHERE, GROUP

    intAryPos(1)=Instr(1, Ucase$(strTemp), "ORDER")
    intAryPos(2) =Instr(1, Ucase$(strTemp), "JOIN")
    intAryPos(3) =Instr(1, Ucase$(strTemp), "WHERE")
    intAryPos(4) =Instr(1, Ucase$(strTemp), "GROUP")


    rval =  SortByPos(intAryPos())
    intPos = 0
    Forall intElements In intAryPos
        If intElements > 0 Then
            intPos = intElements
            Exit Forall
        End If
    End Forall



    'Remove the remainder of the sql string that we don't need
    If intPos <> 0 Then
        strTemp = Mid$( StrTemp, 1 , intPos -1)
    End If

    'Count the number of commas in the string that is left - if none, then 1 table:
    For c = 1 To Len(strTemp)
        If Mid$(StrTemp,c,1) = "," Then
            intNumCommas = intNumCommas + 1
        End If
    Next
    If intNumCommas = 0 Then
        intNumCommas = 1
    End If
    intNumTables = intNumCommas
    Redim aryAlias(0 To intNumTables, 0 To 1)
    Redim aryUserId(0 To intNumTables, 0 To 1)

    'Now retreive the sets of Owner and tablenames

    c=0
    intPos=1
    While intPos < Len(strTemp) -1
        intPosPeriod =Instr(1, Lcase$(strTemp), ".")
        intPosComma =  Instr(1, Lcase$(strTemp), ",")
        If intPosComma <> 0 Then
            IntPos = intPosComma
        Else
            IntPos = Len(strTemp)
        End If

        AryUserid(c, 0) = Left$(strTemp, intPosPeriod - 1)
        AryUserid(c, 1) = Mid$( strTemp, intPosPeriod + 1, IntPos - (intPosPeriod + 1))
        'Subtract the portion of the string that we're finished with:
        c=c+1
        strTemp = Right$(strTemp,Len(strTemp) - intPos)
    Wend

    'Now go thru the Tables array and make sure that no aliases exist:
    intPosSpace = 0
    j = 0
    For c = 0 To Ubound(aryUserid())
        aryUserid(c,1) = Trim(aryUserid(c, 1))
        intPosSpace = Instr(aryUserid(c, 1),Space(1))
        If intPosSpace Then
            'Add the alias to the alias array
            aryAlias(j, 0) = Trim(Right$(aryUserid(c, 1),Len(aryUserid(c, 1)) - intPosSpace ))
            'Remove the alias from the array:
            aryUserid(c, 1) = Left$(aryUserid(c, 1), intPosSpace - 1)
            'Add the fully qualified tablename to the alias array
            aryAlias(j, 1) = aryUserid(c,0) & "." & aryUserid(c,1)
            j = j+1
        End If
    Next
    If aryAlias(0,0) <> "" Then
        ParseSQLUserid = aryAlias
    End If

End Function
'++LotusScript Development Environment:2:1:SortByPos:1:8
Function SortByPos(aryPos() As Integer)
    'This function will sort the position number of
    'certain keywords in a SQL string

    Dim i%, j%, temp As Integer
    i = 0
    j = 0
    For i =  1 To Ubound(aryPos)
        temp =aryPos(i)
        For j = i + 1 To  Ubound(aryPos)
            If aryPos(j) <aryPos(i) Then
                aryPos(i) =aryPos(j)
                aryPos(j) = temp
                temp = aryPos(i)

            End If
        Next
    Next



End Function
'++LotusScript Development Environment:2:1:ReplaceAliases:1:8
Function ReplaceAliases(strSQLOriginal As String, strSQLclause As String) As String
    'Replaces alias names for tables with fully
    'qualified tablenames
    Dim aryTemp() As String
    Dim aryAliases As Variant
    Dim intPosAlias As Integer
    Dim intPosPeriod As Integer
    Dim j As Integer
    Dim strFind As String

    'Remove parentheses from strSQLclause if any exist:
    For c = 1 To Len(strSQLclause)
        If Mid$(strSQLclause, c,1) = "(" Or Mid$(strSQLclause, c,1) =")" Then
            'Do nothing
        Else
            strTemp = strTemp + Mid$(strSQLclause, c,1)
        End If
    Next
    strSQLClause = Trim$(strTemp)
    strTemp = ""

    'Remove quotations marks first:
    strFind =Chr(34)
    For c=1 To Len(strSQLclause)
        If Mid(strSQLclause, c, 1) = strFind  Then
            strTemp = strTemp
        Else
            strTemp = strTemp + Mid(strSQLclause, c,1)
        End If
    Next
    strSQLclause = strTemp
    strTemp = ""
    aryAliases = ParseSQLUserid(strSQLOriginal, aryTemp)

    'Continue only if aryAliases has aliases...
    If Not (Isarray(aryAliases)) Then
        Goto Finished
    End If
    'Look for a period:
    c=0
    CurStrLen = Len(strSQLclause)
    While c < CurStrLen
        For c = 1 To CurStrLen
            Select Case Mid$(strSQLclause,c,1)
            Case Space(1)
                strTemp = ""
            Case "."
            'Must have found an alias
                For j = 0 To Ubound(aryAliases)
                    If aryAliases(j,0) = strTemp Then
                        intPosAlias = c - Len(strTemp)
                    'We have an alias to replace:
                        strSQLClause = Left$(strSQLclause, intPosAlias - 1) & aryAliases(j,1) & "."    & Right$(strSQLClause, Len(strSQLClause) - (intPosAlias + Len(aryAliases(j,0))))
                        strTemp =  ""
                        c= c + Len(aryAliases(j,1)) + 1
                        CurStrLen = Len(strSQLclause)
                        Exit For
                    End If
                Next
            Case Else
                strTemp = strTemp & Mid$(strSQLclause,c,1)
            End Select
        Next

    Wend

Finished:
    ReplaceAliases = strSQLClause

End Function