/* Microsoft SQL Server - Scripting */
/* Server: MSI_NJ_SERVER */
/* Database: RequestBroker */
/* Creation Date 11/3/96 4:39:03 PM */
GRANT CREATE TABLE TO public
GO
GRANT CREATE TABLE TO public
GO
/*** Object: User RequestBroker Script Date: 11/3/96 4:39:04 PM ***/
if not exists (select * from sysusers where name = 'RequestBroker' and uid <
16382)
EXEC sp_adduser 'RequestBroker', 'RequestBroker', 'public'
GO
/*** Object: Table dbo.t_Fields Script Date: 11/3/96 4:39:04 PM ***/
if exists (select * from sysobjects where id = object_id('dbo.t_Fields') and
sysstat & 0xf = 3)
drop table dbo.t_Fields
GO
/*** Object: Table dbo.t_Fields Script Date: 11/3/96 4:39:04 PM ***/
CREATE TABLE dbo.t_Fields (
ID int NULL ,
Report_ID int NULL ,
Name varchar (255) NULL ,
DataType smallint NULL ,
Description varchar (255) NULL ,
Size smallint NULL ,
Value varchar (255) NULL ,
SelectedFilter smallint NULL
)
GO
CREATE UNIQUE CLUSTERED INDEX ID ON dbo.t_Fields(ID)
GO
GRANT SELECT ON t_Fields TO public
GO
Figure 3 GetReportsList
Public Sub GetReportsList(asReportList() As String)
'PART II
'Has been changed from a Test Harness/Stub for Reporter
' to develop against.
' Now draws data from Data Cache to build message structure.
Dim oResultset As rdoResultset
Set oResultset = oConnection.OpenResultset("Select * from _
t_Reports", rdOpenKeyset, rdConcurReadOnly)
oResultset.MoveLast
ReDim asReportList(1, oResultset.RowCount) As String
oResultset.MoveFirst
Dim iRowCount As Integer
Do While Not oResultset.EOF
asReportList(0, iRowCount) = oResultset.rdoColumns("Name")
asReportList(1, iRowCount) = _
oResultset.rdoColumns("Description")
iRowCount = iRowCount + 1
oResultset.MoveNext
Loop
Set oResultset = Nothing
End Sub
Figure 4 1stReportList
Private Sub lstReportList_Click()
'PART II
'Populate the ViewerType list on report selection
sbMain.Panels.Item(1).Text = asReportsList _
(1, lstReportList.ListIndex)
lstViewerType.Clear
Set oMessage = Nothing
oRequestBroker.GetReportDescription lstReportList.Text, oMessage
Dim iLoop As Integer
For iLoop = 1 To oMessage.ViewerTypes.Count
lstViewerType.AddItem oMessage.ViewerTypes.Item(iLoop).Name
Next iLoop
End Sub
Figure 5 GetReportDescription
Public Sub GetReportDescription(sName As String, oMessage As _
ReportBuildMessage)
'PART II
'Report-building message structure is built here by using the passed-in
' report name to query the database
'Load Header Information ====================
oMessage.Header.ReportName = sName
oMessage.Header.ReportID = sUniqueName
'Load Field Information =======================
Dim oResultset As rdoResultset
Dim sSQL As String
sSQL = "select t_Reports.Description as ReportDescription, _
t_Fields.Name as FieldsName, t_Fields.DataType, " & _
"t_Fields.Description as FieldsDescription, t_Fields.Size, _
t_Fields.Value, " & _
"t_Fields.SelectedFilter, t_Filters_Selected.Name as _
FiltersSelectedName, t_Filters.Name as FiltersName, " & _
"t_Filters.Description as FiltersDescription from t_Fields, _
t_Fields_MTM_Filters, t_Filters, " & _
"t_Filters t_Filters_Selected, t_Reports where t_Reports.Name = '" _
& sName & "' and " & _
"t_Fields.Report_ID = t_Reports.ID and " & _
"t_Fields.ID = t_Fields_MTM_Filters.Field_ID and " & _
"t_Fields_MTM_Filters.Filter_ID = t_Filters.ID and " & _
"t_Fields.SelectedFilter = t_Filters_Selected.ID order by _
t_Reports.ID, t_Fields.ID, t_Filters.ID"
Set oResultset = oConnection.OpenResultset(sSQL, rdOpenKeyset, _
rdConcurReadOnly)
Dim sCurrentFieldName As String
Dim sCurrentFilterName As String
'Do While there are records
Do While Not oResultset.EOF
'Set Current name
sCurrentFieldName = oResultset.rdoColumns("FieldsName")
'Create a Field object
oMessage.Fields.Create sCurrentFieldName
'Set Field properties
With oMessage.Fields.Item(sCurrentFieldName)
'Cast rdo data types
.Name = sCurrentFieldName
.DataType = vFixRDOData(oResultset.rdoColumns("DataType"))
.Description = vFixRDOData _
(oResultset.rdoColumns("FieldsDescription"))
.Size = vFixRDOData(oResultset.rdoColumns("Size"))
.Value = vFixRDOData(oResultset.rdoColumns("Value"))
.SelectedFilter = vFixRDOData _
(oResultset.rdoColumns("FiltersSelectedName"))
End With
'Do While We are on the same Field and have records
Do While Not oResultset.EOF
If sCurrentFieldName <> oResultset.rdoColumns _
("FieldsName") Then Exit Do
'Set current filter name
sCurrentFilterName = oResultset.rdoColumns("FiltersName")
'Create the filter object and set its properties
With oMessage.Fields.Item(sCurrentFieldName).Filters
.Create sCurrentFilterName
With .Item(sCurrentFilterName)
.Name = vFixRDOData _
(oResultset.rdoColumns("FiltersName"))
.Description = vFixRDOData _
(oResultset.rdoColumns("FiltersDescription"))
End With
End With
'Go to the next record
oResultset.MoveNext
Loop
Loop
'Load Viewer Information ======================
sSQL = "Select t_ViewerTypes.Name from t_Reports, _
t_Reports_MTM_ViewerTypes, t_ViewerTypes where " & _
"t_Reports.Name = '" & sName & "' and " & _
"t_Reports.ID = t_Reports_MTM_ViewerTypes.Report_ID and " & _
"t_Reports_MTM_ViewerTypes.ViewerType_ID = t_ViewerTypes.ID " & _
"order by t_ViewerTypes.Name"
Set oResultset = oConnection.OpenResultset(sSQL, rdOpenKeyset, _
rdConcurReadOnly)
Do While Not oResultset.EOF
oMessage.ViewerTypes.Create (oResultset.rdoColumns("Name"))
oMessage.ViewerTypes.Item((oResultset.rdoColumns("Name"))) _
.Name = (oResultset.rdoColumns("Name"))
oResultset.MoveNext
Loop
Set oResultset = Nothing
End Sub
Figure 8 Finished
'Finished
'PART II
If pbMain.Value = pbMain.Max Then
'Hide the Wizard
Me.Hide
'Load the ReportRunning form, configure,
' center, then show it
Load frmReportRunning
CenterChild frmReporter, frmReportRunning
frmReportRunning.Message oMessage.Header.ReportName
frmReportRunning.Show
DoEvents
oReportDone.ViewerType = oMessage.Header.ReportType
oReportDone.ReportName = oMessage.Header.ReportName
'Submit the request
oRequestBroker.SubmitReportRequest oMessage, oReportDone
'Being synchronous, when we hit this point, the report
' is done
Unload frmReportRunning
Unload Me
'Call the routine that will look at the oReportDone
' message and display the report
ProcessResults oReportDone
Exit Sub
End If
Figure 9 SubmitReportRequest
Public Sub SubmitReportRequest(oMessage As ReportBuildMessage, _
oReportDone As ReportDone)
'PART II
'It is here that we Handle a requested Report
Dim oResultset As rdoResultset
Dim sSQL As String
Dim oVDO As Object
Select Case oMessage.Header.ReportType
'In places like this we should be using the IDs but I've
' elected to use the string names everywhere to make it
' easier to follow and understand
Case "Excel"
'To be added
Case "HTML"
sSQL = "Select t_VDOs.* from t_Reports, t_VDOs where _
t_Reports.Name = '" & _
oMessage.Header.ReportName & "' and t_VDOs.ID = _
t_Reports.VDO_ID "
Set oResultset = oConnection.OpenResultset(sSQL, _
rdOpenKeyset, rdConcurReadOnly)
Set oVDO = CreateObject(oResultset.rdoColumns("Name"))
Set oResultset = Nothing
oVDO.BuildResultset oMessage, oReportDone
If oReportDone.ReportError = "" Then
'Process Resultset into an HTML Report
Set foBuilder = CreateObject("ReportBuilder" & _
oReportDone.ViewerType & ".ReportBuilder")
foBuilder.Build oReportDone
Set oVDO = Nothing
End If
Case "Tab Delimited"
'To be added
End Select
'Transfer the type
oReportDone.ViewerType = oMessage.Header.ReportType
End Sub
Figure 10 BuildResultset
Public Sub BuildResultset(oMessage As ReportBuildMessage, _
oReportDone As ReportDone)
Dim oResultset As rdoResultset
Set oResultset = oConnectionSource.OpenResultset _
(GenerateSQL(oMessage), rdOpenKeyset, rdConcurReadOnly)
oReportDone.Report = CacheData(oResultset)
End Sub
Figure 11 Class Initialize
Private Sub Class_Initialize()
Set oEnvironmentVDO = rdoEngine.rdoCreateEnvironment _
("VDO Employee Financial", "VDOEmployeeFinancial", _
"vdoemployeefinancial")
Set oConnectionSource = oEnvironmentVDO.OpenConnection _
("EmployeeFinancial", rdDriverNoPrompt, False, "")
Set oEnvironmentCache = rdoEngine.rdoCreateEnvironment _
("VDO Cache", "VDOCache", "vdocache")
Set oConnectionCache = oEnvironmentCache.OpenConnection _
("VDO", rdDriverNoPrompt, False, "")
End Sub
Figure 12 GenerateSQL
Private Function GenerateSQL(oMessage As ReportBuildMessage) As String
Dim sSQL As String
Dim iLoop As Integer
Dim oField As Object
For iLoop = 1 To oMessage.Fields.Count
Set oField = oMessage.Fields.Item(iLoop)
If oField.Value <> "" Then
Select Case oField.DataType
Case 1
sSQL = sSQL & oField.Name & " " & _
oField.SelectedFilter & " '" & _
oField.Value & "' and "
Case 2, 3
sSQL = sSQL & oField.Name & " " & _
oField.SelectedFilter & " " & oField.Value & " and "
End Select
End If
Next iLoop
'Remove last and
If iLoop > 0 Then
sSQL = Left(sSQL, Len(sSQL) - 4)
End If
#If ACCESS_DB Then
sSQL = "Select * from t_Employees where " & _
sSQL & " order by LastName, FirstName"
#Else
sSQL = "Select * from dbo.t_Employees where " & _
sSQL & " order by LastName, FirstName"
#End If
GenerateSQL = sSQL
End Function
Figure 14 CacheData
Private Function CacheData(oResultset As rdoResultset) As String
'If we were always in the same datacache we could just do a
' select into the new table. Since we don't want that limitation
' we will pump the data
Dim sTableName As String
Dim sInsertStatic As String
Dim sInsertDynamic As String
Dim iLoop As Integer
sTableName = CreateCacheTable
sInsertStatic = "Insert into " & sTableName & " ("
For iLoop = 0 To oResultset.rdoColumns.Count - 1
sInsertStatic = sInsertStatic & _
oResultset.rdoColumns.Item(iLoop).Name & ","
Next iLoop
sInsertStatic = Left(sInsertStatic, Len(sInsertStatic) - 1) & _
") Values ("
Do While Not oResultset.EOF
sInsertDynamic = ""
For iLoop = 0 To oResultset.rdoColumns.Count - 1
Select Case oResultset.rdoColumns.Item(iLoop).Type
Case rdTypeCHAR, rdTypeDATE, rdTypeTIME, _
rdTypeTIMESTAMP, rdTypeVARCHAR
If IsNull(oResultset.rdoColumns.Item(iLoop).Value) _
Then
sInsertDynamic = sInsertDynamic & "Null,"
Else
sInsertDynamic = sInsertDynamic & "'" & _
oResultset.rdoColumns.Item(iLoop).Value & "',"
End If
Case Else
If IsNull(oResultset.rdoColumns.Item(iLoop).Value) _
Then
sInsertDynamic = sInsertDynamic & "Null,"
Else
sInsertDynamic = sInsertDynamic & _
oResultset.rdoColumns.Item(iLoop).Value & ","
End If
End Select
Next iLoop
sInsertDynamic = Left(sInsertDynamic, Len(sInsertDynamic) - 1) _
& ")"
oConnectionCache.Execute sInsertStatic & sInsertDynamic
oResultset.MoveNext
Loop
fsTableName = sTableName
CacheData = sTableName
End Function
Figure 15 CreateCacheTable
Private Function CreateCacheTable() As String
Dim sTableName As String
Dim sSQL As String
#If ACCESS_DB Then
sTableName = "t_" & sUniqueName
sSQL = "CREATE TABLE " & sTableName & " (" & _
"EmployeeID int ," & _
"LastName varchar (20) ," & _
"FirstName varchar (10) ," & _
"Title varchar (30) ," & _
"TitleOfCourtesy varchar (25) ," & _
"BirthDate datetime ," & _
"HireDate datetime ," & _
"Address varchar (60) ,"
sSQL = sSQL & "City varchar (15) ," & _
"Region varchar (15) ," & _
"PostalCode varchar (10) ," & _
"Country varchar (15) ," & _
"HomePhone varchar (24) ," & _
"Extension varchar (4) ," & _
"ReportsTo int ,"
sSQL = sSQL & "Salary money ," & _
"Bonus money )"
#Else
sTableName = oEnvironmentCache.UserName & ".t_" & sUniqueName
sSQL = "CREATE TABLE " & sTableName & " (" & _
"EmployeeID int NULL ," & _
"LastName varchar (20) NULL ," & _
"FirstName varchar (10) NULL ," & _
"Title varchar (30) NULL ," & _
"TitleOfCourtesy varchar (25) NULL ," & _
"BirthDate datetime NULL ," & _
"HireDate datetime NULL ," & _
"Address varchar (60) NULL ,"
sSQL = sSQL & "City varchar (15) NULL ," & _
"Region varchar (15) NULL ," & _
"PostalCode varchar (10) NULL ," & _
"Country varchar (15) NULL ," & _
"HomePhone varchar (24) NULL ," & _
"Extension varchar (4) NULL ," & _
"ReportsTo int NULL ,"
sSQL = sSQL & "Salary money NULL ," & _
"Bonus money NULL)"
#End If
oConnectionCache.Execute sSQL
#If ACCESS_DB Then
#Else
sSQL = "GRANT REFERENCES , SELECT , INSERT , DELETE , _
UPDATE ON " & sTableName & " TO public"
oConnectionCache.Execute sSQL
#End If
CreateCacheTable = sTableName
End Function
Figure 16 UniqueName
Private Function sUniqueName() As String
'PART II
'There are more precise ways to generate unique names. GUIDs could even
'be used. This is good enough for our needs. We might add a unique
'process ID for the Request Broker using this to make the name more
'unique.
Dim sHold As String
Dim iPos As Integer
sHold = Trim(Str(Format(Date, "ddmmyyyy"))) & Trim(Str(CDbl(Timer)))
'Replace any . with _
iPos = InStr(1, sHold, ".")
sUniqueName = Left(sHold, iPos - 1) & "_" & _
Right(sHold, Len(sHold) - iPos)
End Function
Figure 17 Build
Public Sub Build(oReportDone As ReportDone)
Dim oResultset As rdoResultset
Dim sSQL As String
fsTableName = oReportDone.Report
sSQL = "Select * from " & oReportDone.Report
Set oResultset = oConnectionSource.OpenResultset _
(sSQL, rdOpenKeyset, rdConcurReadOnly)
BuildReport oResultset, oReportDone
'Not only required because it is a good habit, but
' when using Access as the DataCache it will lock the table
' and not allow us to drop it because the resultset is placed
' on the rdoResultsets collection of the rdoConnection
' object.
oResultset.Close
End Sub
Figure 18 BuildReport
Private Sub BuildReport(oResultset As rdoResultset, _
oReportDone As ReportDone)
Dim iFileHandle As Integer
Dim sOutput As String
Dim iLoop As Integer
Dim iColumns As Integer
'If we compile locally then place the resultant HTM file locally
#If ACCESS_DB Then
fsFileName = "C:\HTM\" & sStripOwner(oReportDone.Report) & ".htm"
#Else 'If we are on the server put it in the shared directory
fsFileName = "W:\" & sStripOwner(oReportDone.Report) & ".htm"
#End If
iFileHandle = FreeFile
'Open/Create the output file
Open fsFileName For Output Access Write Lock Write As iFileHandle
'Start document and table
Print #iFileHandle, "<HTML> <TITLE> </TITLE> <BODY> _
<TABLE border> <TR>"
'Set the number of columns
Print #iFileHandle, "<TH colspan=" & _
oResultset.rdoColumns.Count & ">"
'Set the report name
Print #iFileHandle, "<H3><A NAME=""TT"">" & _
oReportDone.ReportName & "</a></H3> </TH> </TR> <TR>"
iColumns = oResultset.rdoColumns.Count - 1
'Put the column headers in
For iLoop = 0 To iColumns
sOutput = sOutput & "<TH>" & _
oResultset.rdoColumns.Item(iLoop).Name & "</TH>"
Next iLoop
'Finish the headers
sOutput = sOutput & "</TR>"
Print #iFileHandle, sOutput
'Populate the cells
Do While Not oResultset.EOF
'Start Row
sOutput = "<TR>"
'Do the cells
For iLoop = 0 To iColumns
sOutput = sOutput & "<TD>" & _
oResultset.rdoColumns.Item(iLoop).Value & "</TD>"
Next iLoop
'Finish Row
sOutput = sOutput & "</TR>"
Print #iFileHandle, sOutput
'Next Row
oResultset.MoveNext
Loop
'Finish the document/report
Print #iFileHandle, "</TABLE></BODY></HTML>"
Close iFileHandle
'Depending on whether we are without or with server
' set the URL for the report
#If ACCESS_DB Then
oReportDone.Report = "C|/HTM/" & sStripOwner _
(oReportDone.Report) & ".htm"
#Else
oReportDone.Report = "http://192.168.0.1/vdo/" & _
sStripOwner(oReportDone.Report) & ".htm"
#End If
End Sub
Figure 21 NewShow
Public Sub NewShow(sURL As String)
Load Me
CenterChild frmReporter, Me
wbMain.Navigate sURL
DoEvents
Me.WindowState = 2
wbMain.Top = 0
wbMain.Left = 0
Resize
DoEvents
Me.Show
End Sub
Figure 22 Terminate
Private Sub Class_Terminate()
DestroyReport
DestroyTable
Set oEnvironment = Nothing
Set oConnectionSource = Nothing
End Sub
Private Sub DestroyReport()
Dim dStartTime As Double
dStartTime = Timer
On Error GoTo ERROR_DestroyReport
Kill fsFileName
Exit Sub
ERROR_DestroyReport:
'Apparently it takes some time for IIS to release the file so we
' keep trying until it works.
' Otherwise let garbage collection get it.
Select Case Timer - dStartTime
'30 Second timer
Case Is > 30
'Midnight exception handle
Case Is < 0
'Try again... maybe IIS has let it go
Case Else
Resume
End Select
Exit Sub
End Sub
Private Sub DestroyTable()
oConnectionSource.Execute "Drop table " & fsTableName
End Sub
Figure 23 Setting Properties
With oMessage.Fields.Item(sCurrentFieldName)
'Cast rdo data types
.Name = sCurrentFieldName
.DataType = vFixRDOData(oResultset.rdoColumns("DataType"))
.Description = vFixRDOData (oResultset.rdoColumns _
("FieldsDescription"))
.Size = vFixRDOData(oResultset.rdoColumns("Size"))
.Value = vFixRDOData(oResultset.rdoColumns("Value"))
.SelectedFilter = vFixRDOData(oResultset.rdoColumns _
("FiltersSelectedName"))
End With
Figure 25 ConvertFile Function
Private Function ConvertFile(sFileName As String) As Boolean
'The work to convert the header file to a bas file takes place here
'Basically trap any file or command line errors
On Error GoTo ERROR_ConvertFile
'Set successful completion to false
ConvertFile = False
Dim iInFile As Integer
Dim iOutFile As Integer
Dim sInString As String
Dim sOutString As String
'Get input file handle and open file
iInFile = FreeFile
Open sFileName For Input As iInFile
'Get output file handle and open file
'Since VB only allows one resource file we've chosen
' RESOURCE.BAS as our result name
iOutFile = FreeFile
Open ExtractPath(sFileName) & "RESOURCE.BAS" For Output As iOutFile
'Put in the first line required by VB
Print #iOutFile, "Attribute VB_Name = ""modResource"""
'Process the whole file
Do While Not EOF(iInFile)
'In with a row
Input #iInFile, sInString
'Looking at a .h file generated by the Developer Studio Resource
' editor shows that the first break in lines of text is where
' we want to bail out
If Left(sInString, 1) = "" Then
Exit Do
'Else we ignore comments
ElseIf Left(sInString, 1) <> "/" Then
'If it is not a comment then replace the #define with _
"Public Const"
sOutString = "Public Const" & Right(sInString, _
Len(sInString) - Len("#define"))
'Put an equal (=) sign between the const name and value
Dim iLastSpace As Integer
iLastSpace = FindLastSpace(sOutString)
sOutString = Left(sOutString, iLastSpace) & "= " & _
Right(sOutString, Len(sOutString) - iLastSpace)
'Print result to file
Print #iOutFile, sOutString
End If
Loop
'Close files
Close iInFile
Close iOutFile
'If we made it this far we were successful
ConvertFile = True
Exit Function
Figure 26 Resource.h
//{{NO_DEPENDENCIES}}
// Microsoft Developer Studio generated include file.
// Used by Resource.rc
//
#define STR_HELP 1
#define STR_FAIL_PART_1 2
#define STR_FAIL_PART_2 3
#define STR_SUCCESS_PART_1 4
#define STR_SUCCESS_PART_2 5
#define ICON_MAIN 102
// Next default values for new objects
//
#ifdef APSTUDIO_INVOKED
#ifndef APSTUDIO_READONLY_SYMBOLS
#define _APS_NEXT_RESOURCE_VALUE 103
#define _APS_NEXT_COMMAND_VALUE 40001
#define _APS_NEXT_CONTROL_VALUE 1000
#define _APS_NEXT_SYMED_VALUE 101
#endif
#endif
Figure 27 Resource.bas
Attribute VB_Name = "modResource" Public Const STR_HELP = 1 Public Const STR_FAIL_PART_1 = 2 Public Const STR_FAIL_PART_2 = 3 Public Const STR_SUCCESS_PART_1 = 4 Public Const STR_SUCCESS_PART_2 = 5 Public Const ICON_MAIN = 102