'++LotusScript Development Environment:2:5:(Options):0:74
Option Public
'++LotusScript Development Environment:2:5:(Forward):0:1
Declare Sub NextPage
Declare Sub PrevPage
Declare Function GetObjIndex(Objname As String) As Integer
Declare Function GetForms(DocIndex As Integer, frmlist() As String) As Integer
Declare Function GetRpts(DocIndex As Integer, rptlist() As String) As Integer
Declare Function GetDocIndex(AprFile As String) As Integer
Declare Sub CancelWWWAssist
Declare Function GetViewsIndex(ViewName As String, DocIndex As Integer) As Integer
Declare Sub FindAprs
Declare Function GetUserIds(DocIndex As Integer, aryUserId() As String) As Integer
Declare Function GetViewObj(ViewName As String, docindex As Integer) As Variant
Declare Sub CollectObjs(frmName As String, rptName As String)
Declare Sub DoneBtn(dbutton As Variant)
Declare Function Generate(strDatabaseName As String, strUserid As String, strPassword As String, intShowSQL As Integer, strMacroFile As String, strMacroFileSubDirectory As String, strImagesDirectory As String, intMaxRows As Integer, intDBCase As Integer, intSearchType As Integer, strDefaultMessage As String, intFormMethod As Integer, frmForm As Variant, rptReport As Report, strExecutableName As String, arrUserid() As String, intUserid As Integer, intPassword As Integer, WebTemplate As String) As Integer
Declare Function GenerateDefineVars(strDatabaseName As String, strUserid As String, strPassword As String, intShowSQL As Integer, intMaxRows As Integer, intDBCase As Integer, intUserid As Integer, intPassword As Integer ) As Integer
Declare Function CreateHeader As Integer
Declare Function GetSQLAssistant( arrWhereClauses() As String, arrTables() As String, arrColumns() As String, frmForm As Variant )
Declare Function GetJoins( arrWhereClauses() As String, arrTables() As String, frmForm As Variant, arrUserid() As String ) As Integer
Declare Function SmartAdd( arr() As String, item As String ) As Integer
Declare Function GenerateDefineBegin() As Integer
Declare Function GenerateDefineEnd() As Integer
Declare Function GenerateDefineClauses( intSearchType As Integer, arrWhereClauses() As String, frmForm As Variant, arrTables() As String, arrUserid() As String ) As Integer
Declare Function GenerateDefineTables(arrTables() As String) As Integer
Declare Function GenerateDefineColumns(rptReport As Report, arrColumns() As String, arrUserid() As String) As Integer
Declare Function GenerateHTML_REPORT( strCmdName As String ) As Integer
Declare Function GenerateHTML_INPUT(strMacroFile As String, strMacroFileSubDirectory As String, strImagesDirectory As String, intShowSQL As Integer, intSearchType As Integer, intFormMethod As Integer, frmForm As Variant, strExecutableName As String, intUserid As Integer, intPassword As Integer, WebTemplate As String) As Integer
Declare Function GetAfterLastSlash( strString As String ) As String
Declare Function GenerateSQL( rptReport As Report, strCmdName As String, strDefaultMessage As String, WebTemplate As String, imagePath As String) As Integer
Declare Function ParseString( arrArray() As String, strString As String) As Integer
Declare Function GetFullTableName( strTableName As String, aryLookup() As String ) As String
Declare Function GenerateDefineClause( control As Variant, arrTables() As String, arrUserid() As String) As Integer
Declare Sub PrintFrmHtml(fileNum As Integer, frmObject As Variant, frmMethod As Integer, frmAction As String, imagePath As String, SearchType As Integer, ShowSQL As Integer, XtraHtml As String, WebTemplate As String)
Declare Sub PrintFormTitle(numFile As Integer, vartextbox As Variant)
Declare Sub PrintFldBx(numFile As Integer, varfldbx As Variant)
Declare Sub PrintRadioBtn(NumFile As Integer, varrdobtn As Variant)
Declare Sub PrintCbx(numFile As Integer, varCbx As Variant)
Declare Function GetObj(objary As Variant)
Declare Sub SortItByY
Declare Sub GroupRdoBtn
Declare Sub PrintHtmlGood
Declare Function PrintLbx(numFile As Integer, varlbx As Variant)
Declare Sub SortItByX
Declare Sub PrintRptHtml(filenum As Integer, rptObject As Variant, WebTemplate As String, imagePath As String)
Declare Sub PrintFldBx2(numFile As Integer, varfldbx As Variant)
Declare Function PrintPic(numFile As Integer, varpic As Variant, iPath As String)
Declare Function PrintTextBox(numFile As Integer, vartextbox As Variant)
Declare Function htmlString3(vartext As String) As String
Declare Function GetMethod(frmMethod As Integer) As String
Declare Function GetColumns(myTable As Variant)
Declare Sub FindTest
Declare Function PrintDropbx(numFile As Integer, varDropbx As Variant)
Declare Function GetTable(strTablename As String, docindex As Integer) As Variant
Declare Sub PrintSearch(filenum As Integer, Searchtype As Integer)
Declare Function HtmlFntSz(fntSize As Integer) As Integer
Declare Function chkRadioPrinted(objDataField As String) As Integer
Declare Sub PrintActionBtns(numFile As Integer)
Declare Function NoSpaceStr(StrLabelText As String) As String
Declare Sub chkLineNumber(numFile As Integer, objvar As Variant)
Declare Function strLblByPosition(objvar As Variant, txtPos As Integer) As String
Declare Sub PrintShowSQL(filenum As Integer, ShowSQL As Integer)
Declare Function GetTableIndex(strTablename As String, docName As Variant) As Integer
Declare Function htmlString(vartext As String) As String
Declare Function FormatPath(imagepath As String) As String
Declare Function strLblByPosition2(objvar As Variant, txtPos As Integer) As String
Declare Sub ReturnWinTitle
Declare Function ParseUserid(FullTablePath As String) As String
Declare Sub PrintCredits(FileNum As Integer)
Declare Sub GetWebTemplate(PicName As String)
Declare Sub Sub1
Declare Sub QuitAssistant
Declare Function ParseSQLUserid(strSQL As String, aryUserid() As String) As Variant
Declare Function SortByPos(aryPos() As Integer)
Declare Function ReplaceAliases(strSQLOriginal As String, strSQLclause As String) As String
'++LotusScript Development Environment:2:5:(Declarations):0:10
'Dim searchpath As String ' variable used for opening an apr
'Mike's declarations
Dim intMacroFileHandle As Integer
Dim ColorState As Integer
'Busy cursor functions
Declare Function LoadCursorBynum Lib "user32" Alias "LoadCursorA" (Byval hInstance As Long, Byval lpCursorName As Long) As Long
Declare Function SetCursor Lib "user32" Alias "SetCursor" (Byval hCursor As Long) As Long
Public Const IDC_ARROW = 32512&
Public Const IDC_WAIT = 32514&
'For finding browser and readme:
Declare Public Function GetPrivateProfileString Lib"Kernel" (Byval lpName As String, Byval lpKey As Any, Byval lpDefault As String, Byval lpReturn As String, Byval nSize As Integer, Byval lpFile As String) As Integer
Declare Public Function RegOpenKeyExA Lib "advapi32" Alias "RegOpenKeyExA" (Byval HKEY As Long,Byval lpszSubKey As String,Byval dwreserved As Integer,Byval samDesired As Long, keyresult As Long) As Long
Declare Public Function RegQueryValueExA Lib "advapi32" Alias "RegQueryValueExA" (Byval HKEY As Long,Byval lpszValueName As String,Byval dwreserved As Integer, lpdwtype As Long, Byval lpData As String, readbytes As Long) As Long
Declare Public Function RegCloseKey Lib "advapi32" Alias "RegCloseKey" (Byval HKEY As Long) As Long
Declare Public Function GetPrivateProfileStringA Lib "kernel32" Alias "GetPrivateProfileStringA"(Byval AppName As String,Byval KName As Any, Byval Def As String, Byval RStr As String, Byval nSize As Integer, Byval FName As String) As Integer
Dim gInit As Integer 'To determine if file was opened already - a workaround because the docopen event gets called
'++LotusScript Development Environment:2:2:NextPage:1:8
Sub NextPage
On Error Resume Next
ThisPage = currentview.currentpagenum
Currentview.Currentpagenum = ThisPage + 1
Err = 0
End Sub
'++LotusScript Development Environment:2:2:PrevPage:1:8
Sub PrevPage
On Error Resume Next
ThisPage = currentview.currentpagenum
Currentview.Currentpagenum = ThisPage - 1
Err = 0
End Sub
'++LotusScript Development Environment:2:1:GetObjIndex:1:8
Function GetObjIndex(Objname As String) As Integer
'I have to do this to get around a bug with not being able to access objectnames directly
'This needs to be used with the objectlist collection
i = 0
Forall objects In currentview.objectlist
If Lcase$(currentview.objectlist(i).name) = Objname$ Then
GetObjIndex = i
Exit Function
End If
i = i + 1
End Forall
End Function
'++LotusScript Development Environment:2:1:GetForms:1:8
Function GetForms(DocIndex As Integer, frmlist() As String) As Integer
'This function will return a value that will tell the user if any forms were retrieved.
'It takes the apr file name as the argument and returns a value to let
'the user know if any forms were found.
i = 0
GetForms = 0
arycnt = 0
Redim FrmList(0 To CurrentApplication.Documents(DocIndex).Views.count)
Forall Views In CurrentApplication.Documents(DocIndex).Views
If currentApplication.Documents(DocIndex).Views(i).type = $aprForm Then
dbname = Inputbox("You must enter a valid database name", "Enter Database Name",,300, 300)
If dbname="" Then 'Empty string means cancel
dbutton.font.color.setrgb color_black
Exit Sub
Else
.txtDbName.text = dbname
End If
End If
End With
'Let's check if the macro file already exists so that we don't accidentally overwrite something the user may want to keep:
On Error Goto whatnow
If Dir$(MacName$) <>"" Then
Beep 'If we find it warn the user
answ% = Messagebox("Do you want to overwrite the existing macro file " & Chr(10) & MacName$ & "?", 4 + 16 + 256 + 0, "Macro File Exists") 'the default in the msgbox is NO
If answ% <> 6 Then 'If they don't choose YES,
MacName$ = Inputbox("Macro file name", "MacroFile",CurrentDocument.path & "myMacro.d2w",200,200) 'If they choose NO get a new macro file name
If MacName$="" Then 'user chose cancel
dbutton.font.color.setrgb color_black
Exit Sub
End If
End If
End If
'Check that there is a drive letter:
If Mid$(MacName$,2, 1) <> ":" Then
strPath$=Inputbox("Please enter a valid drive letter:", "Error Creating Macro File", "C:",300, 300)
End If
MacName$=strPath$ + MacName$
'Check that the third character in the macro name is a backslash:
If Mid$(MacName$,3, 1) <> "\" Then
MacLeft$ = Left$(MacName$, 2)
MacRight$ = Right(MacName$, Len(MacName$) - 2)
MacName$ = MacLeft$ + "\" + MacRight$
End If
'Retreive the values from panel 4:
With CurrentDocument.WWW~ Assistant.body
ShowSearch = Val(.rdoSearchPrompt.value) ' value for the group of radio buttons
ShowSql = Val(.rdoSqlPrompt.value)
NumRows = Val(.txtNumRows.text) 'The number of rows to return in the report
End With
'Retreive the values from panel 5:
With CurrentDocument.WWW~ Assistant.body
imagepath =FormatPath( .txtImagePath.text)
macpath = .txtMacroPath.text
exename = .txtExeName.text
case_conv = Val(.rdoNoConvert.value) 'This will provide the value for the group of radio buttons
FormMethod = Val(.rdoFormPost.value) ''This will provide the value for the group of radio buttons
End With
'Reset values in the assistant:
With CurrentDocument.WWW~ Assistant.body
.lbopenapps.setlist(ClearIt)
.lbformsP2.background.color.setrgb color_white
.lbformsP2.readonly = False
End With
prevcursor = SetCursor(waitcursor)
'Retreive the userids for all of the tables
Call GetUserids(DocIndex, aryUserid)
'Get the form and report objects:
Call CollectObjs(formSelected, RptSelected)
'Get the default Message
Dim strDefaultMsg As String
Dim myRs As Resultset
Set myRs = CurrentDocument.tables(0).createresultset
rval = Messagebox ("DB2 WWW macro: " & MacName$ & " created successfully!", MB_OK + MB_ICONEXCLAMATION, "DB2 Web Sizing Assistant")
Err=0
Else 'This means the file could not be opened for some reason so reload the assistant:
Set CurrentWindow.Activeview= Currentdocument.www~ assistant
currentview.currentpagenum = 3
Exit Sub
End If
'Close the assistant dialogue
Call QuitAssistant()
%REM
If CurrentApplication.ApplicationWindow.IsCommandEnabled(IDM_SAVE) Then
Sendkeys "{tab}~",0
End If
'CurrentApplication.visible = True
'CurrentApplication.db2www.window.close
%END REM
prevcursor = SetCursor(arrowcursor)
Whatnow:
If Error$ = "Path not found" Then
Msgbox "Path not found" & Chr(10) & "Please enter valid path and filename",,"Error"
Err=0 'Reset the current error to nothing!
Currentview.currentpagenum = 3
dbutton.font.color.setrgb color_black
Exit Sub
End If
gnrlError:
If Err<>0 Then
Msgbox "The following Lotus Script error occured: " & Chr(10) & Error$, ,"Lotus Script Error"
Msgbox "The Web Sizing Assistant will close", ,"Lotus Script Error"
CurrentApplication.activedocwindow.close 'Close the dialog
CurrentApplication.applicationwindow.domenucommand(IDM_CLOSEANDDISC) 'close the document
End
End If
End Sub
'++LotusScript Development Environment:2:1:Generate:1:8
Function Generate(strDatabaseName As String, strUserid As String, strPassword As String, intShowSQL As Integer, strMacroFile As String, strMacroFileSubDirectory As String, strImagesDirectory As String, intMaxRows As Integer, intDBCase As Integer, intSearchType As Integer, strDefaultMessage As String, intFormMethod As Integer, frmForm As Variant, rptReport As Report, strExecutableName As String, arrUserid() As String, intUserid As Integer, intPassword As Integer, WebTemplate As String) As Integer
Dim rc As Integer 'Return Code
Dim arrWhereClauses(100) As String
Dim arrTables(100) As String
Dim arrColumns(100) As String
'Initialize the WhereClauses and Tables collections
arrWhereClauses(0) = "0"
arrTables(0) = "0"
'Open the Macro File for Write Access
intMacroFileHandle = Freefile()
On Error Goto Whatnow
Open strMacroFile For Output Access Write Lock Write As intMacroFileHandle
'Get SQL Assistant parts (where clauses, orders, groups)
If Error="Unable to open file" Or Error = "Path not found" Then
Msgbox "Unable to open file",, "Error Opening Macro File"
Generate = -2
Err=0 'Reset the error code
Exit Function
End If
End Function
'++LotusScript Development Environment:2:1:GenerateDefineVars:1:8
Function GenerateDefineVars(strDatabaseName As String, strUserid As String, strPassword As String, intShowSQL As Integer, intMaxRows As Integer, intDBCase As Integer, intUserid As Integer, intPassword As Integer ) As Integer
'++LotusScript Development Environment:2:1:CreateHeader:1:8
Function CreateHeader As Integer
CreateHeader = 0
Print #intMacroFileHandle, "%{"
Print #intMacroFileHandle, "This macro file was generated by the DB2 Web Sizing Assistant for Lotus Approach"
Print #intMacroFileHandle, "on " Date$ " at " Time$ "."
Print #intMacroFileHandle, "%}"
Print #intMacroFileHandle,
End Function
'++LotusScript Development Environment:2:1:GetSQLAssistant:1:8
Function GetSQLAssistant( arrWhereClauses() As String, arrTables() As String, arrColumns() As String, frmForm As Variant )
Dim rs As ResultSet
Dim strSQL As String
Dim strColumns As String
Dim strTables As String
Dim strClauses As String
Dim i,j As Integer
Set rs = frmForm.Document.Tables(0).CreateResultSet()
strSQL = rs.Query.SQL
If( strSQL<> "" ) Then
strColumns = ""
strTables = ""
strClauses = ""
i = Instr( strSQL, " FROM " )
'Commented out on12/17/96
'strColumns = Mid$( strSQL, 8, i-9 ) 'Everything between "SELECT " and "FROM"
j = Instr( i+5, strSQL, " WHERE " )
If( j=0 ) Then
j = Instr( i+5, strSQL, " ORDER " )
End If
If( j<>0 ) Then
strTables = Mid$( strSQL, i+5, j -i-6) 'Everything between "FROM" and "WHERE"
'Need to replace aliases in the following string: 12/17/96 -gf
strClauses = Mid$( strSQL, j+6 )
strClauses = ReplaceAliases(strSQL, strClauses)
End If
'Commented out on 12/17/96 -gf
'rc = ParseString( arrColumns, strColumns )
rc = ParseString( arrTables, strTables )
rc = ParseString( arrWhereClauses, strClauses )
End If
GetSQLAssistant = 0
End Function
'++LotusScript Development Environment:2:1:GetJoins:1:8
Function GetJoins( arrWhereClauses() As String, arrTables() As String, frmForm As Variant, arrUserid() As String ) As Integer
Dim joins As Variant
Dim strTable1 As String
Dim strTable2 As String
Dim strWhereClause As String
Dim intJoinIndx, i, intNumJoins As Integer
GetJoins = 0
intJoinIndx = -1
joins = frmForm.Parent.JoinsInternal
'If there is join information, then the IsArray function will return TRUE. Otherwise, it will return FALSE.
If( Isarray(joins) ) Then
While( intJoinIndx < Ubound(joins))
intJoinIndx = intJoinIndx + 1
strTable1 = GetFullTableName( frmForm.Parent.Tables(Val(joins(intJoinIndx))).TableName, arrUserid ) 'Val added by Grace to convert string to numeric value
'++LotusScript Development Environment:2:1:SmartAdd:1:8
Function SmartAdd( arr() As String, item As String ) As Integer
Dim found As Integer
found = False
i = 1
While (Not found) And ( i <= Val( arr(0) ) )
If arr(i) = item Then
found = True
Else
i = i + 1
End If
Wend
If Not found Then
arr(0) = Str$( Val( arr(0) ) + 1 )
arr( Val( arr(0) ) ) = Trim$(item)
End If
End Function
'++LotusScript Development Environment:2:1:GenerateDefineBegin:1:8
Function GenerateDefineBegin() As Integer
Print #intMacroFileHandle, "%DEFINE{"
GenerateDefineBegin = 0
End Function
'++LotusScript Development Environment:2:1:GenerateDefineEnd:1:8
Function GenerateDefineEnd() As Integer
Print #intMacroFileHandle, "%}"
GenerateDefineEnd = 0
End Function
'++LotusScript Development Environment:2:1:GenerateDefineClauses:1:8
Function GenerateDefineClauses( intSearchType As Integer, arrWhereClauses() As String, frmForm As Variant, arrTables() As String, arrUserid() As String ) As Integer
Dim rc As Integer
Dim i,j As Integer
Dim intRadioFound As Integer
Dim aryRadioNames(100) As String
rc = 0
Print #intMacroFileHandle,
'The AndOr variable is the "connector" for the where clauses
'used via user-input on the input form.
Select Case intSearchType
Case 0 : 'Prompt the User
'Do nothing here. We will add an input field on the input form.
Case 1 : 'Always On
Print #intMacroFileHandle, ,"ANDOR=", """AND"""
Case 2 : 'Always Off
Print #intMacroFileHandle, ,"ANDOR=", """OR"""
Case Else :
rc = 999
End Select
'The c2 variable is a list variable which will be instantiated
'++LotusScript Development Environment:2:1:GenerateHTML_INPUT:1:8
Function GenerateHTML_INPUT(strMacroFile As String, strMacroFileSubDirectory As String, strImagesDirectory As String, intShowSQL As Integer, intSearchType As Integer, intFormMethod As Integer, frmForm As Variant, strExecutableName As String, intUserid As Integer, intPassword As Integer, WebTemplate As String) As Integer
'++LotusScript Development Environment:2:2:PrintFrmHtml:1:8
Sub PrintFrmHtml(fileNum As Integer, frmObject As Variant, frmMethod As Integer, frmAction As String, imagePath As String, SearchType As Integer, ShowSQL As Integer, XtraHtml As String, WebTemplate As String)
Dim lStr, rStr As String
aryCounter = 0
flag = 0
radioCounter = 0
'Store the objects in an array
Call GetObj(frmObject.objectlist) 'The form I picked
'To be used to get best-guess datafield for dropdownboxes and listboxes
'GetColumns(frmObject.parent.tables(GetTableIndex(frmObject.maintable, frmObject.parent))) 'need to adjust
'Sort the array by its y coordinate first
SortItByY
'Now let's split the objects line by line and sort by x coordinate
SortItByX
'Have to group the radiobuttons in order to group them correctly in the cells