home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1998 October A / Pcwk10a98.iso / Lotus / LOTUS / SMASTERS / APPROACH / DB2WWW.MPR / SCRIPT / A007ApprGlobObj897.s (.txt) < prev   
Encoding:
Null Bytes Alternating  |  1997-01-09  |  182.4 KB  |  2,691 lines

  1. '++LotusScript Development Environment:2:5:(Options):0:74
  2. Option Public
  3. '++LotusScript Development Environment:2:5:(Forward):0:1
  4. Declare Sub NextPage
  5. Declare Sub PrevPage
  6. Declare Function GetObjIndex(Objname As String) As Integer
  7. Declare Function GetForms(DocIndex As Integer, frmlist() As String) As Integer
  8. Declare Function GetRpts(DocIndex As Integer, rptlist() As String) As Integer
  9. Declare Function GetDocIndex(AprFile As String) As Integer
  10. Declare Sub CancelWWWAssist
  11. Declare Function GetViewsIndex(ViewName As String, DocIndex As Integer) As Integer
  12. Declare Sub FindAprs
  13. Declare Function GetUserIds(DocIndex As Integer, aryUserId() As String) As Integer
  14. Declare Function GetViewObj(ViewName As String, docindex As Integer) As Variant
  15. Declare Sub CollectObjs(frmName As String, rptName As String)
  16. Declare Sub DoneBtn(dbutton As Variant)
  17. 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
  18. 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
  19. Declare Function CreateHeader As Integer
  20. Declare Function GetSQLAssistant( arrWhereClauses() As String, arrTables() As String, arrColumns() As String, frmForm As Variant )    
  21. Declare Function GetJoins(  arrWhereClauses() As String, arrTables() As String, frmForm As Variant, arrUserid() As String ) As Integer
  22. Declare Function SmartAdd( arr() As String, item As String ) As Integer
  23. Declare Function GenerateDefineBegin() As Integer
  24. Declare Function GenerateDefineEnd() As Integer
  25. Declare Function GenerateDefineClauses( intSearchType As Integer, arrWhereClauses() As String, frmForm As Variant, arrTables() As String, arrUserid() As String ) As Integer
  26. Declare Function GenerateDefineTables(arrTables() As String) As Integer
  27. Declare Function GenerateDefineColumns(rptReport As Report, arrColumns() As String, arrUserid() As String) As Integer
  28. Declare Function GenerateHTML_REPORT( strCmdName As String ) As Integer
  29. 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
  30. Declare Function GetAfterLastSlash( strString As String ) As String
  31. Declare Function GenerateSQL( rptReport As Report, strCmdName As String, strDefaultMessage As String, WebTemplate As String, imagePath As String) As Integer
  32. Declare Function ParseString( arrArray() As String, strString As String) As Integer
  33. Declare Function GetFullTableName( strTableName As String, aryLookup() As String ) As String
  34. Declare Function GenerateDefineClause( control As Variant, arrTables() As String, arrUserid() As String) As Integer
  35. 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)
  36. Declare Sub PrintFormTitle(numFile As Integer, vartextbox As Variant)
  37. Declare Sub PrintFldBx(numFile As Integer, varfldbx As Variant)
  38. Declare Sub PrintRadioBtn(NumFile As Integer, varrdobtn As Variant)
  39. Declare Sub PrintCbx(numFile As Integer, varCbx As Variant)
  40. Declare Function GetObj(objary As Variant)
  41. Declare Sub SortItByY
  42. Declare Sub GroupRdoBtn
  43. Declare Sub PrintHtmlGood
  44. Declare Function PrintLbx(numFile As Integer, varlbx As Variant)
  45. Declare Sub SortItByX
  46. Declare Sub PrintRptHtml(filenum As Integer, rptObject As Variant, WebTemplate As String, imagePath As String)
  47. Declare Sub PrintFldBx2(numFile As Integer, varfldbx As Variant)
  48. Declare Function PrintPic(numFile As Integer, varpic As Variant, iPath As String)
  49. Declare Function PrintTextBox(numFile As Integer, vartextbox As Variant)
  50. Declare Function htmlString3(vartext As String) As String
  51. Declare Function GetMethod(frmMethod As Integer) As String
  52. Declare Function GetColumns(myTable As Variant)
  53. Declare Sub FindTest
  54. Declare Function PrintDropbx(numFile As Integer, varDropbx As Variant)
  55. Declare Function GetTable(strTablename As String, docindex As Integer) As Variant
  56. Declare Sub PrintSearch(filenum As Integer, Searchtype As Integer)
  57. Declare Function HtmlFntSz(fntSize As Integer) As Integer
  58. Declare Function chkRadioPrinted(objDataField As String) As Integer
  59. Declare Sub PrintActionBtns(numFile As Integer)
  60. Declare Function NoSpaceStr(StrLabelText As String) As String
  61. Declare Sub chkLineNumber(numFile As Integer, objvar As Variant)
  62. Declare Function strLblByPosition(objvar As Variant, txtPos As Integer) As String
  63. Declare Sub PrintShowSQL(filenum As Integer, ShowSQL As Integer)
  64. Declare Function GetTableIndex(strTablename As String, docName As Variant) As Integer
  65. Declare Function htmlString(vartext As String) As String
  66. Declare Function FormatPath(imagepath As String) As String
  67. Declare Function strLblByPosition2(objvar As Variant, txtPos As Integer) As String
  68. Declare Sub ReturnWinTitle
  69. Declare Function ParseUserid(FullTablePath As String) As String
  70. Declare Sub PrintCredits(FileNum As Integer)
  71. Declare Sub GetWebTemplate(PicName As String)
  72. Declare Sub Sub1
  73. Declare Sub QuitAssistant
  74. Declare Function ParseSQLUserid(strSQL As String, aryUserid() As String) As Variant
  75. Declare Function SortByPos(aryPos() As Integer)
  76. Declare Function ReplaceAliases(strSQLOriginal As String, strSQLclause As String) As String
  77.  
  78. '++LotusScript Development Environment:2:5:(Declarations):0:10
  79.  
  80. '****************************Variable Declarations**********************************************
  81.  
  82. 'Dim aryFieldnames() As String
  83. Dim ObjSorted () As Variant
  84. Dim lastradio() As String
  85.  
  86. Dim lastLineNo As Integer 'to keep track of which line we're on in the html doc
  87. Dim CurXCoor As Integer 'to keep track of the current column
  88.  
  89. Dim aryRadioBtn() As Variant
  90. Dim NumRadioButtons As Integer 'Used while collecting all of the radiobuttons
  91. Dim RadioCounter As Integer ' Used to count through the lastradio array
  92. Dim TotalObjs As Integer 'Used to count the number of objects we selected in GetObj
  93.  
  94. '*****************************************************************************************************************************
  95. 'Front end gui declarations - some of these are placed here to reset the assistant back to current values
  96. 'after returning from error table view
  97. Dim gFlagLoaded As Integer
  98. Dim gPageLoaded As Integer
  99. Dim gCurPage As Integer
  100. 'These are the actual view that will be passed to db2www macro generator
  101. Dim frmObject As Variant
  102. Dim rptObject As Report
  103.  
  104. 'Things collected from panel 1
  105. Dim DocIndex As Integer
  106. 'Collected from panel 2:
  107. Dim WebTemplate As String
  108. 'Collected from panel 3:
  109. Dim MacName As String
  110.  
  111.  
  112. '***************************************************************************************************
  113. 'Following windows functions will be used to set the window title of the WWW Assistant 
  114. Declare Function GetActiveWindow Lib "User32" () As Integer
  115. Declare Sub SetWindowTextA Lib "User32" (Byval hWnd As Integer, Byval LpString As String)
  116.  
  117. 'Declare Function SetCursor Lib "user32" Alias "SetCursor" (Byval hCursor As Long) As Long
  118. '***************************************************************************************************
  119.  
  120. 'Dim searchpath As String ' variable used for opening an apr
  121.  
  122. 'Mike's declarations
  123. Dim intMacroFileHandle As Integer
  124.  
  125.  
  126. Dim ColorState As Integer
  127.  
  128. 'Busy cursor functions
  129. Declare Function LoadCursorBynum Lib "user32" Alias "LoadCursorA" (Byval hInstance As Long, Byval lpCursorName As Long) As Long
  130. Declare Function SetCursor Lib "user32" Alias "SetCursor" (Byval hCursor As Long) As Long
  131.  
  132. Public Const IDC_ARROW = 32512&
  133. Public Const IDC_WAIT = 32514&
  134.  
  135. 'For finding browser and readme:
  136. 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
  137. 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
  138. 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
  139. Declare Public Function RegCloseKey Lib "advapi32" Alias "RegCloseKey" (Byval HKEY As Long) As Long
  140. 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
  141.  
  142. Dim gInit As Integer 'To determine if file was opened already - a workaround because the docopen event gets called
  143.  
  144.  
  145. '++LotusScript Development Environment:2:2:NextPage:1:8
  146. Sub NextPage
  147.     On Error Resume Next
  148.     ThisPage = currentview.currentpagenum
  149.     Currentview.Currentpagenum = ThisPage + 1 
  150.     
  151.     Err = 0
  152. End Sub
  153. '++LotusScript Development Environment:2:2:PrevPage:1:8
  154. Sub PrevPage
  155.     On Error Resume Next
  156.     ThisPage = currentview.currentpagenum
  157.     Currentview.Currentpagenum = ThisPage - 1 
  158.     
  159.     Err = 0
  160. End Sub
  161. '++LotusScript Development Environment:2:1:GetObjIndex:1:8
  162. Function GetObjIndex(Objname As String) As Integer
  163.     
  164.     'I have to do this to get around a bug with not being able to access objectnames directly
  165.     'This needs to be used with the objectlist collection
  166.     
  167.     i = 0
  168.     Forall objects In currentview.objectlist
  169.         If Lcase$(currentview.objectlist(i).name) = Objname$ Then
  170.             GetObjIndex = i
  171.             Exit Function
  172.         End If
  173.         i = i + 1
  174.     End Forall
  175. End Function
  176. '++LotusScript Development Environment:2:1:GetForms:1:8
  177. Function GetForms(DocIndex As Integer, frmlist() As String) As Integer
  178.     'This function will return a value that will tell the user if any forms were retrieved.
  179.     'It takes the apr file name as the argument and returns a value to let
  180.     'the user know if any forms were found.
  181.     
  182.     
  183.     
  184.     i = 0
  185.     GetForms = 0
  186.     arycnt = 0
  187.     Redim FrmList(0 To CurrentApplication.Documents(DocIndex).Views.count)
  188.     
  189.     Forall Views In CurrentApplication.Documents(DocIndex).Views
  190.         If currentApplication.Documents(DocIndex).Views(i).type = $aprForm Then
  191.             FrmList(arycnt) = currentApplication.Documents(DocIndex).Views(i).name
  192.             arycnt = arycnt + 1
  193.             GetForms=1
  194.         End If    
  195.         i = i + 1
  196.     End Forall
  197.     
  198.     
  199. End Function
  200. '++LotusScript Development Environment:2:1:GetRpts:1:8
  201. Function GetRpts(DocIndex As Integer, rptlist() As String) As Integer
  202.     'This function will return a value that will tell the user if any reports were retrieved.
  203.     'It takes the apr file name as the argument and returns a value to let
  204.     'the user know if any reports were found.
  205.     
  206.     i = 0
  207.     arycnt = 0
  208.     Redim RptList(0 To CurrentApplication.Documents(DocIndex).Views.count) 
  209.     
  210.     
  211.     Forall Views In CurrentApplication.Documents(DocIndex).Views
  212.         If currentApplication.Documents(DocIndex).Views(i).type = $aprReport Then
  213.             RptList(arycnt) = currentApplication.Documents(DocIndex).Views(i).name
  214.             arycnt = arycnt + 1
  215.             GetRpts =1
  216.         End If    
  217.         i = i + 1
  218.     End Forall
  219.     
  220.     
  221. End Function
  222. '++LotusScript Development Environment:2:1:GetDocIndex:1:8
  223. Function GetDocIndex(AprFile As String) As Integer
  224.     'This function takes the name of an apr file
  225.     'And returns the value of the index number where it
  226.     'is located in the base collection documents
  227.     
  228.     'Need to get the index number of the file we are looking for
  229.     
  230.     j = 0
  231.     
  232.     Forall Documents In currentapplication.Documents
  233.         
  234.         If currentApplication.documents(j).name = AprFile Then
  235.             GetDocIndex = j
  236.         End If    
  237.         j = j + 1
  238.     End Forall
  239.     
  240. End Function
  241. '++LotusScript Development Environment:2:2:CancelWWWAssist:1:8
  242. Sub CancelWWWAssist
  243.     'Closes the assistant form dialog    
  244.     On Error Resume Next    'If there are any errors, ignore them and close the assistant
  245.     Call QuitAssistant
  246.     
  247. End Sub
  248. '++LotusScript Development Environment:2:1:GetViewsIndex:1:8
  249. Function GetViewsIndex(ViewName As String, DocIndex As Integer) As Integer
  250.     
  251.     'This function will take the view name that we are looking for and the index number of the apr we
  252.     'should look in.
  253.     'This will return the appropriate index number for the view we are looking for.
  254.     
  255.     i = 0
  256.     Forall views In CurrentApplication.Documents(DocIndex).views
  257.         If CurrentApplication.Documents(DocIndex).views(i).name = ViewName Then
  258.             GetViewsIndex = i
  259.             Exit Function
  260.         End If
  261.         i = i + 1 'Go to the next item in the array 
  262.     End Forall
  263.     
  264.     'If for some reason the view index is not found - return a value that can't be an index:
  265.     GetViewsIndex = -1
  266. End Function
  267. '++LotusScript Development Environment:2:2:FindAprs:1:8
  268. Sub FindAprs
  269.     
  270.     ' List all approach files in the specified path
  271.     Dim pathName As String, fileName As String
  272.     pathName$ = searchpath$ & "*.apr"
  273.     fileName$ = Dir$(pathName$, 0)
  274.     
  275.     Do While fileName$ <> ""
  276.         Print fileName$
  277.         CurrentView.objectlist(0).addlistitem filename$
  278.         fileName$ = Dir$()
  279.     Loop
  280. End Sub
  281. '++LotusScript Development Environment:2:1:GetUserIds:1:8
  282. Function GetUserIds(DocIndex As Integer, aryUserId() As String) As Integer
  283.     'This function will take the Document index of the document selected by the user,
  284.     'and go through to provide all of the tablenames and userids for that document
  285.     'Return value will indicate if this was successfully done or not.
  286.     Dim i%, numtables%, querystate As Integer
  287.     Dim myTables As BaseCollection
  288.     Dim tbl_UserId As String
  289.     Dim rs As resultset
  290.     
  291.     Const constTable = True
  292.     Const constSQL = False
  293.     
  294.     i = 0
  295.     GetUserIds = 0 'initially 0 - not done
  296.     'Determine first if we have an apr that is the result of the SQL assistant
  297.     ' or has full tables:
  298.     Set myTables = CurrentApplication.Documents(DocIndex).tables
  299.     Set rs = myTables(i).createresultset
  300.     If rs.query.sql = "" Then
  301.         'Must have tables instead
  302.         QueryState = constTable
  303.     Else
  304.         QueryState = constSQL
  305.     End If
  306.     
  307.     If QueryState Then
  308.         
  309.         numTables = myTables.count
  310.         Redim aryUserId(0 To numTables, 0 To 1)
  311.         Forall tables In myTables
  312.             Set rs = myTables(i).createresultset 'Create result set for the current table
  313.             tbl_UserId = ParseUserid(rs.query.tablename)
  314.             aryUserId(i, 0) = tbl_UserId 'store the userid
  315.             aryUserId(i, 1) = myTables(i).tablename 'store the table name
  316.             i = i + 1
  317.         End Forall    
  318.     Else
  319.         Call ParseSQLUserid(RS.Query.SQL, aryUserid())
  320.     End If
  321.     
  322.     
  323.     
  324.     
  325.     
  326.     GetUserIds = 1 'Finished
  327.     
  328. End Function
  329. '++LotusScript Development Environment:2:1:GetViewObj:1:8
  330. Function GetViewObj(ViewName As String, docindex As Integer) As Variant
  331.     'Return the view that we're looking for
  332.     
  333.     Forall views In CurrentApplication.Documents(docindex).views
  334.         If views.name = ViewName Then
  335.             Set GetViewObj = views
  336.             Exit Function
  337.         End If
  338.     End Forall
  339.     'If we don't find the view return an error:
  340.     GetViewObj = -1
  341.     
  342. End Function
  343. '++LotusScript Development Environment:2:2:CollectObjs:1:8
  344. Sub CollectObjs(frmName As String, rptName As String)
  345.     Set frmObject = GetViewObj(frmName, DocIndex)
  346.     Set rptObject = GetViewObj(rptName, DocIndex)
  347. End Sub
  348. '++LotusScript Development Environment:2:2:DoneBtn:1:8
  349. Sub DoneBtn(dbutton As Variant)
  350.     'Clear any previous errors
  351.     Err = 0
  352.     On Error Goto gnrlError    'Area for handling general errors from here on out...
  353.     Dim waitcursor As Long
  354.     Dim arrowcursor As Long
  355.     Dim prevcursor As Long
  356.     
  357.     waitcursor = LoadCursorBynum(0, IDC_WAIT)
  358.     arrowcursor = LoadCursorBynum(0, IDC_ARROW)
  359.     
  360.     prevcursor = SetCursor(waitcursor)
  361.     
  362.     
  363.     
  364.     Dim aryUserId() As String
  365.     Dim ClearIt(0) As String
  366.     'The done button is available on the last three panels
  367.     'Retreive the current values from all the last three panels
  368.     'And doublecheck that the macro file doesn't already exist
  369.     '*********Place values from Panel 3 into global variables:
  370.     
  371.     
  372.     
  373. 'Front End (GUI) Declarations
  374.     'From Panel 2
  375.     
  376.     
  377. 'Things collected from panel 2
  378.     Dim FormSelected As String 'This will hold the name of the form selected
  379.     Dim RptSelected As String 'This will hold the name of the report selected
  380.     Dim RptAsForm As Integer 'This will tell us if user wants to use the report as the html form
  381.     
  382. 'Things that will get retreived from panel 3
  383.     Dim strUserid As String
  384.     Dim strPswd As String
  385.     Dim Pswd_Opt As Integer    'This is the variable that indicates prompt or always use for password
  386.     Dim Userid_opt As Integer    'This is the variable that indicates prompt or always use for userid
  387.     Dim dbname As String
  388.     Dim macname As String 'This is where we'll store the path and name of the macro file
  389.     
  390. 'Things that will get retreived from panel 4
  391.     Dim ShowSearch As Integer
  392.     Dim ShowSql As Integer
  393.     Dim NumRows As Integer 'The number of rows to return in the report
  394.     
  395. 'Things that will get retreived from panel 5
  396.     Dim imagepath As String
  397.     Dim macpath As String
  398.     Dim exename As String
  399.     Dim case_conv As Integer
  400.     Dim FormMethod As Integer
  401.     
  402.     'Grey out the done button
  403.     
  404.     dbutton.font.color.setrgb color_30_gray
  405.     
  406.     '*******************************************Start Retreiving Values*************************************************************************8
  407.     'Retreive values from panel 2:
  408.     With CurrentDocument.WWW~ Assistant.body
  409.         rptAsForm = Val(.cbxRptAsForm.value)
  410.         If rptAsForm = 1 Then
  411.             FormSelected =  .lbReportsP2.text
  412.         Else
  413.             FormSelected = .lbformsP2.text
  414.         End If
  415.         RptSelected = .lbReportsP2.text    
  416.     End With    
  417.     
  418.     'Retreive values from panel 3:
  419.     With CurrentDocument.WWW~ Assistant.body
  420.         MacName$ = .txtMacName.text
  421.         strUserid = .txtUserid.text
  422.         strPswd  = .txtPswd.text
  423.         Pswd_Opt = Val(.cbxPromptPswd.value)
  424.         Userid_opt = Val(.cbxPromptUserid.value)
  425.         dbname = .txtDbName.text
  426.         'Make sure that we have a database name
  427.         If dbname=""  Then' No database name was entered
  428.             dbname = Inputbox("You must enter a valid database name", "Enter Database Name",,300, 300)
  429.             If dbname=""  Then  'Empty string means cancel
  430.                 dbutton.font.color.setrgb color_black
  431.                 Exit Sub
  432.             Else
  433.                 .txtDbName.text = dbname
  434.             End If
  435.         End If
  436.         
  437.     End With
  438.     
  439.     
  440.     'Let's check if the macro file already exists so that we don't accidentally overwrite something the user may want to keep:
  441.     On Error Goto whatnow
  442.     If Dir$(MacName$) <>"" Then
  443.         Beep 'If we find it warn the user
  444.         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
  445.         If answ% <> 6 Then 'If they don't choose YES,
  446.             MacName$ = Inputbox("Macro file name", "MacroFile",CurrentDocument.path & "myMacro.d2w",200,200)  'If they choose NO get a new macro file name
  447.             If MacName$="" Then 'user chose cancel
  448.                 dbutton.font.color.setrgb color_black
  449.                 Exit Sub
  450.             End If
  451.         End If
  452.     End If
  453.     'Check that there is a drive letter:
  454.     If Mid$(MacName$,2, 1) <> ":" Then
  455.         strPath$=Inputbox("Please enter a valid drive letter:", "Error Creating Macro File", "C:",300, 300)
  456.     End If
  457.     MacName$=strPath$ + MacName$
  458.     
  459.     'Check that the third character in the macro name is a backslash:
  460.     If Mid$(MacName$,3, 1) <> "\" Then
  461.         MacLeft$ = Left$(MacName$, 2)
  462.         MacRight$ = Right(MacName$, Len(MacName$) - 2)
  463.         MacName$ = MacLeft$ + "\" + MacRight$
  464.     End If
  465.     
  466.     'Retreive the values from panel 4:
  467.     With CurrentDocument.WWW~ Assistant.body
  468.         ShowSearch = Val(.rdoSearchPrompt.value) ' value for the group of radio buttons
  469.         ShowSql  = Val(.rdoSqlPrompt.value)
  470.         NumRows  =  Val(.txtNumRows.text)  'The number of rows to return in the report
  471.     End With
  472.     
  473.     'Retreive the values from panel 5:
  474.     
  475.     With CurrentDocument.WWW~ Assistant.body
  476.         imagepath  =FormatPath( .txtImagePath.text)
  477.         
  478.         macpath  = .txtMacroPath.text
  479.         exename  = .txtExeName.text
  480.         case_conv = Val(.rdoNoConvert.value) 'This will provide the value for the group of radio buttons
  481.         FormMethod  = Val(.rdoFormPost.value) ''This will provide the value for the group of radio buttons
  482.     End With
  483.     
  484.     'Reset values in the assistant:
  485.     With CurrentDocument.WWW~ Assistant.body
  486.         .lbopenapps.setlist(ClearIt)
  487.         .lbformsP2.background.color.setrgb color_white
  488.         .lbformsP2.readonly = False
  489.     End With
  490.     
  491.     
  492.     
  493.     prevcursor = SetCursor(waitcursor)
  494.     
  495.     'Retreive the userids for all of the tables
  496.     Call GetUserids(DocIndex, aryUserid)
  497.     
  498.     'Get the form and report objects:
  499.     
  500.     Call CollectObjs(formSelected, RptSelected)
  501.     
  502.     'Get the default Message
  503.     Dim strDefaultMsg As String
  504.     Dim myRs As Resultset
  505.     Set myRs = CurrentDocument.tables(0).createresultset
  506.     myRs.firstrow
  507.     strDefaultMsg = myRs.GetValue("defaultMsg")
  508.     
  509. 'Call the "Back end"    
  510.     
  511.     rc = Generate(dbname, strUserid, strPswd, ShowSQL, MacName$, macpath, imagepath, NumRows, case_conv, ShowSearch, strDefaultMsg, FormMethod, frmObject, rptObject, exeName, aryUserid, Userid_Opt, Pswd_opt, WebTemplate )    
  512.     If rc <>-2 Then    
  513.         rval = Messagebox ("DB2 WWW macro: " & MacName$ & " created successfully!", MB_OK + MB_ICONEXCLAMATION, "DB2 Web Sizing Assistant")
  514.         Err=0
  515.     Else 'This means the file could not be opened for some reason so reload the assistant:
  516.         Set CurrentWindow.Activeview= Currentdocument.www~ assistant
  517.         currentview.currentpagenum = 3
  518.         Exit Sub
  519.     End If
  520.     'Close the assistant dialogue
  521.     
  522.     Call QuitAssistant()
  523.     
  524. %REM
  525.     If CurrentApplication.ApplicationWindow.IsCommandEnabled(IDM_SAVE) Then
  526.         Sendkeys "{tab}~",0
  527.     End If
  528.     'CurrentApplication.visible = True
  529.     
  530.     
  531.     'CurrentApplication.db2www.window.close
  532. %END REM    
  533.     prevcursor = SetCursor(arrowcursor)
  534.     
  535. Whatnow:
  536.     If Error$ = "Path not found" Then
  537.         Msgbox "Path not found" & Chr(10) & "Please enter valid path and filename",,"Error"
  538.         Err=0    'Reset the current error to nothing!
  539.         Currentview.currentpagenum = 3
  540.         dbutton.font.color.setrgb color_black
  541.         Exit Sub
  542.     End If
  543.     
  544. gnrlError:
  545.     If Err<>0 Then
  546.         Msgbox "The following Lotus Script error occured: " & Chr(10) & Error$, ,"Lotus Script Error"
  547.         Msgbox "The Web Sizing Assistant will close", ,"Lotus Script Error"
  548.         CurrentApplication.activedocwindow.close    'Close the dialog
  549.         CurrentApplication.applicationwindow.domenucommand(IDM_CLOSEANDDISC) 'close the document
  550.         End
  551.     End If
  552. End Sub
  553. '++LotusScript Development Environment:2:1:Generate:1:8
  554. 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
  555.     Dim rc As Integer 'Return Code    
  556.     Dim arrWhereClauses(100) As String    
  557.     Dim arrTables(100) As String    
  558.     Dim arrColumns(100) As String    
  559.     
  560.     'Initialize the WhereClauses and Tables collections
  561.     arrWhereClauses(0) = "0"
  562.     arrTables(0) = "0"
  563.     
  564.     'Open the Macro File for Write Access    
  565.     intMacroFileHandle = Freefile()
  566.     On Error Goto Whatnow
  567.     Open strMacroFile For Output Access Write Lock Write As intMacroFileHandle
  568.     
  569.     'Get SQL Assistant parts (where clauses, orders, groups)
  570.     rc = GetSQLAssistant( arrWhereClauses, arrTables, arrColumns, frmForm )    
  571.     
  572.     'Get Join Information
  573.     rc = GetJoins( arrWhereClauses, arrTables, frmForm, arrUserid )    
  574.     
  575.     'Create Header Information
  576.     rc = CreateHeader()
  577.     
  578.     'Create a DEFINE section
  579.     rc = GenerateDefineBegin()
  580.     rc = GenerateDefineVars( strDatabaseName, strUserid, strPassword, intShowSQL, intMaxRows, intDBCase, intUserid, intPassword )
  581.     rc = GenerateDefineClauses(  intSearchType, arrWhereClauses, frmForm,  arrTables, arrUserid )
  582.     'Rewritten on 12/17/96 -gf
  583.     'rc = GenerateDefineTables(  arrTables )
  584.     rc = GenerateDefineTables(arrUserid)
  585.     rc = GenerateDefineColumns( rptReport, arrColumns, arrUserid )
  586.     rc = GenerateDefineEnd()
  587.     
  588.     'Create an SQL section
  589.     rc = GenerateSQL( rptReport, "sql1",  strDefaultMessage, WebTemplate, strImagesDirectory)    
  590.     
  591.     'Create an HTML_INPUT section
  592.     rc = GenerateHTML_INPUT( strMacroFile, strMacroFileSubDirectory, strImagesDirectory, intShowSQL, intSearchType, intFormMethod, frmForm, strExecutableName, intUserid, intPassword , WebTemplate)    
  593.     
  594.     'Create an HTML_REPORT section
  595.     rc = GenerateHTML_REPORT( "sql1" )
  596.     
  597.     'Close the macro file
  598.     Close intMacroFileHandle
  599.     
  600.     Generate = rc    
  601. Whatnow:
  602.     If Error="Unable to open file" Or Error = "Path not found" Then
  603.         Msgbox "Unable to open file",, "Error Opening Macro File"
  604.         Generate = -2
  605.         Err=0 'Reset the error code
  606.         Exit Function
  607.     End If
  608. End Function
  609. '++LotusScript Development Environment:2:1:GenerateDefineVars:1:8
  610. 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
  611.     Dim rc As Integer    
  612.     
  613.     rc = 0    
  614.     
  615.     'First, let's set some simple variables    
  616.     Print #intMacroFileHandle, ,"DATABASE=", """" strDatabaseName """"
  617.     
  618.     Select Case intUserid
  619.     Case 0 : 'Prompt the User
  620.         'Do nothing here.  We will add an input field on the form
  621.     Case 1 : 'Hard-code the value passed in
  622.         Print #intMacroFileHandle, ,"LOGIN=",  """" strUserid """"
  623.     End Select
  624.     
  625.     Select Case intPassword
  626.     Case 0 : 'Prompt the User
  627.         'Do nothing here.  We will add an input field on the form
  628.     Case 1 : 'Hard-code the value passed in
  629.         Print #intMacroFileHandle, ,"PASSWORD=", """" strPassword """"
  630.     End Select
  631.     
  632.     Print #intMacroFileHandle, ,"RPT_MAX_ROWS=", """" Trim$(Str$(intMaxRows)) """"
  633.     
  634.     Select Case intShowSQL
  635.     Case 0 : 'Prompt the User
  636.         'Do nothing here.  We will add an input field on the input form.        
  637.     Case 1 : 'Always On
  638.         Print #intMacroFileHandle, ,"SHOWSQL=", """YES"""
  639.     Case 2 : 'Always Off
  640.         Print #intMacroFileHandle, ,"SHOWSQL=", """NO"""
  641.     Case Else :
  642.         rc = 999
  643.     End Select        
  644.     
  645.     Select Case intDBCase
  646.     Case 0 : 'Do not set the variable -- no conversion
  647.         'Do nothing here.        
  648.     Case 1 : 'Convert to lower case
  649.         Print #intMacroFileHandle, ,"DB_CASE=", """LOWER"""
  650.     Case 2 : 'Convert to upper case
  651.         Print #intMacroFileHandle, ,"DB_CASE=", """UPPER"""
  652.     Case Else :
  653.         rc = 998
  654.     End Select        
  655.     
  656.     GenerateDefineVars = rc    
  657. End Function
  658. '++LotusScript Development Environment:2:1:CreateHeader:1:8
  659. Function CreateHeader As Integer
  660.     CreateHeader = 0
  661.     
  662.     Print #intMacroFileHandle, "%{"
  663.     Print #intMacroFileHandle, "This macro file was generated by the DB2 Web Sizing Assistant for Lotus Approach"
  664.     Print #intMacroFileHandle,  "on " Date$ " at " Time$ "."
  665.     Print #intMacroFileHandle, "%}"
  666.     Print #intMacroFileHandle, 
  667.     
  668. End Function
  669. '++LotusScript Development Environment:2:1:GetSQLAssistant:1:8
  670. Function GetSQLAssistant( arrWhereClauses() As String, arrTables() As String, arrColumns() As String, frmForm As Variant )    
  671.     Dim rs As ResultSet
  672.     Dim strSQL As String
  673.     Dim strColumns As String
  674.     Dim strTables As String
  675.     Dim strClauses As String
  676.     Dim i,j As Integer
  677.     
  678.     Set rs = frmForm.Document.Tables(0).CreateResultSet()
  679.     strSQL = rs.Query.SQL
  680.     
  681.     If( strSQL<> "" ) Then
  682.         
  683.         strColumns = ""
  684.         strTables = ""
  685.         strClauses = ""
  686.         
  687.         i = Instr( strSQL, " FROM " )
  688.         'Commented out on12/17/96
  689.         'strColumns = Mid$( strSQL, 8, i-9 ) 'Everything between "SELECT " and "FROM"
  690.         j = Instr( i+5, strSQL, " WHERE " )
  691.         If( j=0 ) Then
  692.             j = Instr( i+5, strSQL, " ORDER " )        
  693.         End If
  694.         If( j<>0 ) Then
  695.             strTables = Mid$( strSQL, i+5, j -i-6) 'Everything between "FROM" and "WHERE"
  696.             'Need to  replace aliases in the following string: 12/17/96 -gf
  697.             strClauses = Mid$( strSQL, j+6 )         
  698.             strClauses = ReplaceAliases(strSQL, strClauses)
  699.         End If
  700.         'Commented out on 12/17/96 -gf
  701.         'rc = ParseString( arrColumns, strColumns )
  702.         rc = ParseString( arrTables, strTables )
  703.         rc = ParseString( arrWhereClauses, strClauses )
  704.     End If
  705.     
  706.     GetSQLAssistant = 0
  707. End Function
  708. '++LotusScript Development Environment:2:1:GetJoins:1:8
  709. Function GetJoins(  arrWhereClauses() As String, arrTables() As String, frmForm As Variant, arrUserid() As String ) As Integer
  710.     Dim joins As Variant
  711.     Dim strTable1 As String
  712.     Dim strTable2 As String
  713.     Dim strWhereClause As String
  714.     Dim intJoinIndx, i, intNumJoins As Integer
  715.     
  716.     GetJoins = 0
  717.     
  718.     intJoinIndx = -1
  719.     joins = frmForm.Parent.JoinsInternal
  720.     
  721.     'If there is join information, then the IsArray function will return TRUE.  Otherwise, it will return FALSE.
  722.     If( Isarray(joins)  ) Then    
  723.         While( intJoinIndx < Ubound(joins))
  724.             intJoinIndx = intJoinIndx + 1
  725.             strTable1 = GetFullTableName( frmForm.Parent.Tables(Val(joins(intJoinIndx))).TableName, arrUserid ) 'Val added by Grace to convert string to numeric value
  726.             rc = SmartAdd( arrTables, strTable1 )
  727.             intJoinIndx = intJoinIndx + 1
  728.             strTable2 = GetFullTableName( frmForm.Parent.Tables(Val(joins(intJoinIndx))).TableName, arrUserid )
  729.             intJoinIndx = intJoinIndx + 1
  730.             rc = SmartAdd( arrTables, strTable2 )
  731.             intNumJoins =Val(joins(intJoinIndx))
  732.             For i=1 To intNumJoins
  733.                 intJoinIndx = intJoinIndx + 1
  734.                 strWhereClause = strTable1 +  "." + joins(intJoinIndx) +  "=" + strTable2 + "." +  joins(intJoinIndx+1)
  735.                 rc = SmartAdd( arrWhereClauses,  strWhereClause )    
  736.                 intJoinIndx = intJoinIndx + 1
  737.             Next
  738.         Wend
  739.     End If
  740.     
  741. End Function
  742. '++LotusScript Development Environment:2:1:SmartAdd:1:8
  743. Function SmartAdd( arr() As String, item As String ) As Integer
  744.     Dim found As Integer
  745.     
  746.     found = False
  747.     i  = 1
  748.     While (Not found) And ( i <= Val( arr(0) ) )
  749.         If arr(i) = item Then
  750.             found = True
  751.         Else
  752.             i = i + 1
  753.         End If
  754.     Wend
  755.     
  756.     If Not found Then
  757.         arr(0) = Str$( Val( arr(0) ) + 1 )
  758.         arr( Val( arr(0) ) ) = Trim$(item)
  759.     End If
  760.     
  761. End Function
  762. '++LotusScript Development Environment:2:1:GenerateDefineBegin:1:8
  763. Function GenerateDefineBegin() As Integer
  764.     
  765.     Print #intMacroFileHandle, "%DEFINE{"
  766.     
  767.     GenerateDefineBegin = 0
  768. End Function
  769. '++LotusScript Development Environment:2:1:GenerateDefineEnd:1:8
  770. Function GenerateDefineEnd() As Integer
  771.     
  772.     Print #intMacroFileHandle, "%}"
  773.     
  774.     GenerateDefineEnd = 0
  775. End Function
  776. '++LotusScript Development Environment:2:1:GenerateDefineClauses:1:8
  777. Function GenerateDefineClauses( intSearchType As Integer, arrWhereClauses() As String, frmForm As Variant, arrTables() As String, arrUserid() As String ) As Integer
  778.     Dim rc As Integer    
  779.     Dim i,j As Integer
  780.     Dim intRadioFound As Integer
  781.     Dim aryRadioNames(100) As String        
  782.     
  783.     rc = 0
  784.     
  785.     Print #intMacroFileHandle,
  786.     
  787.     'The AndOr variable is the "connector" for the where clauses
  788.     'used via user-input on the input form.
  789.     Select Case intSearchType
  790.     Case 0 : 'Prompt the User
  791.         'Do nothing here.  We will add an input field on the input form.        
  792.     Case 1 : 'Always On
  793.         Print #intMacroFileHandle, ,"ANDOR=", """AND"""
  794.     Case 2 : 'Always Off
  795.         Print #intMacroFileHandle, ,"ANDOR=", """OR"""
  796.     Case Else :
  797.         rc = 999
  798.     End Select        
  799.     
  800.     'The c2 variable is a list variable which will be instantiated
  801.     'by input criteria selected on the input form.
  802.     Print #intMacroFileHandle, ,"%LIST "" $(ANDOR) "" c2"
  803.     
  804.     'The c1 variable is a list variable which will be instantiated
  805.     'by clauses from the SQL Assistant and the Joins
  806.     Print #intMacroFileHandle, ,"%LIST "" AND "" c1"
  807.     Print #intMacroFileHandle, 
  808.     
  809.     For i=1 To  Val( arrWhereClauses(0) )     
  810.         Print #intMacroFileHandle, ,"c1 = """ arrWhereClauses(i) """"
  811.     Next
  812.     
  813.     Print #intMacroFileHandle, 
  814.     Print #intMacroFileHandle, ,"wc2 = ? ""WHERE $(c2)"""
  815.     Print #intMacroFileHandle, ,"andc2 = ? ""AND ($(c2))"""
  816.     
  817.     Print #intMacroFileHandle, ,"WHERELIST = c1 ? ""WHERE $(c1) $(andc2)"" : ""$(wc2)"""
  818.     Print #intMacroFileHandle, 
  819.     
  820.     'For each input control that maps to a database field on the input form,
  821.     'add a conditional clause that assigns a value to the c2 variable
  822.     For i=0 To frmForm.ObjectList.Count - 1    
  823.         Select Case frmForm.ObjectList(i).Type
  824.         Case $AprFieldBox, $AprCheckBox, $AprListBox, $AprDropDownBox :
  825.             If frmForm.ObjectList(i).DataTable <> "" Then
  826.                 rc = GenerateDefineClause( frmForm.ObjectList(i), arrTables, arrUserid )
  827.             End If
  828.         'Each radio button on the form is considered a separate control.  However, we only want to
  829.         'add an assignment statement to the macro file once per "group" of buttons (all which map to the same datafield)"
  830.         Case $AprRadioButton :
  831.             If frmForm.ObjectList(i).DataTable <> "" Then
  832.                 intRadioFound = False                
  833.                 'Loop through the RadioNames array to see if we have hit this datafield before            
  834.                 j=0
  835.                 While  (j <= intRadioIndex) And (Not intRadioFound) 
  836.                     If aryRadioNames(j) = frmForm.ObjectList(i).DataField Then
  837.                         intRadioFound = True                        
  838.                     Else                        
  839.                         j = j + 1
  840.                     End If
  841.                 Wend
  842.                 'If we have not seen this datafield, then add an assignment statement 
  843.                 If Not intRadioFound Then
  844.                     intRadioIndex = intRadioIndex + 1
  845.                     aryRadioNames(intRadioIndex) = frmForm.ObjectList(i).DataField
  846.                     rc = GenerateDefineClause( frmForm.ObjectList(i), arrTables, arrUserid )
  847.                 End If
  848.             End If
  849.         Case Else :                
  850.             'Do nothing            
  851.         End Select            
  852.     Next    
  853.     
  854.     GenerateDefineClauses = rc
  855. End Function
  856. '++LotusScript Development Environment:2:1:GenerateDefineTables:1:8
  857. Function GenerateDefineTables(arrTables() As String) As Integer
  858.     Dim rc As Integer
  859.     
  860.     rc=0
  861.     
  862.     'Create the TABLES list variable and populate it.    
  863.     Print #intMacroFileHandle, 
  864.     Print #intMacroFileHandle, ,"%LIST "",""  TABLES"
  865.     
  866. %REM re-written on 12/17/96 -gf
  867.     For i=1 To Val( arrTables(0) )    
  868.         Print #intMacroFileHandle, ,"TABLES  =  """ arrTables(i) """"
  869.     Next
  870. %END REM
  871.     
  872.     For i = 0 To Ubound(arrTables) 'added on 1/16/97 to fix Senan's bug
  873.         If (arrTables(i,0) & arrTables(i,1)) <> "" Then 'check that these elements aren't empty first
  874.             Print #intMacroFileHandle, ,"TABLES  =  """ arrTables(i,0) & "." & arrTables(i,1) """"    
  875.         End If
  876.         
  877.     Next
  878.     GenerateDefineTables = rc
  879. End Function
  880. '++LotusScript Development Environment:2:1:GenerateDefineColumns:1:8
  881. Function GenerateDefineColumns(rptReport As Report, arrColumns() As String, arrUserid() As String) As Integer
  882.     Dim rc As Integer
  883.     Dim i As Integer    
  884.     
  885.     rc=0
  886.     
  887.     'Create the COLUMNS list variable and populate it.    
  888.     Print #intMacroFileHandle, 
  889.     Print #intMacroFileHandle, ,"%LIST "",""  COLUMNS"
  890.     
  891.     For i=0 To rptReport.ObjectList.Count - 1    
  892.         Select Case rptReport.ObjectList(i).Type
  893.         Case $AprFieldBox, $AprCheckBox :
  894.             If rptReport.ObjectList(i).DataTable <> "" Then
  895.                 rc = SmartAdd( arrColumns, GetFullTableName( rptReport.ObjectList(i).DataTable, arrUserid ) & "." & Ucase$(rptReport.ObjectList(i).DataField ))
  896.             End If
  897.         Case Else :                
  898.             'Do nothing            
  899.         End Select            
  900.     Next
  901.     
  902.     For i=1 To Val( arrColumns(0) )
  903.         Print #intMacroFileHandle, ,"COLUMNS  =  """ arrColumns(i) """"
  904.     Next
  905.     
  906.     GenerateDefineColumns = rc
  907. End Function
  908. '++LotusScript Development Environment:2:1:GenerateHTML_REPORT:1:8
  909. Function GenerateHTML_REPORT( strCmdName As String ) As Integer
  910.     Dim rc As Integer
  911.     
  912.     rc=0
  913.     
  914.     Print #intMacroFileHandle, 
  915.     Print #intMacroFileHandle, "%HTML_REPORT{"
  916.     'Print #intMacroFileHandle, "<HTML>"
  917.     Print #intMacroFileHandle, "%EXEC_SQL(" strCmdName ")"
  918.     'Print #intMacroFileHandle, "</HTML>"
  919.     Print #intMacroFileHandle, "%}"
  920.     
  921.     GenerateHTML_REPORT = rc    
  922.     
  923. End Function
  924. '++LotusScript Development Environment:2:1:GenerateHTML_INPUT:1:8
  925. 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
  926.     Dim rc As Integer 'Return Code    
  927.     Dim strFormMethod As String    
  928.     Dim strAction As String    
  929.     Dim strMacroName As String
  930.     Dim strExtraFields As String
  931.     rc = 0
  932.     
  933.     If intFormMethod = 0 Then
  934.         strFormMethod = "POST"
  935.     Else
  936.         strFormMethod= "GET"
  937.     End If
  938.     
  939.     strMacroName = GetAfterLastSlash( strMacroFile )    
  940.     
  941.     If strMacroFileSubDirectory = "" Then
  942.         strAction = strExecutableName & "/" & strMacroName & "/report"
  943.     Else
  944.         strAction = strExecutableName & "/" & strMacroFileSubDirectory & "/" & strMacroName & "/report"
  945.     End If
  946.     
  947.     strExtraFields = ""    
  948.     
  949.     If intUserid = 0 Then    
  950.         strExtraFields = strExtraFields & "<Font Size=2>Userid: <INPUT TYPE=""text"" NAME=""LOGIN""><br>"
  951.     End If
  952.     
  953.     If intPassword = 0 Then
  954.         strExtraFields = strExtraFields & "<Font Size=2>Password: <INPUT TYPE=""password"" NAME=""PASSWORD""><br>"
  955.     End If
  956.     
  957.     If intSearchType = 0 Then
  958.         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>"
  959.     End If
  960.     
  961.     If ( intShowSQL = 0 ) Then
  962.         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>"    
  963.     End If        
  964.     
  965.     'Add some space between these added fields and the rest of the input form.    
  966.     If( strExtraFields <> "" ) Then
  967.         strExtraFields = strExtraFields & "<P>"
  968.     End If
  969.     
  970.     Print #intMacroFileHandle, 
  971.     Print #intMacroFileHandle, "%HTML_INPUT{"
  972.     
  973. '    Print #intMacroFileHandle, SaveViewAsHTML( frmForm, strFormMethod, strAction, strExtraFields )    
  974.     
  975.     Call  PrintFrmHtml(intMacroFileHandle, frmForm, intFormMethod, strAction , strImagesDirectory, 1,1, strExtraFields, WebTemplate ) 'Note: image directory must have forward slash
  976.     
  977.     Print #intMacroFileHandle, "%}"
  978.     
  979.     GenerateHTML_INPUT = rc    
  980. End Function
  981. '++LotusScript Development Environment:2:1:GetAfterLastSlash:1:8
  982. Function GetAfterLastSlash( strString As String ) As String
  983.     Dim intLastSlash As Integer
  984.     Dim begin, temp As Integer
  985.     
  986.     intLastSlash = 0
  987.     begin = 1
  988.     
  989.     Do
  990.         temp = Instr( begin, strString, "\" )
  991.         If( temp > intLastSlash ) Then
  992.             intLastSlash = temp
  993.             begin = temp + 1
  994.         End If
  995.     Loop Until (temp=0)
  996.     
  997.     GetAfterLastSlash = Mid$( strString, intLastSlash+1 )
  998.     
  999. End Function
  1000. '++LotusScript Development Environment:2:1:GenerateSQL:1:8
  1001. Function GenerateSQL( rptReport As Report, strCmdName As String, strDefaultMessage As String, WebTemplate As String, imagePath As String) As Integer
  1002.     Dim rc As Integer
  1003.     Dim i As Integer    
  1004.     Dim rs As ResultSet
  1005.     Dim intNumRows As Integer
  1006.     Dim strErrorCode As String
  1007.     rc=0
  1008.     
  1009.     Print #intMacroFileHandle, 
  1010.     Print #intMacroFileHandle, "%SQL(" strCmdName ") {"
  1011.     Print #intMacroFileHandle, ,"SELECT $(COLUMNS) FROM $(TABLES) $(WHERELIST)"
  1012.     
  1013.     'Generate the SQL_REPORT section, which includes converting the Approach form to HTML    
  1014.     
  1015.     
  1016.     Call PrintRptHtml(intMacroFileHandle, rptReport, WebTemplate, imagePath)
  1017.     
  1018.     'Print the SQL Message Section, if necessary
  1019.     
  1020.     'Set rs = CurrentDocument.Tables(0).CreateResultSet()    Commented out and modiified by Grace 7/19 - app tried to create rs from the wrong apr
  1021.     Set rs = CurrentDocument.Tables(0).CreateResultSet()    
  1022.     
  1023.     intNumRows = rs.NumRows()    
  1024.     If (intNumRows > 0) Or (Trim$(strDefaultMessage) <> "") Then  'Trim added on 7/23 by G. 
  1025.         rs.FirstRow 
  1026.         chkEmpty$ = rs.GetValue("ErrorCode")
  1027.         If chkEmpty$ <> "" Then
  1028.             Print #intMacroFileHandle, "%SQL_MESSAGE{"
  1029.             
  1030.             For i=1 To intNumRows
  1031.                 strErrorCode = rs.GetValue("ErrorCode")
  1032.                 
  1033.             'There is a bug in db2www where it considers ":Exit" following a negative error code to
  1034.             'be an error.  Until this is fixed, we must ignore the action for negative return codes to
  1035.             'avoid the syntax error message is fixed.  Once the db2www bug is fixed, this if test
  1036.             'can be removed and the "Else" condition should always be executed.
  1037.                 If( Left$(strErrorCode, 1) = "-" ) Then
  1038.                     Print #intMacroFileHandle, strErrorCode " : " """" rs.GetValue("Message") """" 
  1039.                 Else
  1040.                     Print #intMacroFileHandle, strErrorCode " : " """" rs.GetValue("Message") """" rs.GetValue("SQL_Action")
  1041.                 End If
  1042.                 
  1043.                 
  1044.                 rs.NextRow
  1045.             Next
  1046.             
  1047.             'If a Default Message was specified (it is not NULL) then print it in the SQL_Message section        
  1048.             If( strDefaultMessage <> "" ) Then
  1049.                 Print #intMacroFileHandle, "default : " """" strDefaultMessage """"        
  1050.             End If
  1051.             Print #intMacroFileHandle, "%}"
  1052.         End If    
  1053.     End If
  1054.     
  1055.     
  1056.     Print #intMacroFileHandle, "%}"
  1057.     
  1058.     GenerateSQL = rc
  1059. End Function
  1060. '++LotusScript Development Environment:2:1:ParseString:1:8
  1061. Function ParseString( arrArray() As String, strString As String) As Integer
  1062.     Dim rc As Integer
  1063.     Dim temp As Integer
  1064.     
  1065.     rc= 0
  1066.     
  1067.     Do
  1068.         temp = Instr( strString, "," )
  1069.         If temp = 0 Then
  1070.             rc = SmartAdd( arrArray, strString )
  1071.         Else            
  1072.             rc = SmartAdd( arrArray, Left$(strString, temp-1)    )
  1073.             strString = Right$( strString, Len(strString) - temp )            
  1074.         End If
  1075.     Loop Until (temp=0)
  1076.     
  1077.     ParseString = rc
  1078. End Function
  1079. '++LotusScript Development Environment:2:1:GetFullTableName:1:8
  1080. Function GetFullTableName( strTableName As String, aryLookup() As String ) As String
  1081.     Dim i As Integer
  1082.     
  1083.     GetFullTableName = ""
  1084.     
  1085.     i=0
  1086.     While( (aryLookup(i,1) <> strTableName) And (aryLookup(i,1) <> "") )
  1087.         i = i+1
  1088.     Wend
  1089.     GetFullTableName =  aryLookup(i,0) & "." & aryLookup(i,1)
  1090.     
  1091. End Function
  1092. '++LotusScript Development Environment:2:1:GenerateDefineClause:1:8
  1093. Function GenerateDefineClause( control As Variant, arrTables() As String, arrUserid() As String) As Integer
  1094.     Dim rc As Integer
  1095.     Dim strFullTableName As String
  1096. '    Dim rs As ResultSet
  1097. '    Dim i As Integer    
  1098.     Dim strVariableName As String
  1099.     rc=0
  1100.     
  1101.     strFullTableName = GetFullTableName( control.DataTable, arrUserid )
  1102.     rc = SmartAdd( arrTables,  strFullTableName )   'Add to the list of Tables
  1103.     
  1104. '    i=0    
  1105. '    While( ( i < control.Parent.Parent.Document.Tables.Count ) And ( control.Parent.Parent.Document.Tables(i).Tablename <> control.DataTable ) )
  1106. '        i = i+1
  1107. '    Wend
  1108.     
  1109. '    Set rs = control.Parent.Parent.Document.Tables(i).CreateResultSet()
  1110.     
  1111. '    Select Case rs.FieldNativeDataType( control.DataField )
  1112.     'Print control.DataTable "." control.DataField control.Parent.Parent.Document.Tables(i).GetFieldType( control.DataField ) 
  1113. '    Forall elements In currentapplication.documents(0).tables(0).fieldnames 
  1114. '        Ftype= currentapplication.documents(0).tables(0).getfieldtype(elements)
  1115. '        Print Ftype                                            
  1116. '    End Forall                                              
  1117.     
  1118.     strVariableName = control.DataTable + "_" + control.DataField    
  1119. '    Select Case control.Parent.Parent.Document.Tables(i).GetFieldType( control.DataField ) 
  1120. '    Case SQL_CHAR, SQL_VARCHAR, SQL_DATE, SQL_TIME : 'Prompt the User
  1121. '    Case aprFieldText, aprFieldDate, aprFieldTime : 'Prompt the User
  1122.     Print #intMacroFileHandle, ,"c2 = ? """  strFullTableName "." control.DataField " LIKE '%$(" strVariableName ")%'"""
  1123. '    Case Else :
  1124. '        Print #intMacroFileHandle, ,"c2 = ? """  strFullTableName "." control.DataField " = $(" strVariableName ")"""
  1125. '    End Select        
  1126.     
  1127.     
  1128.     GenerateDefineClause = rc    
  1129. End Function
  1130. '++LotusScript Development Environment:2:2:PrintFrmHtml:1:8
  1131. 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)
  1132.     Dim lStr, rStr As String
  1133.     aryCounter = 0
  1134.     flag = 0
  1135.     radioCounter = 0
  1136.     
  1137.     
  1138.     'Store the objects in an array
  1139.     Call GetObj(frmObject.objectlist)    'The form I picked
  1140.     'To be used to get best-guess datafield for dropdownboxes and listboxes
  1141.     'GetColumns(frmObject.parent.tables(GetTableIndex(frmObject.maintable, frmObject.parent))) 'need to adjust
  1142.     'Sort the array by its y coordinate first
  1143.     SortItByY
  1144.     'Now let's split the objects line by line and sort by x coordinate
  1145.     SortItByX
  1146.     'Have to group the radiobuttons in order to group them correctly in the cells
  1147.     GroupRdoBtn
  1148.     Redim lastradio(0 To numRadioButtons)    
  1149.     
  1150.     'Determine the form method first:
  1151.     frmMethodstr = GetMethod(frmMethod)
  1152.     
  1153.     
  1154.     
  1155.     
  1156.     Print #fileNum%,"<HTML>"
  1157.     Print #fileNum%, "<Head><Title>" & frmObject.name & "</Title></Head>"
  1158.     If WebTemplate <> "" Then 'Must mean that user selected a background
  1159.         Print #fileNum%, "<Body Background=""" & imagepath & WebTemplate & """>"
  1160.     Else
  1161.         'Get the background color for the form:
  1162.         frmColor = frmObject.body.background.color.getrgb()
  1163.         'Convert to hex
  1164.         tempColor = Hex$(frmColor)
  1165.         WebColor = Right (tempColor, Len(tempColor) - 1)
  1166.         If WebColor = "0C0C0" Then 'This is an incorrect value for the default background color
  1167.             WebColor = "C0C0C0"
  1168.         End If
  1169.         Print #fileNum%, "<Body BGColor=""" & WebColor & """>"
  1170.     End If
  1171.     'Form method and action
  1172.     Print #fileNum%, "<form method=""" & frmMethodstr &  """ action=""" & frmaction$ & """>"
  1173.     
  1174.     
  1175.     objPos = 0
  1176.     headerPos = 0
  1177.     
  1178.     '*****Print the header if there is one - it must be at the top
  1179.     Print #fileNum%, "<hr><h1 align=""" & "center" & """>"
  1180.     For c = 0 To TotalObjs - 1
  1181.         Select Case objsorted(c).type
  1182.         Case $aprtextbox
  1183.             If objsorted(c).font.size >= 14 And objsorted(c).width > 5000 And objsorted(c).top < 900 Then
  1184.                 
  1185.                 'Get the text color of the header:
  1186.                 headerColor = objsorted(c).font.color.getrgb()
  1187.                 'Convert to hex
  1188.                 tempColor = Hex$(headerColor)
  1189.                 WebColor = Right (tempColor, Len(tempColor) - 1)
  1190.                 'Convert the String
  1191.                 newstring = htmlString(objsorted(c).text)
  1192.                 
  1193.                 
  1194.                 
  1195.                 If objsorted(c).font.italic = True Then
  1196.                     lStr = "<I>"
  1197.                     rStr="</I>"
  1198.                 End If
  1199.                 
  1200.                 If objsorted(c).font.bold = True Then
  1201.                     lStr = lstr + "<B>"
  1202.                     rStr = rStr + "</B>"
  1203.                 End If
  1204.                 Print #fileNum%, lStr + "<Font Size=" & htmlfntsz(objsorted(c).font.size) & "><Font Color=""" & WebColor & """>" & newstring &  "</Font>" + rStr
  1205.                 'If a header is found, flag it so that it is not reprinted in the body:
  1206.                 headerIndex = c
  1207.                 flag = 1
  1208.                 headerPos = Round(objsorted(c).top/objsorted(c).height, 0)
  1209.                 Exit For
  1210.             End If
  1211.         End Select
  1212.     Next
  1213.     
  1214.     '************Print the logo if there is one - it must have the same line number as the header block
  1215.     
  1216.     For c = 0 To TotalObjs - 1
  1217.         Select Case objsorted(c).type
  1218.         Case $aprpicture
  1219.             objPos = Round ((objsorted(c).top/objsorted(c).height), 0)
  1220.             If objPos = headerPos Then
  1221.                 Print #fileNum%, "<img src=""" imagePath$ & objsorted(c).name & ".gif"  & """ ALT=""" & "[LOGO]" & """>"
  1222.                 'If a logo is found, flag it so that it isn't reprinted in the body:
  1223.                 logoIndex = c
  1224.                 flag = 1
  1225.                 Exit For
  1226.             End If
  1227.         End Select
  1228.     Next
  1229.     
  1230.     'If we found neither a logo or title block, then use the approach view name as the title
  1231.     '************need to modify this with the actual view argument
  1232.     If flag=0 Then
  1233.         Print #fileNum%, frmObject.name
  1234.     End If
  1235.     
  1236.     'End the header block:
  1237.     Print #fileNum%, "</h1><hr><p>"
  1238.     
  1239.     '***************************************************************************
  1240.     
  1241.     '-----------------Need to add a place holder here for printing anything extra Mike wants to throw in...
  1242.     Print #fileNum%, XtraHtml    '*****This string is needs to be valid HTML****
  1243.     
  1244.     
  1245.     
  1246.     Print #fileNum%, "<table cellpadding=8>"
  1247.     Print #fileNum%, "<tr>"
  1248.     For c = 0 To Totalobjs - 1
  1249.         typeParent = objsorted(c).parent.type 
  1250.         If typeParent  = $aprbodypanel Then
  1251.             'Go to the next object - we're not translating repeating panels    
  1252.             
  1253.             Select Case objSorted(c).type 
  1254.             Case $aprfieldbox
  1255.                 Printfldbx filenum%, ObjSorted(c)
  1256.             '***********radio buttons are special cases
  1257.             Case $aprradiobutton 
  1258.                 
  1259.                 
  1260.                 'Check if we ran into this radio button before
  1261.                 radioPrinted = chkRadioPrinted( ObjSorted(c).datafield)
  1262.                 
  1263.                 If radioPrinted <> 1 Then 'check if we already ran into this radio button before
  1264.                     'Check the line number
  1265.                     chkLineNumber fileNum%, objsorted(c)
  1266.                     Print #fileNum%, "<td>" 'Start the table cell
  1267.                     For rcounter = 0 To NumRadioButtons - 1 'If not, then we need to go through and print a radio button for each in the group
  1268.                         If objSorted(c).datafield = aryRadioBtn(rcounter).datafield Then
  1269.                             Printradiobtn filenum%, aryRadioBtn(rcounter)
  1270.                             'aryCounter = aryCounter + 1
  1271.                         End If
  1272.                     Next
  1273.                 End If
  1274.                 lastradio(radioCounter) = objSorted(c).datafield
  1275.                 radioCounter = radioCounter + 1
  1276.                 lastradiobtn = objSorted(c).datafield
  1277.                 aryCounter = 0 'reset my counters
  1278.                 radioPrinted = 0
  1279.                 
  1280.             '**********End of radiobuttons***********************************************
  1281.                 
  1282.             Case $aprcheckbox     
  1283.                 PrintCbx filenum%, objSorted(c)
  1284.                 
  1285.             'Listboxes and dropdownboxes will be treated as fieldboxes for now
  1286.             'Limitations:
  1287.             'Can't get the value list for these objects    
  1288.             'Can't retreive the datafield for these objects in this version.
  1289.             Case $aprlistbox
  1290.                 Printlbx filenum%, objsorted(c)
  1291.             Case $aprdropdownbox
  1292.                 PrintDropbx filenum%, objsorted(c)
  1293.                 
  1294.             'I'm only putting a place holder for pictures
  1295.             'The user will have to convert their pictures to *.gif (or other filetype viewable by web browsers)
  1296.             ' and place it in the appropriate image directory.
  1297.                 
  1298.             Case $aprpicture, $aprpictureplus
  1299.                 If c <>logoIndex Then
  1300.                     'Have to check if this picture was a logo in the header - if so don't print again
  1301.                     PrintPic filenum%, objSorted(c), imagePath$
  1302.                 End If        
  1303.             Case $aprtextbox
  1304.                 'Have to check if this textblock was the header - if so don't print again
  1305.                 If c <> headerindex Then
  1306.                     Printtextbox filenum%, objsorted    (c)    
  1307.                 End If
  1308.                 
  1309.             End Select
  1310.         End If
  1311.     Next
  1312.     Print #fileNum%, "<tr>"
  1313.     Print #fileNum%, "</table>"
  1314.     
  1315.     'Print Action Buttions
  1316.     PrintActionBtns filenum%
  1317.     
  1318.     Print #fileNum%, "</Form>"
  1319.     Print #fileNum%, "</Body>"    
  1320.     Print #fileNum%, "<Footer>"
  1321.     PrintCredits filenum%
  1322.     Print #fileNum%, "</Footer>"
  1323.     Print #fileNum%,"</HTML>"
  1324.     
  1325.     'Empty the arrays...
  1326.     Erase objSorted() 'Start over again for the report
  1327.     Erase aryRadioBtn()
  1328.     Erase lastradio()
  1329.     
  1330. End Sub
  1331. '++LotusScript Development Environment:2:2:PrintFormTitle:1:8
  1332. Sub PrintFormTitle(numFile As Integer, vartextbox As Variant)
  1333.     Print #numfile, vartextbox.text
  1334. End Sub
  1335. '++LotusScript Development Environment:2:2:PrintFldBx:1:8
  1336. Sub PrintFldBx(numFile As Integer, varfldbx As Variant)
  1337.     
  1338.     '******************************************************
  1339.     'A different strategy by line number
  1340.     
  1341.     linenumber = Round(varfldbx.top /560, 0)
  1342.     
  1343.     If lineNumber <> lastLineNo Then
  1344.         Print #numfile, "<tr></table><table cellpadding=8>"
  1345.         CurXCoor=0
  1346.     End If
  1347.     lastLineNo = lineNumber
  1348.     '*******************************************************
  1349.     objx = Round(varfldbx.left/1200,0)
  1350.     While objX < CurXCoor - 10  Or  objX > CurXCoor + 10
  1351.         'Put a spacer
  1352.         Print #numfile, "<td colspan=20><!-- Spacer --> </td>"
  1353.         objX= objX + 1
  1354.     Wend
  1355.     CurXCoor=objx
  1356.     '******************************************************
  1357.     'Get fontsize for the label:
  1358.     fntSize = HtmlFntSz(varfldbx.labelfont.size)
  1359.     
  1360.     'Let's check for labelposition
  1361.     labelleft$ = strlblByPosition(varfldbx, 0)
  1362.     labelright$ = strlblByPosition(varfldbx, 1)
  1363.     
  1364.     
  1365.     If varfldbx.height <= 630 Then 'We'll assume this is not a memofield - 625 is the default height of fieldboxes in Approach
  1366.         Print #numfile, "<td>"    
  1367.         Print #numFile, "<Font Size=" & fntSize &">" & labelleft$ "<Input type=""" & "text""" & "  name=""" & varfldbx.datatable & "_" & varfldbx.datafield & """size =" & Str(Round(varfldbx.width/94,0))  & ">" & labelright$
  1368.     Else
  1369.         Print #numfile, "<td rowspan=" & Str(Round((varfldbx.height/1000), 0)) &">"
  1370.         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$
  1371.         
  1372.     End If
  1373. End Sub
  1374. '++LotusScript Development Environment:2:2:PrintRadioBtn:1:8
  1375. Sub PrintRadioBtn(NumFile As Integer, varrdobtn As Variant)
  1376.     
  1377.     
  1378.     'Get fontsize for the label:
  1379.     fntSize = HtmlFntSz(varrdobtn.labelfont.size)
  1380.     
  1381.     'Get labelposition
  1382.     labelLeft$= strLblByPosition(varrdobtn, 0)
  1383.     labelRight$= strLblByPosition(varrdobtn, 1)    
  1384.     
  1385.     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>"
  1386.     
  1387.     
  1388. End Sub
  1389. '++LotusScript Development Environment:2:2:PrintCbx:1:8
  1390. Sub PrintCbx(numFile As Integer, varCbx As Variant)
  1391.     
  1392.     'A different strategy by line number
  1393.     
  1394.     'linenumber = Round(varcbx.top /varcbx.height, 0)
  1395.     'linenumber = Round(varcbx.top /625, 0)
  1396.     linenumber = Round(varcbx.top /560, 0)
  1397.     If lineNumber <> lastLineNo Then
  1398.         Print #numfile, "<tr></table><table cellpadding=8>"
  1399.     End If
  1400.     lastLineNo = lineNumber
  1401.     '*******************************************************
  1402.     
  1403.     'Get fontsize for the label:
  1404.     fntSize = HtmlFntSz(varcbx.labelfont.size)
  1405.     'Determine position of label
  1406.     labelLeft$ = strlblByPosition(varcbx,0)
  1407.     labelRight$= strlblByPosition(varcbx, 1)
  1408.     
  1409.     'Print #numFile, "" & varfldbx.labeltext 
  1410.     Print #numfile, "<td>"
  1411.     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$
  1412.     Print #numfile, "</td>"
  1413. End Sub
  1414. '++LotusScript Development Environment:2:1:GetObj:1:8
  1415. Function GetObj(objary As Variant)
  1416.     
  1417.     Redim objSorted(0 To objary.count - 1)  'Redimension the array appropriately
  1418.     
  1419.     i = 0
  1420.     arycounter = 0
  1421.     
  1422.     Forall objects In objary
  1423.         Select Case objary(i).type
  1424.         Case $aprfieldbox, $aprtextbox
  1425.             Set Objsorted(arycounter) = objary(i)  'Get the types of objects specified above
  1426.             arycounter = arycounter + 1
  1427.         Case  $aprcheckbox, $aprradiobutton, $aprpicture, $aprlistbox, $aprdropdownbox, $aprpictureplus
  1428.             Set Objsorted(arycounter) = objary(i)  'Get the types of objects specified above
  1429.             arycounter = arycounter + 1
  1430.         End Select
  1431.         
  1432.         i = i + 1 'Go to the next object in the list
  1433.     End Forall
  1434.     
  1435.     TotalObjs = arycounter 'Keep track of the number of objects we collected
  1436.     
  1437. End Function
  1438. '++LotusScript Development Environment:2:2:SortItByY:1:8
  1439. Sub SortItByY
  1440.     i = 0
  1441.     j = 0
  1442.     For i = 0 To TotalObjs -1
  1443.         Set temp = objSorted(i)
  1444.         
  1445.         
  1446.         For j = i + 1 To TotalObjs -1
  1447.             If objSorted(j).top < objSorted(i).top Then
  1448.                 Set objSorted(i) = objSorted(j)
  1449.                 
  1450.                 
  1451.                 Set objSorted(j) = temp
  1452.                 
  1453.                 Set temp = objSorted(i)
  1454.                 
  1455.                 
  1456.             End If
  1457.         Next
  1458.     Next
  1459.     
  1460.     
  1461. End Sub
  1462. '++LotusScript Development Environment:2:2:GroupRdoBtn:1:8
  1463. Sub GroupRdoBtn
  1464.     j = 0
  1465.     Redim aryRadioBtn(0 To Ubound(objsorted))
  1466.     For i = 0 To TotalObjs - 1
  1467.         If objsorted(i).type = $aprradiobutton Then
  1468.             
  1469.             Set aryRadioBtn(j) = objsorted(i)
  1470.             j = j + 1
  1471.         End If
  1472.     Next
  1473.     
  1474.     NumRadioButtons = j
  1475. End Sub
  1476. '++LotusScript Development Environment:2:2:PrintHtmlGood:1:8
  1477. Sub PrintHtmlGood
  1478.     ' Get an unused file number so LotusScript can open a file.
  1479.     fileNum% = Freefile()
  1480.     aryCounter = 0
  1481.     flag = 0
  1482.     
  1483.     
  1484.     Redim lastradio(numRadioButtons)
  1485.     radioCounter = 0
  1486.     
  1487.     Open "c:\win95\desktop\test5.htm" For Output As fileNum%
  1488.     
  1489.     Print #fileNum%,"<HTML>"
  1490.     Print #fileNum%, "<Body>"
  1491.     
  1492.     '------------------Need to replace the form method and action later...
  1493.     Print #fileNum%, "<form method=post action=""" & "mailto:grace_francisco@crd.lotus.com""" & ">"
  1494.     
  1495.     '-----------------Need to add a place holder here for printing anything extra Mike wants to throw in...
  1496.     
  1497.     
  1498.     '----------------Search Type-----------------------------------------------------
  1499.     PrintSearch filenum%, 0 ' 0 here needs to be changed to an argument variable
  1500.     
  1501.     objPos = 0
  1502.     headerPos = 0
  1503.     
  1504.     '*****Print the header if there is one - it must be at the top
  1505.     Print #fileNum%, "<hr><h1 align=""" & "center" & """>"
  1506.     For c = 0 To TotalObjs - 1
  1507.         Select Case objsorted(c).type
  1508.         Case $aprtextbox
  1509.             If objsorted(c).font.size >=12 Then
  1510.                 newstring = htmlString(objsorted(c).text)
  1511.                 Print #fileNum%, "<Font Size=" & htmlfntsz(objsorted(c).font.size) & ">" & newstring
  1512.                 'If a header is found, flag it so that it is not reprinted in the body:
  1513.                 headerIndex = c
  1514.                 flag = 1
  1515.                 headerPos = Round(objsorted(c).top/objsorted(c).height, 0)
  1516.                 Exit For
  1517.             End If
  1518.         End Select
  1519.     Next
  1520.     
  1521.     '************Print the logo if there is one - it must have the same line number as the header block
  1522.     
  1523.     For c = 0 To TotalObjs - 1
  1524.         Select Case objsorted(c).type
  1525.         Case $aprpicture
  1526.             objPos = Round ((objsorted(c).top/objsorted(c).height), 0)
  1527.             If objPos = headerPos Then
  1528.                 Print #fileNum%, "<img src=""" & objsorted(c).name & ".gif"  & """ ALT=""" & "[LOGO]" & """>"
  1529.                 'If a logo is found, flag it so that it isn't reprinted in the body:
  1530.                 logoIndex = c
  1531.                 flag = 1
  1532.                 Exit For
  1533.             End If
  1534.         End Select
  1535.     Next
  1536.     
  1537.     'If we found neither a logo or title block, then use the approach view name as the title
  1538.     '************need to modify this with the actual view argument
  1539.     If flag=0 Then
  1540.         Print #fileNum%, currentview.name
  1541.     End If
  1542.     
  1543.     'End the header block:
  1544.     Print #fileNum%, "</h1><hr><p>"
  1545.     
  1546.     '***************************************************************************
  1547.     
  1548.     Print #fileNum%, "<table cellpadding=8>"
  1549.     Print #fileNum%, "<tr>"
  1550.     For c = 0 To Totalobjs - 1
  1551.         Print c
  1552.         If objsorted(c).parent.type <> $aprrepeatingpanel Then
  1553.             'Go to the next object - we're not translating repeating panels    
  1554.             
  1555.             Select Case objSorted(c).type 
  1556.             Case $aprfieldbox
  1557.                 Printfldbx filenum%, ObjSorted(c)
  1558.             '***********radio buttons are special cases
  1559.             Case $aprradiobutton 
  1560.                 
  1561.                 
  1562.                 'Check if we ran into this radio button before
  1563.                 radioPrinted = chkRadioPrinted( ObjSorted(c).datafield)
  1564.                 
  1565.                 If radioPrinted <> 1 Then 'check if we already ran into this radio button before
  1566.                     'Check the line number
  1567.                     chkLineNumber fileNum%, objsorted(c)
  1568.                     Print #fileNum%, "<td>" 'Start the table cell
  1569.                     For rcounter = 0 To NumRadioButtons - 1 'If not, then we need to go through and print a radio button for each in the group
  1570.                         If objSorted(c).datafield = aryRadioBtn(rcounter).datafield Then
  1571.                             Printradiobtn filenum%, aryRadioBtn(rcounter)
  1572.                             'aryCounter = aryCounter + 1
  1573.                         End If
  1574.                     Next
  1575.                 End If
  1576.                 lastradio(radioCounter) = objSorted(c).datafield
  1577.                 radioCounter = radioCounter + 1
  1578.                 lastradiobtn = objSorted(c).datafield
  1579.                 aryCounter = 0 'reset my counters
  1580.                 radioPrinted = 0
  1581.                 
  1582.             '**********End of radiobuttons***********************************************
  1583.                 
  1584.             Case $aprcheckbox     
  1585.                 PrintCbx filenum%, objSorted(c)
  1586.                 
  1587.             'Listboxes and dropdownboxes will be treated as fieldboxes for now
  1588.             'Limitations:
  1589.             'Can't get the value list for these objects    
  1590.             'Can't retreive the datafield for these objects in this version.
  1591.             Case $aprlistbox
  1592.                 Printlbx filenum%, objsorted(c)
  1593.             Case $aprdropdownbox
  1594.                 PrintDropbx filenum%, objsorted(c)
  1595.                 
  1596.             'I'm only putting a place holder for pictures
  1597.             'The user will have to convert their pictures to *.gif (or other filetype viewable by web browsers)
  1598.             ' and place it in the appropriate image directory.
  1599.                 
  1600.             Case $aprpicture, $aprpictureplus
  1601.                 If c <>logoIndex Then
  1602.                     'Have to check if this picture was a logo in the header - if so don't print again
  1603.                     PrintPic filenum%, objSorted(c), ""
  1604.                 End If        
  1605.             Case $aprtextbox
  1606.                 'Have to check if this textblock was the header - if so don't print again
  1607.                 If c <> headerindex Then
  1608.                     Printtextbox filenum%, objsorted    (c)    
  1609.                 End If
  1610.                 
  1611.             End Select
  1612.         End If
  1613.     Next
  1614.     Print #fileNum%, "<tr>"
  1615.     Print #fileNum%, "</table>"
  1616.     
  1617.     'Print Action Buttions
  1618.     PrintActionBtns filenum%
  1619.     
  1620.     Print #fileNum%, "</Form>"
  1621.     Print #fileNum%, "</Body>"    
  1622.     Print #fileNum%,"</HTML>"
  1623.     
  1624.     Close fileNum%
  1625.     
  1626. End Sub
  1627. '++LotusScript Development Environment:2:1:PrintLbx:1:8
  1628. Function PrintLbx(numFile As Integer, varlbx As Variant)
  1629.     
  1630.         '******************************************************
  1631.     'A different strategy by line number
  1632.     
  1633.     linenumber = Round(varlbx.top /560, 0)
  1634.     
  1635.     
  1636.     If lineNumber <> lastLineNo Then
  1637.         Print #numfile, "<tr></table><table cellpadding=8>"
  1638.     End If
  1639.     lastLineNo = lineNumber
  1640.     '*******************************************************
  1641.     
  1642.     'Get a similar datafield for this type of object since there is no datafield property for this object:
  1643.     msgValue = ""
  1644.     
  1645.     'strLabel = NoSpaceStr(varlbx.labeltext)
  1646. '    Forall elements In aryFieldnames
  1647. '        If Lcase$(Left$(strLabel, 5)) Like Lcase$(Left$(elements, 5)) Then
  1648. '            datafield = elements
  1649. '        End If
  1650. '    End Forall
  1651.     
  1652. '    If datafield = "" Then
  1653. '        datafield = strLabel
  1654. '        msgValue = "Could not find the datafield for this field - do not use for query"
  1655. '    End If
  1656.     
  1657.     'Get fontsize for the label:
  1658.     fntSize = HtmlFntSz(varlbx.labelfont.size)
  1659.     
  1660.     'Determine label position
  1661.     labelLeft$ = strLblByPosition(varlbx, 0)
  1662.     labelRight$ = strLblByPosition(varlbx, 1)
  1663.     If varlbx.height <= 630 Then 'We'll assume this is not a memofield - 625 is the default height of fieldboxes in Approach
  1664.         Print #numfile, "<td>"    
  1665.         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$
  1666.     Else
  1667.         Print #numfile, "<td rowspan=" & Str(Round((varlbx.height/1000), 0)) &">"
  1668.         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$
  1669.     End If
  1670. End Function
  1671. '++LotusScript Development Environment:2:2:SortItByX:1:8
  1672. Sub SortItByX
  1673.     i = 0
  1674.     j = 0
  1675.     For i = 0 To TotalObjs - 1
  1676.         Set temp = objSorted(i)
  1677.         
  1678.         
  1679.         For j = i + 1 To TotalObjs - 1
  1680.             
  1681.             '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
  1682.             If objSorted(j).left < objSorted(i).left And Round((objSorted(j).top/560), 0) = Round((objSorted(i).top/560), 0) Then
  1683.                 Set objSorted(i) = objSorted(j)
  1684.                 
  1685.                 
  1686.                 Set objSorted(j) = temp
  1687.                 
  1688.                 Set temp = objSorted(i)
  1689.                 
  1690.                 
  1691.             End If
  1692.         Next
  1693.     Next
  1694.     
  1695.     
  1696.     
  1697. End Sub
  1698. '++LotusScript Development Environment:2:2:PrintRptHtml:1:8
  1699. Sub PrintRptHtml(filenum As Integer, rptObject As Variant, WebTemplate As String, imagePath As String)
  1700.     Dim c, aryCounter, headerindex, logoIndex, headerPos, ObjPos, flag  As Integer
  1701.     Dim lStr, rStr As String
  1702.     Dim newstring As String
  1703.     Dim rptcolor, WebColor, colHeight As Long
  1704.     '*******************************************************************************************************
  1705.     'Only objects in the bodypanel, headerpanel, and footerpanel will be printed out
  1706.     'to html.
  1707.     'Only Fieldboxes,  textboxes, and pictures will be printed
  1708.     '*******************************************************************************************************
  1709.     'Store the objects in an array
  1710.     GetObj(rptObject.objectlist)    'The report I picked
  1711.     'To be used to get best-guess datafield for dropdownboxes and listboxes
  1712.     
  1713.     'GetColumns(rptObject.parent.tables(GetTableIndex(rptObject.maintable, rptObject.parent)))  'Needs to be adjusted
  1714.     'Sort the array by its y coordinate first
  1715.     SortItByY
  1716.     'Now let's split the objects line by line and sort by x coordinate
  1717.     SortItByX
  1718.     
  1719.     '------------------------------------------------------------------------------------------------------------------------------------------
  1720.     
  1721.     
  1722.     aryCounter = 0
  1723.     
  1724.     'Mark the beginning of the SQL_REPORT Section:
  1725.     Print #fileNum%, "%SQL_REPORT{"
  1726.     
  1727.     Print #fileNum%,"<HTML>"
  1728.     Print #fileNum%, "<Head><Title>" & rptObject.name & "</Title></Head>"
  1729.     If WebTemplate <> "" Then 'Must mean that user selected a background
  1730.         Print #fileNum%, "<Body Background=""" & imagepath & WebTemplate & """>"
  1731.     Else
  1732.         'Get the background color for the form:
  1733.         rptColor = rptObject.body.background.color.getrgb()
  1734.         'Convert to hex
  1735.         tempColor = Hex$(rptColor)
  1736.         WebColor = Right (tempColor, Len(tempColor) - 1)
  1737.         If WebColor = "0C0C0" Then 'This is an incorrect value for the default background color
  1738.             WebColor = "C0C0C0"
  1739.         End If
  1740.         Print #fileNum%, "<Body BGColor=""" & WebColor & """>"
  1741.     End If
  1742.     '*****Print the header if there is one - it must be at the top
  1743.     Print #fileNum%, "<hr><h1 align=""" & "left" & """>"
  1744.     For c = 0 To TotalObjs - 1
  1745.         Select Case objsorted(c).type
  1746.         Case $aprtextbox
  1747.             If objsorted(c).font.size >=12 And objsorted(c).namedstyle = ":116 Default Report Title" Then
  1748.                 newstring = htmlString(objsorted(c).text)
  1749.                 
  1750.                     'Get the text color of the header:
  1751.                 headerColor = objsorted(c).font.color.getrgb()
  1752.                 'Convert to hex
  1753.                 tempColor = Hex$(headerColor)
  1754.                 WebColor = Right (tempColor, Len(tempColor) - 1)
  1755.                 'Convert the String
  1756.                 newstring = htmlString(objsorted(c).text)
  1757.                 
  1758.                 
  1759.                 
  1760.                 If objsorted(c).font.italic = True Then
  1761.                     lStr = "<I>"
  1762.                     rStr="</I>"
  1763.                 End If
  1764.                 
  1765.                 If objsorted(c).font.bold = True Then
  1766.                     lStr = lstr + "<B>"
  1767.                     rStr = rStr + "</B>"
  1768.                 End If
  1769.                 Print #fileNum%, lStr + "<Font Size=" & htmlfntsz(objsorted(c).font.size) & "><Font Color=""" & WebColor & """>" & newstring &  "</Font>" + rStr
  1770.                 
  1771.                   'If a header is found, flag it so that it is not reprinted in the body:
  1772.                 headerIndex = c
  1773.                 flag = 1
  1774.                 headerPos = Round(objsorted(c).top/560, 0)
  1775.                 Exit For
  1776.             End If
  1777.         End Select
  1778.     Next
  1779.     
  1780.      '***************************************************************************
  1781.     
  1782.      '************Print the logo if there is one - it must have the same line number as the header block
  1783.     
  1784.     For c = 0 To TotalObjs - 1
  1785.         Select Case objsorted(c).type
  1786.         Case $aprpicture
  1787.             objPos = Round ((objsorted(c).top/560), 0)
  1788.             If objPos = headerPos And objsorted(c).parent.namedstyle = ":107 Default Columns"  Then
  1789.                 Print #fileNum%, "<img src=""" & objsorted(c).name & ".gif"  & """ ALT=""" & "[LOGO]" & """>"
  1790.                    'If a logo is found, flag it so that it isn t reprinted in the body:
  1791.                 logoIndex = c
  1792.                 flag = 1
  1793.                 Exit For
  1794.             End If
  1795.         End Select
  1796.     Next
  1797.     
  1798.     'If we found neither a logo or title block, then use the approach view name as the title
  1799.     '************need to modify this with the actual view argument
  1800.     If flag=0 Then
  1801.         Print #fileNum%, rptObject.name
  1802.     End If
  1803.     
  1804.     'End the header block:
  1805.     Print #fileNum%, "</h1><hr><p>"
  1806.     
  1807.     'Determine what we'll consider a column header for this report
  1808.     For c = 0 To TotalObjs -1
  1809.         Select Case objsorted(c).type
  1810.         Case $aprtextbox
  1811.             If objsorted(c).namedstyle = ":107 Default Columns"  Then
  1812.               'Get the height of the first column header to distinguish it from other objects in the header:
  1813.                 colHeight = objsorted(c).height
  1814.                 Exit For
  1815.             End If        
  1816.         End Select
  1817.         
  1818.     Next
  1819.     
  1820.     '***************************************************************************
  1821.     'Let's print any miscellaneous objects in the header here:
  1822.     
  1823.     Print #fileNum%, "<table cellpadding=8>"
  1824.     Print #fileNum%, "<tr>"
  1825.     For c = 0 To TotalObjs -1
  1826.         If objsorted(c).namedstyle = ":107 Default Columns"  And objsorted(c).height <> colHeight Then
  1827.             Select Case objSorted(c).type
  1828.             Case $aprpicture, $aprpictureplus
  1829.                 If c <>logoIndex Then
  1830.                        'Have to check if this picture was a logo in the header - if so don t print again
  1831.                     PrintPic filenum%, objSorted(c), imagePath
  1832.                 End If        
  1833.             Case $aprtextbox
  1834.                    'Have to check if this textblock was the header - if so don't print again
  1835.                 If c <> headerindex Then
  1836.                     Printtextbox filenum%, objsorted    (c)    
  1837.                 End If
  1838.             End Select
  1839.         End If
  1840.     Next
  1841.     Print #fileNum%, "<tr>"
  1842.     
  1843.     
  1844.     '********************Print the column headings: **************************************************
  1845.     
  1846.     Print #fileNum%, "<table cellpadding=8>"
  1847.     Print #fileNum%, "<tr>"
  1848.     For c = 0 To TotalObjs -1
  1849.         Select Case objsorted(c).type
  1850.         Case $aprtextbox            
  1851.             If objsorted(c).namedstyle = ":107 Default Columns" And objsorted(c).height = colHeight Then
  1852.                 Print #fileNum%, "<TH>" &  objsorted(c).text    
  1853.             End If
  1854.         End Select
  1855.     Next
  1856.     Print #fileNum%, "<tr>"
  1857.     '*******************************************************************************************************
  1858.     
  1859.     '*****************Print the body of the report:******************************************************************
  1860.     'Mark the beginning of repeating object row:
  1861.     Print #fileNum%, "%ROW{"
  1862.     
  1863.     For c = 0 To TotalObjs - 1
  1864.         If ObjSorted(c).parent.type = $aprbodypanel  Then
  1865.             Select Case objSorted(c).type
  1866.             Case $aprfieldbox    
  1867.                 Printfldbx2 filenum%, ObjSorted(c)
  1868.             Case $aprpicture, $aprpictureplus
  1869.                 If c <>logoIndex Then
  1870.                     'Have to check if this picture was a logo in the header - if so don't print again
  1871.                     PrintPic filenum%, objSorted(c), imagePath$
  1872.                 End If        
  1873.             Case $aprtextbox
  1874.                 'Have to check if this textblock was the header - if so don't print again
  1875.                 If c <> headerindex Then
  1876.                     Printtextbox filenum%, objsorted    (c)    
  1877.                 End If
  1878.             End Select
  1879.         End If
  1880.     Next
  1881.     Print #fileNum%, "<tr>"
  1882.     Print #fileNum%, "%}"    
  1883.     Print #fileNum%, "</table><br>"
  1884.     Print #fileNum%, "</Body>"    
  1885.     
  1886.     '************************************Footer Section*****************************************************
  1887.     Print #fileNum%, "<Footer><hr><small>"    
  1888.     Print #fileNum%, "<table><td><small>"
  1889.     Print #fileNum%, "<Script Language=""" & "JavaScript" & """>"
  1890.     Print #fileNum%, "document.write(Date())"
  1891.     Print #fileNum%, "</Script>"
  1892.     Print #fileNum%, "</table>"
  1893.     
  1894.     
  1895.     Print #fileNum%, "<table cellpadding=8>"
  1896.     Print #fileNum%, "<tr>"
  1897.     For c = 0 To TotalObjs -1
  1898.         If objsorted(c).parent.namedstyle = ":117 Default Footer left"  Or objsorted(c).parent.namedstyle = ":118 Default Footer right" Then
  1899.             Select Case objSorted(c).type
  1900.             Case $aprpicture, $aprpictureplus
  1901.                 If c <>logoIndex Then
  1902.                     'Have to check if this picture was a logo in the header - if so don't print again
  1903.                     PrintPic filenum%, objSorted(c), imagePath
  1904.                 End If        
  1905.             Case $aprtextbox
  1906.                 'Have to check if this textblock was the header - if so don't print again
  1907.                 If c <> headerindex Then
  1908.                     Printtextbox filenum%, objsorted    (c)    
  1909.                 End If
  1910.             End Select
  1911.         End If
  1912.     Next
  1913.     Print #fileNum%, "</table>"
  1914.     PrintCredits filenum%
  1915.     Print #fileNum%, "</Footer><hr>"        
  1916.     '***********************************************************************************************************
  1917.     
  1918.     Print #fileNum%,"</HTML>"
  1919.     
  1920.     'Mark the end of the SQL_REPORT Section
  1921.     Print #fileNum%, "%}"
  1922.     
  1923.         'Empty the arrays...
  1924.     Erase objSorted() 'Start over again.
  1925.     Erase aryRadioBtn()
  1926.     Erase lastradio()
  1927.     
  1928. End Sub
  1929. '++LotusScript Development Environment:2:2:PrintFldBx2:1:8
  1930. Sub PrintFldBx2(numFile As Integer, varfldbx As Variant)
  1931.     
  1932.     '******************************************************
  1933.     'A different strategy by line number
  1934.     
  1935.     linenumber = Round(varfldbx.top /560, 0)
  1936.     
  1937.     If lineNumber <> lastLineNo Then
  1938.         'Print #numfile, "<tr></table><table cellpadding=8>"
  1939.         Print #numfile, "<tr>"
  1940.         CurXCoor=0
  1941.     End If
  1942.     lastLineNo = lineNumber
  1943.     '*******************************************************
  1944.     'Get fontsize for the label:
  1945.     fntSizeLabel = HtmlFntSz(varfldbx.labelfont.size)
  1946.     'Get fontsize for the text
  1947.     fntSizeData = HtmlFntSz(varfldbx.font.size)
  1948.     
  1949.     'Let's check for labelposition
  1950.     labelleft$ = strlblByPosition2(varfldbx, 0)
  1951.     labelright$ = strlblByPosition2(varfldbx, 1)
  1952.     
  1953.     
  1954.     Print #numfile,"<td>"    
  1955.     Print #numFile,  "<Font=" & fntSizeLabel & ">" & labelLeft$ & "<Font Size=" &  fntSizeData & ">" & "$(V_" & varfldbx.datafield & ")" & "<Font Size=" & labelRight$ & ">"
  1956.     
  1957. End Sub
  1958. '++LotusScript Development Environment:2:1:PrintPic:1:8
  1959. Function PrintPic(numFile As Integer, varpic As Variant, iPath As String)
  1960.     linenumber = Round(varpic.top /560, 0)
  1961.     
  1962.     If lineNumber <> lastLineNo Then
  1963.         Print #numfile, "<tr></table><table cellpadding=8>"
  1964.     End If
  1965.     lastLineNo = lineNumber
  1966.     '*******************************************************
  1967.     
  1968.     
  1969.     Print #numfile, "<td rowspan=" & Str(Round((varpic.height/1000), 0)) &">"
  1970.     Print #numFile, "<image src =""" & iPath$ & varpic.name & ".gif" & """ Alt=""" & varpic.name &".gif"  & """>"
  1971.     
  1972.     
  1973. End Function
  1974. '++LotusScript Development Environment:2:1:PrintTextBox:1:8
  1975. Function PrintTextBox(numFile As Integer, vartextbox As Variant)
  1976.     
  1977.     linenumber = Round(vartextbox.top/560, 0)
  1978.     
  1979.     If lineNumber <> lastLineNo Then
  1980.         Print #numfile, "</tr><tr>"
  1981.     End If
  1982.     lastLineNo = lineNumber
  1983.     '*******************************************************
  1984.     
  1985.     'Get fontsize for the label:
  1986.     fntSize = HtmlFntSz(vartextbox.font.size)
  1987.     
  1988.     newstring = htmlString(vartextbox.text) 
  1989.     
  1990.     'Get the font color
  1991.     fntColor = vartextbox.font.color.getrgb()
  1992.     'Convert to hex
  1993.     tempColor = Hex$(fntColor)
  1994.     WebColor = Right (tempColor, Len(tempColor) - 1)
  1995.     
  1996.     'Check for text formatting:
  1997.     If Abs(vartextbox.font.bold) = 1 And  Abs(vartextbox.font.italic) = 1 Then
  1998.         LeftStr$="<B><I>"
  1999.         RightStr$= "</I></B>"
  2000.     Elseif Abs(vartextbox.font.bold) = 1 Then
  2001.         LeftStr$="<B>"
  2002.         RightStr$= "</B>"
  2003.     Elseif Abs(vartextbox.font.italic) = 1 Then
  2004.         LeftStr$="<I>"
  2005.         RightStr$= "</I>"
  2006.     Else
  2007.         LeftStr$=""
  2008.         RightStr$= ""
  2009.     End If
  2010.     
  2011.     Print #numfile, "<td rowspan=" & Str(Round((vartextbox.height/1000), 0)) &">"
  2012.     Print #numFile, LeftStr$ & "<Font Size=" & fntSize &"><font color=""" & WebColor & """>"  & newstring & "</font>" & RightStr$
  2013.         'Need to put a place holder in the rows that this takes up!!!
  2014.         'How????????????
  2015.     
  2016. End Function
  2017. '++LotusScript Development Environment:2:1:htmlString3:1:8
  2018. Function htmlString3(vartext As String) As String
  2019.     newstring = ""
  2020.     If Left$(vartext,1) = "<" Then 'Calculated fields cause problems because their text properties have "<"
  2021.         htmlString3= "<!--[Approach calculated field] -->"
  2022.         Exit Function
  2023.     End If
  2024.     
  2025.     For c =1 To Len(vartext)
  2026.         If Mid$(vartext, c, 1) = Chr(10) Then
  2027.             newstring = newstring + "<br>"
  2028.         Else
  2029.             newstring = newstring + Mid$(vartext, c, 1)
  2030.         End If
  2031.     Next
  2032.     
  2033.     htmlString3 = newstring
  2034. End Function
  2035. '++LotusScript Development Environment:2:1:GetMethod:1:8
  2036. Function GetMethod(frmMethod As Integer) As String
  2037.      'GetMethod will return a valid string to PrintFrmHtml fuction
  2038.     If frmMethod = 0 Then
  2039.         GetMethod ="Post" 
  2040.     Elseif frmMethod = 1 Then
  2041.         GetMethod="Get"
  2042.     Else 'the number wasn't valid
  2043.         GetMethod="Bad Value"
  2044.     End If
  2045. End Function
  2046. '++LotusScript Development Environment:2:1:GetColumns:1:8
  2047. Function GetColumns(myTable As Variant)
  2048.     'Need to get all of the fieldnames from the table for the view to use later
  2049.     'to get a datafield assoicated with dropdownlist and fieldbox objects
  2050.     Redim aryFieldnames(0 To (mytable.numfields-1))
  2051.     c= 0
  2052.     Forall elements In myTable.Fieldnames
  2053.         aryFieldnames(c) =elements
  2054.         c= c + 1
  2055.     End Forall
  2056.     
  2057. End Function
  2058. '++LotusScript Development Environment:2:2:FindTest:1:8
  2059. Sub FindTest
  2060.     Dim myres(0 To 30) As String
  2061.     Set myfind = New finddistinct
  2062.     'Set mycount = myfind.getcount
  2063.     'Redim myres(0 To mycount)
  2064.     CurrentFind = myfind.getat(2, "item")
  2065.     For c = 0 To mycount
  2066.         myres(c) = myfind.getat(c, "item")
  2067.     Next
  2068. End Sub
  2069. '++LotusScript Development Environment:2:1:PrintDropbx:1:8
  2070. Function PrintDropbx(numFile As Integer, varDropbx As Variant)
  2071.     
  2072.         '******************************************************
  2073.     'A different strategy by line number
  2074.     
  2075.     linenumber = Round(varDropbx.top /560, 0)
  2076.     
  2077.     If lineNumber <> lastLineNo Then
  2078.         Print #numfile,  "</table><table cellpadding=8><tr>"
  2079.     End If
  2080.     lastLineNo = lineNumber
  2081.     '*******************************************************
  2082.     
  2083.     
  2084.     msgValue = ""
  2085. '    strLabel = NoSpaceStr(varDropbx.labeltext)
  2086. '    Forall elements In aryFieldnames
  2087. '        If Lcase$(Left$(strLabel, 5)) Like Lcase$(Left$(elements,5)) Then
  2088. '        datafield = elements
  2089.     '    End If
  2090. '    End Forall
  2091.     
  2092.     'If datafield = "" Then
  2093.     '    datafield = strLabel
  2094. '        msgValue = "Could not find the datafield for this field - do not use for query"
  2095.     'End If
  2096.     
  2097.     
  2098.     'Get fontsize for the label:
  2099.     fntSize = HtmlFntSz(varDropbx.labelfont.size)
  2100.     
  2101.     'Determine Position of Label
  2102.     labelLeft$ = strLblByPosition(varDropbx, 0)
  2103.     labelRight$ = strLblByPosition(varDropbx, 1)
  2104.     If varDropbx.height <= 630 Then 'We'll assume this is not a memofield - 625 is the default height of fieldboxes in Approach
  2105.         Print #numfile, "<td>"    
  2106.         Print #numFile, "<Font Size=" & fntSize &">" & labelLeft$ & "<Input type=""" & "text""" & "  name=""" & vardropbx.datatable & "_" & vardropbx.datafield & """Value=""" & msgValue & """size =" & Str(Round(varDropbx.width/94,0))  & ">" & labelRight$
  2107.     Else
  2108.         Print #numfile, "<td rowspan=" & Str(Round((varDropbx.height/1000), 0)) &">"
  2109.         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$
  2110.     End If
  2111. End Function
  2112. '++LotusScript Development Environment:2:1:GetTable:1:8
  2113. Function GetTable(strTablename As String, docindex As Integer) As Variant
  2114.     c= 0
  2115.     Forall tables In CurrentApplication.Documents(docindex).tables
  2116.         If CurrentApplication.Documents(docindex).tables(c).tablename = strTablename Then
  2117.             Set GetTable =  CurrentApplication.Documents(docindex).tables(c)
  2118.             Exit Function
  2119.         Else
  2120.             c = c + 1 ' Go to the next item
  2121.         End If
  2122.     End Forall
  2123.     
  2124. End Function
  2125. '++LotusScript Development Environment:2:2:PrintSearch:1:8
  2126. Sub PrintSearch(filenum As Integer, Searchtype As Integer)
  2127.     
  2128.     If SearchType = 1 Then
  2129.         strAnd = "Checked"
  2130.     Elseif SearchType = 2 Then
  2131.         strOr = "Checked"
  2132.     Else
  2133.         strAnd = ""
  2134.         strOr = ""
  2135.     End If
  2136.     
  2137.     Print #filenum, "<!-- Search Type -->"
  2138.     Print #filenum, "<table><tr>"        
  2139.     Print #filenum, "<td>Search Type:"
  2140.     Print #filenum, "</table>"
  2141.     Print #filenum, "<table><tr>"    
  2142.     Print #filenum, "<td><Input type=""" & "radio" & """ name=""" & "SearchType" & """ value=""" & "1" & """ " & strAnd & " ><small>And"
  2143.     Print #filenum, "<td><Input type=""" & "radio" & """ name=""" & "SearchType" & """ value=""" & "2" & """ " & strOr & " ><small>Or"
  2144.     Print #filenum, "</table>"
  2145.     Print #filenum, "<!-- End Search Type -->"
  2146.     
  2147. End Sub
  2148. '++LotusScript Development Environment:2:1:HtmlFntSz:1:8
  2149. Function HtmlFntSz(fntSize As Integer) As Integer
  2150.     Select Case fntSize
  2151.     Case Is <= 8
  2152.         HtmlFntSz=2
  2153.     Case 10, 11
  2154.         HtmlFntSz=3
  2155.     Case 12, 13
  2156.         HtmlFntSz=4
  2157.     Case 14, 15
  2158.         HtmlFntSz=5
  2159.     Case 16, 17
  2160.         HtmlFntSz=6
  2161.     Case Is  >= 18
  2162.         HtmlFntSz=7
  2163.         
  2164.     End Select
  2165.     
  2166. End Function
  2167. '++LotusScript Development Environment:2:1:chkRadioPrinted:1:8
  2168. Function chkRadioPrinted(objDataField As String) As Integer
  2169.     j = 0
  2170.     Forall elements In  lastradio
  2171.         If lastradio(j) = "" Then
  2172.             Exit Forall
  2173.         End If
  2174.         If objDataField= lastradio (j) Then
  2175.             chkRadioPrinted = 1 'Found it so don't print it again.
  2176.         End If
  2177.         j = j + 1
  2178.     End Forall
  2179.     
  2180. End Function
  2181. '++LotusScript Development Environment:2:2:PrintActionBtns:1:8
  2182. Sub PrintActionBtns(numFile As Integer)
  2183.         '*******************Action buttons for the form
  2184.     Print #numFile%, "<p><p><table cellpadding=8>"
  2185.     Print #numFile%, "<tr>"
  2186.     Print #numFile, "<td> <INPUT TYPE="""& "submit" & """ VALUE=""" & "Submit Query" & """>"
  2187.     Print #numFile%, "<td> <INPUT TYPE="""& "reset" & """ VALUE=""" & "Reset" & """></table><P>"
  2188.     '****************************************************
  2189. End Sub
  2190. '++LotusScript Development Environment:2:1:NoSpaceStr:1:8
  2191. Function NoSpaceStr(StrLabelText As String) As String
  2192. 'This will be used to help best guess what datafield to attach to dropdownboxes and fieldboxes
  2193.     
  2194.     newstring = ""
  2195.     For c=1 To Len(strLabeltext)
  2196.         If Mid$(strLabeltext, c, 1) = " " Then
  2197.             newstring = newstring + ""            'Note: getting rid of the space will help compare the label to a fieldname in the table
  2198.         Else 
  2199.             newstring = newstring + Mid$(strLabeltext, c, 1)
  2200.         End If
  2201.     Next
  2202.     
  2203.     NoSpaceStr = newstring
  2204.     
  2205. End Function
  2206. '++LotusScript Development Environment:2:2:chkLineNumber:1:8
  2207. Sub chkLineNumber(numFile As Integer, objvar As Variant)
  2208.     linenumber = Round(objvar.top /560, 0)
  2209.     If lineNumber <> lastLineNo Then
  2210.         Print #numfile, "<tr></table><table cellpadding=8>"
  2211.     End If
  2212.     lastLineNo = lineNumber
  2213.     '*******************************************************
  2214. End Sub
  2215. '++LotusScript Development Environment:2:1:strLblByPosition:1:8
  2216. Function strLblByPosition(objvar As Variant, txtPos As Integer) As String
  2217.     'This returns a string value with html text determining if the label for the
  2218.     'object is on top, bottom, left, or right.
  2219.     'txtPos here indicates the position of the place holders I have in the Print Subroutines:
  2220.     '$labelLeft &$labelRight
  2221.     '0 indicates it's for left
  2222.     '1 indicates it is for right.
  2223.     
  2224.     
  2225.     'Get the font color
  2226.     fntColor = objvar.labelfont.color.getrgb()
  2227.     'Convert to hex
  2228.     tempColor = Hex$(fntColor)
  2229.     WebColor = Right (tempColor, Len(tempColor) - 1)
  2230.     
  2231.     'Check for text formatting:
  2232.     If Abs(objvar.labelfont.bold) = 1 And  Abs(objvar.labelfont.italic) = 1 Then
  2233.         LeftStr$="<Font Color=""" & WebColor &"""><B><I>"
  2234.         RightStr$= "</I></B></Font>"
  2235.     Elseif Abs(objvar.labelfont.bold) = 1 Then
  2236.         LeftStr$="<Font Color=""" & WebColor &"""><B>"
  2237.         RightStr$= "</B></Font>"
  2238.     Elseif Abs(objvar.labelfont.italic) = 1 Then
  2239.         LeftStr$="<Font Color=""" & WebColor &"""><I>"
  2240.         RightStr$= "</I></font>"
  2241.     Else
  2242.         LeftStr$="<Font Color=""" & WebColor &""">"
  2243.         RightStr$= "</font>"
  2244.     End If
  2245.     
  2246.     
  2247.     'Let's check for labelposition
  2248.     Select Case objvar.labelposition
  2249.     Case $ltsPositionleft
  2250.         If txtPos = 0 Then
  2251.             strlblByPosition = LeftStr$ & objvar.labeltext & "  " & RightStr$
  2252.         Else
  2253.             strlblByPosition = ""        
  2254.         End If
  2255.     Case $ltsPositionTop
  2256.         If txtPos = 0 Then
  2257.             strlblByPosition = LeftStr$ & objvar.labeltext & "<br>" & RightStr$
  2258.         Else
  2259.             strlblByPosition =""
  2260.         End If
  2261.     Case $ltsPositionRight
  2262.         If txtPos = 1 Then
  2263.             strlblByPosition = LeftStr$ & "  " & objvar.labeltext & RightStr$
  2264.         Else
  2265.             strlblByPosition =""
  2266.         End If
  2267.     Case $ltsPositionBottom
  2268.         If txtPos = 1 Then
  2269.             strlblByPosition = LeftStr$ & "<br>" & objvar.labeltext & RightStr$
  2270.         Else
  2271.             strlblByPosition =""
  2272.         End If
  2273.     Case Else
  2274.         If objvar.parent.parent.type = $aprreport Then 'Treat it as a top label for report as form
  2275.             If txtPos = 0 Then
  2276.                 strlblByPosition = LeftStr$ & objvar.labeltext & "<br>" & RightStr$
  2277.             Else
  2278.                 strlblByPosition =""
  2279.             End If
  2280.         Else
  2281.             strlblByPosition = ""
  2282.         End If
  2283.     End Select
  2284. End Function
  2285. '++LotusScript Development Environment:2:2:PrintShowSQL:1:8
  2286. Sub PrintShowSQL(filenum As Integer, ShowSQL As Integer)
  2287.     
  2288.     If ShowSQL = 1 Then
  2289.         strValue = "Checked"
  2290.     Else
  2291.         strValue= ""
  2292.     End If
  2293.     Print #filenum, "<!-- ShowSQL -->"
  2294.     Print #filenum, "<table><tr>"
  2295.     Print #filenum, "<td><Input type=""" & "checkbox" & """ name=""" & "ShowSQL" & """ value=""" & "1" & """ " & strValue & " size = 10><small> Show SQL?"
  2296.     Print #filenum, "</table>"
  2297.     Print #filenum, "<!-- End ShowSQL -->"
  2298. End Sub
  2299. '++LotusScript Development Environment:2:1:GetTableIndex:1:8
  2300. Function GetTableIndex(strTablename As String, docName As Variant) As Integer
  2301.     'This function will return the correct index number for the specified table in the table collection for the specified document
  2302.     c = 0
  2303.     Forall tables In docName.tables
  2304.         If tables.tablename = strTablename Then
  2305.             GetTableIndex = c
  2306.             Exit Function
  2307.         End If
  2308.         c= c + 1
  2309.     End Forall
  2310. End Function
  2311. '++LotusScript Development Environment:2:1:htmlString:1:8
  2312. Function htmlString(vartext As String) As String
  2313.     'This version will return a comment string if it finds a calculated field in the string
  2314.     newstring = ""
  2315.     
  2316.     For c =1 To Len(vartext)
  2317.         Select Case Mid$(vartext, c, 1)
  2318.         Case Chr(10)
  2319.             newstring = newstring + "<br>"
  2320.         Case "<"
  2321.             newstring =  "<!--[Approach calculated field] -->" 'Found an Approach Calculated field
  2322.             Exit For
  2323.         Case Else
  2324.             newstring = newstring + Mid$(vartext, c, 1)
  2325.         End Select
  2326.     Next
  2327.     
  2328.     htmlString = newstring
  2329. End Function
  2330. '++LotusScript Development Environment:2:1:FormatPath:1:8
  2331. Function FormatPath(imagepath As String) As String
  2332.     If imagepath="" Then Exit Function
  2333.     'Strip imagepath of backslashes:
  2334.     If Left$(imagepath, 1) <> "\" Then
  2335.         imagepath =Right$( imagepath, Len(imagepath) -1)
  2336.     End If
  2337.     If Right$(imagepath, 1)<> "\" Then    
  2338.         imagepath =Left$( imagepath, Len(imagepath) -1)
  2339.     End If
  2340.         'Check that the image directory specified begins and ends with forward slashes:
  2341.     If Left$(imagepath, 1) <> "/" Then
  2342.         imagepath = "/" + imagepath
  2343.     End If
  2344.     If Right$(imagepath, 1)<> "/" Then
  2345.         imagepath = imagepath + "/"
  2346.     End If
  2347.     
  2348.     FormatPath = imagepath
  2349. End Function
  2350. '++LotusScript Development Environment:2:1:strLblByPosition2:1:8
  2351. Function strLblByPosition2(objvar As Variant, txtPos As Integer) As String
  2352.     
  2353.     'This returns a string value with html text determining if the label for the
  2354.     'object is on top, bottom, left, or right.
  2355.     'txtPos here indicates the position of the place holders I have in the Print Subroutines:
  2356.     '$labelLeft &$labelRight
  2357.     '0 indicates it's for left
  2358.     '1 indicates it is for right.
  2359.     
  2360.     
  2361.     'Get the font color
  2362.     fntColor = objvar.labelfont.color.getrgb()
  2363.     'Convert to hex
  2364.     tempColor = Hex$(fntColor)
  2365.     WebColor = Right (tempColor, Len(tempColor) - 1)
  2366.     
  2367.     'Check for text formatting:
  2368.     If Abs(objvar.labelfont.bold) = 1 And  Abs(objvar.labelfont.italic) = 1 Then
  2369.         LeftStr$="<Font Color=""" & WebColor &"""><B><I>"
  2370.         RightStr$= "</I></B></Font>"
  2371.     Elseif Abs(objvar.labelfont.bold) = 1 Then
  2372.         LeftStr$="<Font Color=""" & WebColor &"""><B>"
  2373.         RightStr$= "</B></Font>"
  2374.     Elseif Abs(objvar.labelfont.italic) = 1 Then
  2375.         LeftStr$="<Font Color=""" & WebColor &"""><I>"
  2376.         RightStr$= "</I></font>"
  2377.     Else
  2378.         LeftStr$="<Font Color=""" & WebColor &""">"
  2379.         RightStr$= "</font>"
  2380.     End If
  2381.     
  2382.     
  2383.     'Let's check for labelposition
  2384.     Select Case objvar.labelposition
  2385.     Case $ltsPositionleft
  2386.         If txtPos = 0 Then
  2387.             strlblByPosition2 = LeftStr$ & objvar.labeltext & "  " & RightStr$
  2388.         Else
  2389.             strlblByPosition2 = ""        
  2390.         End If
  2391.     Case $ltsPositionTop
  2392.         If txtPos = 0 Then
  2393.             strLblByPosition2 = LeftStr$ & objvar.labeltext & "<br>" & RightStr$
  2394.         Else
  2395.             strLblByPosition2 =""
  2396.         End If
  2397.     Case $ltsPositionRight
  2398.         If txtPos = 1 Then
  2399.             strLblByPosition2 = LeftStr$ & "  " & objvar.labeltext & RightStr$
  2400.         Else
  2401.             strLblByPosition2 =""
  2402.         End If
  2403.     Case $ltsPositionBottom
  2404.         If txtPos = 1 Then
  2405.             strLblByPosition2 = LeftStr$ & "<br>" & objvar.labeltext & RightStr$
  2406.         Else
  2407.             strLblByPosition2 =""
  2408.         End If
  2409.     Case Else
  2410.         'If objvar.parent.parent.type = $aprreport Then 'Treat it as a top label for report as form
  2411.         '    If txtPos = 0 Then
  2412.         '        strLblByPosition2 = LeftStr$ & objvar.labeltext & "<br>" & RightStr$
  2413.         '    Else
  2414.         '        strLblByPosition2 =""
  2415.         '    End If
  2416.         'Else
  2417.         strLblByPosition2 = ""
  2418.         'End If
  2419.     End Select
  2420. End Function
  2421. '++LotusScript Development Environment:2:2:ReturnWinTitle:1:8
  2422. Sub ReturnWinTitle
  2423.     'Rename the window title for the dialogue so that it has the title we want instead of the apr file name
  2424.     Dim activeWin As Integer, winTitle As String
  2425.     activeWin% = GetActiveWindow()
  2426.     winTitle$ = "Approach"
  2427.     SetWindowTextA activeWin%, winTitle$
  2428. End Sub
  2429. '++LotusScript Development Environment:2:1:ParseUserid:1:8
  2430. Function ParseUserid(FullTablePath As String) As String
  2431.     Dim tempStr As String
  2432.     
  2433.     tempStr = Left(FullTablePath, Instr(1, FullTablePath, "\") - 1)
  2434.     ParseUserid = tempStr
  2435.     
  2436.     
  2437. End Function
  2438. '++LotusScript Development Environment:2:2:PrintCredits:1:8
  2439. Sub PrintCredits(FileNum As Integer)
  2440.     
  2441.     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>"
  2442.     
  2443. End Sub
  2444. '++LotusScript Development Environment:2:2:GetWebTemplate:1:8
  2445. Sub GetWebTemplate(PicName As String)
  2446.     On Error Resume Next
  2447.     
  2448.     WebTemplate = Right$(PicName, Len(PicName) -3)
  2449.     If WebTemplate = "Cancel" Then
  2450.         WebTemplate = ""
  2451.     Else
  2452.         WebTemplate = WebTemplate + ".gif"
  2453.     End If
  2454.     
  2455.     'CurrentApplication.visible = False
  2456.     CurrentDocument.window.visible = False
  2457.     
  2458.     Set CurrentWindow.activeview = CurrentDocument.opening
  2459.     Set CurrentWindow.activeview = CurrentDocument.www~ assistant
  2460.     'reset error
  2461.     Err = 0
  2462. End Sub
  2463. '++LotusScript Development Environment:2:2:Sub1:1:8
  2464. Sub Sub1
  2465.     Set CurrentWindow.ActiveView = CurrentDocument.Opening
  2466.     CurrentApplication.visible = True
  2467.     CurrentDocument.window.visible = False
  2468.     
  2469.     CurrentView.visible = True    
  2470.     currentview.timerinterval=0
  2471. End Sub    
  2472. '++LotusScript Development Environment:2:2:QuitAssistant:1:8
  2473. Sub QuitAssistant
  2474.     Err=0
  2475.     If Lcase$(Left$(CurrentDocument.name,6)) = "db2www"  Then
  2476.         'Set the flag for modified to false to bypass UI save dialog
  2477.         CurrentDocument.Modified = False
  2478.         'FINALLY close just the web sizing assistant!
  2479.         CurrentApplication.ApplicationWindow.DoMenuCommand(IDM_CLOSE)
  2480.         Doevents
  2481.     End If
  2482.     
  2483. End Sub
  2484. '++LotusScript Development Environment:2:1:ParseSQLUserid:1:8
  2485. Function ParseSQLUserid(strSQL As String, aryUserid() As String) As Variant
  2486.     'This routine must parse thru the SQL string returned from the SQL property
  2487.     'of the query object.  If this routine is called, it's because the apr being
  2488.     'translated is the result of SQL Assistant
  2489.     'For now, will return alias table for use with 
  2490.     'GetSQLAssistant routine which has bugs
  2491.     
  2492.     Dim intPosSpace%, intPosComma%, intPosPeriod As Integer
  2493.     Dim strtemp As String
  2494.     Dim intNumTables%, intNumCommas As Integer
  2495.     Dim intAryPos(1 To 4) As Integer
  2496.     Dim rval As Integer
  2497.     Dim intPos As Integer
  2498.     Dim strFind As String
  2499.     Dim c%, j  As Integer
  2500.     Dim aryAlias() As String
  2501.     
  2502.     'Remove quotations marks first:
  2503.     strFind =Chr(34)
  2504.     For c=1 To Len(strSQL) 
  2505.         If Mid(strSQL, c, 1) = strFind  Then
  2506.             strTemp = strTemp
  2507.         Else 
  2508.             strTemp = strTemp + Mid(strSQL, c,1)
  2509.         End If
  2510.     Next
  2511.     
  2512.     strSQL = strTemp
  2513.     intPos =Instr(1, Ucase$(strSQL), "FROM")
  2514.     
  2515.     strTemp =Right$( strSQL,  Len (strSQL) - intPos - 4)
  2516.     
  2517.     
  2518.     'Strip off the rest of the SQL statement that we don't need:
  2519.     'Look for key words, such as :
  2520.     'ORDER, JOIN, WHERE, GROUP
  2521.     
  2522.     intAryPos(1)=Instr(1, Ucase$(strTemp), "ORDER") 
  2523.     intAryPos(2) =Instr(1, Ucase$(strTemp), "JOIN") 
  2524.     intAryPos(3) =Instr(1, Ucase$(strTemp), "WHERE") 
  2525.     intAryPos(4) =Instr(1, Ucase$(strTemp), "GROUP") 
  2526.     
  2527.     
  2528.     rval =  SortByPos(intAryPos())
  2529.     intPos = 0
  2530.     Forall intElements In intAryPos
  2531.         If intElements > 0 Then
  2532.             intPos = intElements
  2533.             Exit Forall
  2534.         End If
  2535.     End Forall
  2536.     
  2537.     
  2538.     
  2539.     'Remove the remainder of the sql string that we don't need
  2540.     If intPos <> 0 Then
  2541.         strTemp = Mid$( StrTemp, 1 , intPos -1)    
  2542.     End If
  2543.     
  2544.     'Count the number of commas in the string that is left - if none, then 1 table:
  2545.     For c = 1 To Len(strTemp) 
  2546.         If Mid$(StrTemp,c,1) = "," Then
  2547.             intNumCommas = intNumCommas + 1
  2548.         End If
  2549.     Next
  2550.     If intNumCommas = 0 Then
  2551.         intNumCommas = 1
  2552.     End If
  2553.     intNumTables = intNumCommas
  2554.     Redim aryAlias(0 To intNumTables, 0 To 1)
  2555.     Redim aryUserId(0 To intNumTables, 0 To 1)
  2556.     
  2557.     'Now retreive the sets of Owner and tablenames
  2558.     
  2559.     c=0
  2560.     intPos=1
  2561.     While intPos < Len(strTemp) -1
  2562.         intPosPeriod =Instr(1, Lcase$(strTemp), ".")
  2563.         intPosComma =  Instr(1, Lcase$(strTemp), ",")
  2564.         If intPosComma <> 0 Then
  2565.             IntPos = intPosComma
  2566.         Else
  2567.             IntPos = Len(strTemp)
  2568.         End If
  2569.         
  2570.         AryUserid(c, 0) = Left$(strTemp, intPosPeriod - 1)
  2571.         AryUserid(c, 1) = Mid$( strTemp, intPosPeriod + 1, IntPos - (intPosPeriod + 1))
  2572.         'Subtract the portion of the string that we're finished with:
  2573.         c=c+1
  2574.         strTemp = Right$(strTemp,Len(strTemp) - intPos)
  2575.     Wend
  2576.     
  2577.     'Now go thru the Tables array and make sure that no aliases exist:
  2578.     intPosSpace = 0
  2579.     j = 0
  2580.     For c = 0 To Ubound(aryUserid())
  2581.         aryUserid(c,1) = Trim(aryUserid(c, 1))
  2582.         intPosSpace = Instr(aryUserid(c, 1),Space(1)) 
  2583.         If intPosSpace Then
  2584.             'Add the alias to the alias array
  2585.             aryAlias(j, 0) = Trim(Right$(aryUserid(c, 1),Len(aryUserid(c, 1)) - intPosSpace ))
  2586.             'Remove the alias from the array:
  2587.             aryUserid(c, 1) = Left$(aryUserid(c, 1), intPosSpace - 1)
  2588.             'Add the fully qualified tablename to the alias array
  2589.             aryAlias(j, 1) = aryUserid(c,0) & "." & aryUserid(c,1)
  2590.             j = j+1
  2591.         End If
  2592.     Next
  2593.     If aryAlias(0,0) <> "" Then
  2594.         ParseSQLUserid = aryAlias        
  2595.     End If
  2596.     
  2597. End Function
  2598. '++LotusScript Development Environment:2:1:SortByPos:1:8
  2599. Function SortByPos(aryPos() As Integer)
  2600.     'This function will sort the position number of
  2601.     'certain keywords in a SQL string
  2602.     
  2603.     Dim i%, j%, temp As Integer
  2604.     i = 0
  2605.     j = 0
  2606.     For i =  1 To Ubound(aryPos)
  2607.         temp =aryPos(i)
  2608.         For j = i + 1 To  Ubound(aryPos)
  2609.             If aryPos(j) <aryPos(i) Then
  2610.                 aryPos(i) =aryPos(j)    
  2611.                 aryPos(j) = temp
  2612.                 temp = aryPos(i)
  2613.                 
  2614.             End If
  2615.         Next
  2616.     Next
  2617.     
  2618.     
  2619.     
  2620. End Function
  2621. '++LotusScript Development Environment:2:1:ReplaceAliases:1:8
  2622. Function ReplaceAliases(strSQLOriginal As String, strSQLclause As String) As String
  2623.     'Replaces alias names for tables with fully
  2624.     'qualified tablenames
  2625.     Dim aryTemp() As String
  2626.     Dim aryAliases As Variant
  2627.     Dim intPosAlias As Integer
  2628.     Dim intPosPeriod As Integer
  2629.     Dim j As Integer
  2630.     Dim strFind As String
  2631.     
  2632.     'Remove parentheses from strSQLclause if any exist:
  2633.     For c = 1 To Len(strSQLclause)
  2634.         If Mid$(strSQLclause, c,1) = "(" Or Mid$(strSQLclause, c,1) =")" Then
  2635.             'Do nothing
  2636.         Else
  2637.             strTemp = strTemp + Mid$(strSQLclause, c,1)
  2638.         End If
  2639.     Next
  2640.     strSQLClause = Trim$(strTemp)
  2641.     strTemp = ""    
  2642.     
  2643.     'Remove quotations marks first:
  2644.     strFind =Chr(34)
  2645.     For c=1 To Len(strSQLclause) 
  2646.         If Mid(strSQLclause, c, 1) = strFind  Then
  2647.             strTemp = strTemp
  2648.         Else 
  2649.             strTemp = strTemp + Mid(strSQLclause, c,1)
  2650.         End If
  2651.     Next
  2652.     strSQLclause = strTemp
  2653.     strTemp = ""
  2654.     aryAliases = ParseSQLUserid(strSQLOriginal, aryTemp)
  2655.     
  2656.     'Continue only if aryAliases has aliases...
  2657.     If Not (Isarray(aryAliases)) Then
  2658.         Goto Finished
  2659.     End If
  2660.     'Look for a period:
  2661.     c=0
  2662.     CurStrLen = Len(strSQLclause)
  2663.     While c < CurStrLen
  2664.         For c = 1 To CurStrLen
  2665.             Select Case Mid$(strSQLclause,c,1)
  2666.             Case Space(1)
  2667.                 strTemp = ""
  2668.             Case "."
  2669.             'Must have found an alias
  2670.                 For j = 0 To Ubound(aryAliases)
  2671.                     If aryAliases(j,0) = strTemp Then
  2672.                         intPosAlias = c - Len(strTemp)
  2673.                     'We have an alias to replace:
  2674.                         strSQLClause = Left$(strSQLclause, intPosAlias - 1) & aryAliases(j,1) & "."    & Right$(strSQLClause, Len(strSQLClause) - (intPosAlias + Len(aryAliases(j,0)))) 
  2675.                         strTemp =  ""
  2676.                         c= c + Len(aryAliases(j,1)) + 1 
  2677.                         CurStrLen = Len(strSQLclause)
  2678.                         Exit For
  2679.                     End If
  2680.                 Next
  2681.             Case Else
  2682.                 strTemp = strTemp & Mid$(strSQLclause,c,1)
  2683.             End Select
  2684.         Next
  2685.         
  2686.     Wend
  2687.     
  2688. Finished:
  2689.     ReplaceAliases = strSQLClause
  2690.     
  2691. End Function