Attribute VB_Name = "mPatLst"
Option Explicit
Option Compare Text
Option Base 0

'   This program is part of the ETR System.  It displays a report selection list and runs the
'   selected reports until the user selects cancel.  If there is only one possible report, it
'   is printed without displaying the selection form.
'   It expects the AltMode code and the name of a permanent variable to be listed on the command line
'   The permanent variable is set to 1 if the user has selected a report, 0 if not
'   It expects the following permanent variables to exist (the first 3 required for functionality):
'       ETR_ReptLevel: Report level for the report
'       ETR_YrQtr: Year-Quarter for the report
'       ETR_Path: Path of ETR directory
'       ETR_Country: Country name
'       ETR_Officer: Requesting user
'       ETR_EntityCode: Requesting report level

Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpRetunedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private mstrIniFile As String           '   ini file loc

Private mstrAltMode As String           '   Alt mode from command line
Private mstrPermVar As String           '   Permanent variable from command line
Private mstrRptLev As String            '   Entity from command line
Private mstrYrQtr As String             '   Year-Quarter from command line
Private mstrETRPath As String           '   ETR Path from command line

Private mdbReports As Database          '   Database for ETR_Reports
Private mrsReports As Recordset         '   Recordset for ReportTypes

Private mlngNMatch As Long              '   Number of records
Private mlngNSearch As Long             '   Number of matching records
Private mstrPMatch As String            '   Percent of matching records
Private mstrzParams As Collection       '   Parameters for substitution

Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String) As Long
Private Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Private Declare Function GetModuleFileName Lib "kernel32" Alias "GetModuleFileNameA" (ByVal hModule As Long, ByVal lpFileName As String, ByVal nSize As Long) As Long
Private Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Const GWL_HINSTANCE = (-6)

Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const REG_SZ = 1&                         ' Unicode nul terminated string

Private mobjaWindow() As cWindow
Public Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long

Private mobjRepMan As EIREPMAN.EpiReportManager              '   report manager

Public Sub Main()
Dim s As String
Dim i As Integer
Dim lstrError As String
Dim lbolChecking As Boolean


    On Error GoTo Main_Error
    mstrAltMode = Trim$(Command$())
    i = InStr(mstrAltMode, " ")
    If i <> 2 Then
        lstrError = "Report Type invalid"
    Else
        mstrPermVar = Trim$(Mid$(mstrAltMode, 3))
        mstrAltMode = Left$(mstrAltMode, 1)
        mstrRptLev = GetPermVar("ETR_ReportLevel")
        If (Len(mstrRptLev) Mod 3 <> 0) Or (Len(mstrRptLev) = 0) Then
            lstrError = "Report Level invalid"
        Else
            mstrYrQtr = GetPermVar("ETR_YrQtr")
            mstrETRPath = GetPermVar("ETR_Path")
            If Right$(mstrETRPath, 1) <> "\" Then mstrETRPath = mstrETRPath & "\"
            If Len(mstrYrQtr) <> 6 Or Mid$(mstrYrQtr, 5, 1) <> "/" Then
                lstrError = "Report Year-Quarter invalid"
            Else
                s = mstrETRPath & "DATA\ETR_REPORTS.MDB"
                If Len(Dir$(s)) = 0 Then
                    lstrError = "ETR Path invalid"
                Else
                    lbolChecking = True
                    Set mdbReports = OpenDatabase(s)
                    If Not lbolChecking Then
                        lstrError = "Cannot open reports database"
                    Else
                        s = "SELECT * FROM ReptTypes WHERE AltMode=""" & mstrAltMode & """"
                        Set mrsReports = mdbReports.OpenRecordset(s, dbOpenDynaset, dbReadOnly)
                        If Not lbolChecking Then
                            lstrError = "Cannot open reports table"
                            mdbReports.Close
                        Else
                            If Not mrsReports.EOF Then mrsReports.MoveLast
                            Select Case mrsReports.RecordCount
                            Case 0
                                lstrError = "No reports of this type"
                            Case 1
                                RunReport
                                WritePrivateProfileString "VARIABLES", mstrPermVar, "0", mstrIniFile
                            Case Else
                                RunSelReport
                            End Select
                            If mrsReports Is Nothing Then
                                lstrError = "Cannot re-open reports table"
                                WritePrivateProfileString "VARIABLES", mstrPermVar, "0", mstrIniFile
                            Else
                                mrsReports.Close
                            End If
                            If mdbReports Is Nothing Then
                                lstrError = "Cannot re-open reports database"
                                WritePrivateProfileString "VARIABLES", mstrPermVar, "0", mstrIniFile
                            Else
                                mdbReports.Close
                            End If
                        End If
                    End If
                End If
            End If
        End If
    End If
Main_Exit:
    If Len(lstrError) <> 0 Then
        MsgBox "Program failure: " & lstrError, vbOKOnly + vbMsgBoxSetForeground, "TB Patient Listing"
    End If
    Set mobjRepMan = Nothing
    Set mrsReports = Nothing
    Set mdbReports = Nothing
    Exit Sub
Main_Error:
    Debug.Print Err.Number, Err.Description
    Debug.Assert False
    If lbolChecking Then
        lbolChecking = False
        Resume Next
    End If
    lstrError = Err.Number & vbCrLf & Err.Description
    Resume Main_Exit
    Resume
End Sub

Private Sub RunSelReport()
    Load fSelRpt
    With Forms(Forms.Count - 1)
        mrsReports.MoveFirst
        Do
            .lstRpt.AddItem mrsReports!reptdesc
            mrsReports.MoveNext
        Loop Until mrsReports.EOF
        .Show vbModal
        If .mbolExit Then
            WritePrivateProfileString "VARIABLES", mstrPermVar, "0", mstrIniFile
        Else
            mrsReports.FindFirst "reptdesc = """ & .lstRpt.List(.lstRpt.ListIndex) & """"
            If Not mrsReports.NoMatch Then RunReport
        End If
    End With
    Unload fSelRpt
End Sub

Private Sub RunReport()
Const RGINTBL1 = "PatientList"
Const RGINTBL2 = "DataCheck"
Const GETDENOM = "TBPLDen1"
Dim lbolChecking As Boolean
Dim i As Integer
Dim j As Integer
Dim s As String
Dim fh As Integer
Dim lstrLine As String
Dim lstrDenom As String
Dim ldatCatDate As Date
Dim llngNumRecs As Long
Dim llngNumSel As Long
Dim lstrSQL As String
Dim lrs As DAO.Recordset
Dim lstrErrMsg As String

    On Error GoTo ErrGenListing
    
    lbolChecking = True                 '   Delete any existing table
    mdbReports.TableDefs.Delete IIf(mstrAltMode = "L", RGINTBL1, RGINTBL2)
    lbolChecking = False
        
    If (mstrAltMode = "L") Then   '   Get the denom number of records for lists
'MsgBox "Generating the denominator", vbMsgBoxSetForeground, "GenListing"
        With mdbReports.QueryDefs(GETDENOM)
            .Parameters.Refresh
            .Parameters!RptLvl = mstrRptLev & "*"
            .Parameters!SelYrQtr = mstrYrQtr
            Set lrs = .OpenRecordset(dbOpenSnapshot, dbReadOnly)
            llngNumRecs = lrs(0)
            lrs.Close
            Set lrs = Nothing
        End With
    End If
    
'   Create the temporary table
'MsgBox "Creating the temporary table", vbMsgBoxSetForeground, "GenListing"
    lstrSQL = mdbReports.QueryDefs(mrsReports!AltTemplate).SQL  '   Get the query
    lstrSQL = Replace$(lstrSQL, "( 255 )", "")
    If (Len(mrsReports!WhereClause) <> 0) Then           '   If it's a patient listing, get ready for the real query
        i = InStr(lstrSQL, "ORDER BY")
        If i = 0 Then
'MsgBox "No ORDER BY clause", vbMsgBoxSetForeground, "GenListing"
            GoTo Cleanup
        End If
        lstrSQL = Left$(lstrSQL, i - 1) & " AND (" & mrsReports!WhereClause & ") " & Mid$(lstrSQL, i)
    End If
    With mdbReports.CreateQueryDef("", lstrSQL)
'        .SQL = lstrSQL
        .Parameters.Refresh
        lbolChecking = True
        .Parameters!RptLvl = mstrRptLev & "*"
        lbolChecking = True
       .Parameters!SelYrQtr = mstrYrQtr
        lbolChecking = False
        .Execute
        llngNumSel = .RecordsAffected
    End With
    mdbReports.TableDefs.Refresh
    If llngNumSel = 0 Then
        MsgBox "No records meet selection criteria", vbMsgBoxSetForeground, "TB Patient Listing"
        GoTo Cleanup
    End If
    '   set the values for substitution
'MsgBox "Updating the report parameters table", vbMsgBoxSetForeground, "GenListing"
    mlngNMatch = llngNumSel
    If (mstrAltMode = "L") Then           '   if it's a patient listing
        mlngNSearch = llngNumRecs
        If llngNumRecs = 0 Then
            mstrPMatch = ""
        Else
            mstrPMatch = Format$(llngNumSel / llngNumRecs * 100, "0")
        End If
    End If
    
    If Not ProcessEpiReport(mrsReports!ReptTemplate) Then     '   Do the substitution
        MsgBox "Cannot prepare report template", , "TB Patient Listing"
        GoTo Cleanup
    End If
    
    s = mrsReports!ReptTemplate
    mrsReports.Close                  '   Close the DB to avoid ADO/DAO issues
    Set mrsReports = Nothing
    mdbReports.Close
    Set mdbReports = Nothing
    DoEvents
'MsgBox "Creating the report manager object", vbMsgBoxSetForeground, "GenListing"
    Set mobjRepMan = New EIREPMAN.EpiReportManager
    App.OleRequestPendingMsgText = "The program is generating a report." & Chr$(10) & "Please choose the Print Preview icon from the task bar."
    App.OleRequestPendingMsgTitle = "TB Register"
    With mobjRepMan                 '   Open the report in print preview
        lstrErrMsg = "Open Template"
'MsgBox s & vbCrLf & IIf(mobjRepMan Is Nothing, "No RepMan", "RepMan Exists"), vbMsgBoxSetForeground, "Debug"
        .OpenReportTemplate s
        lstrErrMsg = "Designer Visible False"
        .DesignerVisible = False
        lstrErrMsg = "Preview Report"
        .PreviewReportTemplate s
        j = 0
        Do
            ListChildWindows
            For i = UBound(mobjaWindow) To 0 Step -1
                If mobjaWindow(i).sCaption = "Print Preview" Then Exit For
            Next i
            j = j + 1
        Loop Until (i < 0) Or (j = 10)
        If i >= 0 Then SetForegroundWindow mobjaWindow(i).hWnd
        lstrErrMsg = "Wait for Preview"
        .WaitForPreviewClose s, 0
        lstrErrMsg = ""
        .CloseReportTemplate s
        .CloseDesigner
    End With
    
Cleanup:
'   Deal with the RepMan object
    If Len(lstrErrMsg) <> 0 Then
        MsgBox "Error in Report Generator: " & lstrErrMsg, vbMsgBoxSetForeground, "TB Patient Listing"
    End If
    Set mobjRepMan = Nothing
'   Reopen the DB if it got closed
    On Error Resume Next
    Err.Clear
    If mdbReports Is Nothing Then
        Set mdbReports = OpenDatabase(mstrETRPath & "DATA\ETR_REPORTS.MDB")
        If Err.Number = 0 Then
            s = "SELECT * FROM ReptTypes WHERE AltMode=""" & mstrAltMode & """"
            Set mrsReports = mdbReports.OpenRecordset(s, dbOpenDynaset, dbReadOnly)
        End If
    End If
    If mrsReports Is Nothing Then
        s = "SELECT * FROM ReptTypes WHERE AltMode=""" & mstrAltMode & """"
        Set mrsReports = mdbReports.OpenRecordset(s, dbOpenDynaset, dbReadOnly)
    End If
    Exit Sub
ErrGenListing:
    If lbolChecking Then
        lbolChecking = False
        Resume Next
    End If
'MsgBox "Error " & Err.Number & ": " & Err.Description, vbMsgBoxSetForeground, "GenListing"
    Debug.Print Err.Number, Err.Description
    Debug.Assert False
    Resume Cleanup
    Resume
End Sub

'--------------------------------------------------------
'mPatLst.bas : ProcessRTFFile
'Description: Substitutes in RTF file
'Arguments: pstrFile - RTF file path
'Return: True for success, false for error
'Side Effects: Existing file is renamed .bak, new substituted file is .rtf
'--------------------------------------------------------
Private Function ProcessRTFFile(pstrFile As String) As Boolean
Const INSTTAG = "\fldinst"
Const RSLTTAG = "\fldrslt"
Dim lbolChecking As Boolean
Dim i As Integer
Dim j As Integer
Dim s As String
Dim fhin As Integer
Dim fhout As Integer
Dim lstrSub As String

    On Error GoTo ErrProcessRTFFile
    
'   Name the backup file, kill it if it exists, and open the two files
    s = Left$(pstrFile, Len(pstrFile) - 3) & "bak"
    lbolChecking = True
    Kill s
    Name pstrFile As s
    fhin = FreeFile
    Open s For Input As #fhin
    fhout = FreeFile
    Open pstrFile For Output As #fhout
    
'   Step through the file, performing substitutions as necessary
    Do While Not EOF(fhin)
        Line Input #fhin, s
        i = InStr(s, INSTTAG)
        Do While i <> 0             '   For each field instance tag
            j = InStr(i, s, "}")    '   Find the end of the tag
            If j = 0 Then
                j = Len(s)          '   Unterminated tag
            Else
                lstrSub = Trim$(Mid$(s, i + Len(INSTTAG) + 2, j - i - Len(INSTTAG) - 3)) '   Get the field name
                lbolChecking = True                         '   Get its value
                lstrSub = mstrzParams.Item(lstrSub)
                If lbolChecking Then
                    lbolChecking = False
                Else
                    lstrSub = ""
                End If
                i = InStr(j + 1, s, RSLTTAG)    '   Find the instance tag
                If i = 0 Then
                    j = Len(s)      '   Instance tag without result tag
                Else
                    j = InStr(i, s, "}") '   Find end of result tag
                    If j = 0 Then
                        j = Len(s)      '   Unterminated tag
                    Else
                        s = Left$(s, i + Len(RSLTTAG) + 1) & lstrSub & Mid$(s, j)
'                        Mid$(s, i + Len(RSLTTAG) + 2, j - i - Len(RSLTTAG) - 2) = lstrSub
                        j = InStr(i, s, "}") '   Find new end of result tag
                    End If
                End If
            End If
            i = InStr(j + 1, s, INSTTAG)    '   On to the next tag
        Loop
        Print #fhout, s
    Loop
    Close #fhin
    Close #fhout
    ProcessRTFFile = True

Cleanup:
    Exit Function
    
ErrProcessRTFFile:
    If lbolChecking Then
        lbolChecking = False
        Resume Next
    End If
    Debug.Print Err.Number, Err.Description
    Debug.Assert False
    Resume Cleanup
    Resume
End Function

'--------------------------------------------------------
'mPatLst.bas : ProcessEpiReport
'Description: Does one-time setup of report template if necessary, does substitutions in rtf files
'Arguments: pstrEpiReport - name of the epireport (just the name, no path or suffix)
'Return: True for success, false for error
'Side Effects: Rewrites report template if necessary, creates dir in etr\reports to show it's done
'--------------------------------------------------------
Private Function ProcessEpiReport(pstrEpiReport As String) As Boolean
Dim lbolChecking As Boolean
Dim i As Integer
Dim j As Integer
Dim s As String
Dim fh As Integer
Dim lstrHold As String
Dim lstrPath As String
Dim lstrFile As String
Dim lbolPhase2 As Boolean
Dim fd As Field
Dim rs As Recordset

    On Error GoTo ErrProcessEpiReport
    lstrPath = GetKeyValue(HKEY_LOCAL_MACHINE, "SOFTWARE\VB and VBA Program Settings\Epi_Info\Locations", "InstallDir", "*")
    If Not ((Mid$(lstrPath, 2, 2) = ":\") Or (Left$(lstrPath, 2) = "\\")) Then
        lstrPath = GetSetting("Epi_Info", "Locations", "installdir", "c:\epiinfo")
    End If
    If Right$(lstrPath, 1) <> "\" Then lstrPath = lstrPath & "\"
    lstrPath = lstrPath & "EpiReport\Templates\" & pstrEpiReport & "\"           '   Get oriented
    lstrFile = lstrPath & pstrEpiReport & ".ept"
    If Len(Dir$(mstrETRPath & "reports\" & pstrEpiReport, vbDirectory)) = 0 Then '   Do we have to do the one-time stuff?
        If Len(Dir$(lstrPath, vbDirectory)) = 0 Then GoTo Cleanup        '   Directory doesn't exist
        If Len(Dir$(lstrFile)) = 0 Then GoTo Cleanup '   Template doesn't exist
        fh = FreeFile
        Open lstrFile For Input As #fh       '   read up to the filename element
        Do While Not EOF(fh)
            Line Input #fh, s
Debug.Print s
            If Not lbolPhase2 Then
                i = InStr(s, "filename=")
                If i <> 0 Then
                    i = i + 10                          '   expect to find filename="file"
                    If InStr(i, s, lstrFile) <> i Then  '   pointing to another file
                        j = InStr(i, s, """")           '   find the end of the filename tag
                        If j = 0 Then
                            Close #fh
                            GoTo Cleanup
                        End If
                        Mid$(s, i, j - i) = lstrFile   '   insert the right filename
                    End If
                    lbolPhase2 = True
                End If
            End If
            s = Replace(s, "@@ETR_Path", mstrETRPath)   '   replace any path references
            lstrHold = lstrHold & IIf(Len(lstrHold) = 0, "", vbCrLf) & s
        Loop
        Close #fh
        Kill lstrFile                       '   replace the existing version
        Open lstrFile For Output As #fh
        Print #fh, lstrHold
        Close #fh
        MkDir mstrETRPath & "reports\" & pstrEpiReport    '   indicate replacement is done
    End If
    
    Set mstrzParams = New Collection        '   build the parameters collection
    For Each fd In mrsReports.Fields        '   first the fields in the repttypes table
        If fd.Type = dbText Then
            mstrzParams.Add fd.Value, fd.Name
        Else
            mstrzParams.Add Format$(fd.Value), fd.Name
        End If
    Next fd
    mstrzParams.Add Format$(mlngNMatch), "NMatch"       '   then the fields computed here
    mstrzParams.Add Format$(mlngNSearch), "NSearch"
    mstrzParams.Add mstrPMatch, "PMatch"
    mstrzParams.Add mstrRptLev, "ReptLev"               '   then the report parameters
    mstrzParams.Add Right$(mstrRptLev, 3), "ReptEntityCd"
    lbolChecking = True
    Set rs = mdbReports.OpenRecordset("SELECT entity_name FROM reporting_structure WHERE Rept_lev=""" & mstrRptLev & """")
    If lbolChecking Then
        lbolChecking = False
        If rs.EOF Then
            s = ""
        ElseIf IsNull(rs(0)) Then
            s = ""
        Else
            s = rs(0)
        End If
        rs.Close
    Else
        s = ""
    End If
    Set rs = Nothing
    mstrzParams.Add s, "ReptEntity"
    mstrzParams.Add mstrYrQtr, "ReptYrQtr"
    If Right$(mstrYrQtr, 1) = "*" Then
        mstrzParams.Add "All Quarters", "QtrLabel"
        mstrzParams.Add "", "ReptQtr"
    Else
        mstrzParams.Add "Quarter", "QtrLabel"
        mstrzParams.Add Right$(mstrYrQtr, 1), "ReptQtr"
    End If
    mstrzParams.Add Left$(mstrYrQtr, 4), "ReptYear"
    mstrzParams.Add Format$(Date, "Short Date"), "ReqDate"
    mstrzParams.Add GetPermVar("ETR_Country"), "Country"    '   then the permanent variables
    mstrzParams.Add GetPermVar("ETR_Officer"), "ReqUser"
    mstrzParams.Add GetPermVar("ETR_EntityCode"), "ReqReptLev"

    s = Dir$(lstrPath & "*.rtf")                     '   Process all the RTFs
    Do While Len(s) <> 0
        If Not ProcessRTFFile(lstrPath & s) Then Exit Do
        s = Dir$()
    Loop
    
    ProcessEpiReport = (Len(s) = 0)

Cleanup:
    Exit Function
    
ErrProcessEpiReport:
    If lbolChecking Then
        lbolChecking = False
        Resume Next
    End If
    Debug.Print Err.Number, Err.Description
    Debug.Assert False
    Resume Cleanup
    Resume
End Function

Public Function TestRTF(pstrFile As String) As Boolean
    TestRTF = ProcessRTFFile(pstrFile)
End Function

Private Function GetPermVar(pstrVarname As String, Optional pstrDefault As String = "") As String
Dim lstrRet As String
Dim llngSize As Long
    If Len(mstrIniFile) = 0 Then
        Load fProb
        mstrIniFile = fProb.Problem.IniPath
        Unload fProb
'        mstrIniFile = GetSetting("Epi_Info", "Locations", "IniPath", "C:\Epi_Info\")
        If Right$(mstrIniFile, 1) <> "\" Then mstrIniFile = mstrIniFile & "\"
        mstrIniFile = mstrIniFile & "epiinfo.ini"
    End If
    lstrRet = String$(255, Chr$(0))
    llngSize = GetPrivateProfileString("VARIABLES", pstrVarname, pstrDefault, lstrRet, 255, mstrIniFile)
    GetPermVar = Left$(lstrRet, llngSize)
End Function

Public Function ChildCallback(ByVal hWndChild As Long, lParam As Long) As Boolean
Dim loWindow As cWindow
Dim s As String
Dim llTemp As Long
Dim llPID As Long

    Set loWindow = New cWindow
    loWindow.hWnd = hWndChild
    
    s = String(255, " ")
    llTemp = GetWindowText(hWndChild, s, 254&)
    loWindow.sCaption = Left$(s, llTemp)
    
'    loWindow.hParent = GetParent(hWndChild)
'    If loWindow.hParent = 0 Then loWindow.hParent = mobjaWindow(0).hWnd
'
'    llTemp = GetWindowThreadProcessId(hWndChild, llPID)
'    loWindow.hProcess = llPID
'    loWindow.hThread = llTemp
'
'    llTemp = GetWindowLong(loWindow.hWnd, GWL_HINSTANCE)
'    If llTemp = 0 Then
'        s = String(255, " ")
'        llTemp = GetModuleFileName(llTemp, s, 254&)
'        If InStr(1, s, vbNullChar) > 0 Then loWindow.sModule = Left$(s, Len(s) - 1)
'    End If
    
    ReDim Preserve mobjaWindow(UBound(mobjaWindow) + 1)
    Set mobjaWindow(UBound(mobjaWindow)) = loWindow
    
    ChildCallback = True
End Function

Private Sub ListChildWindows()
Dim lhWndDesktop As Long
Dim loDesktop As cWindow
Dim i As Integer
Dim o As Object
Dim lbResult As Boolean

    ReDim mobjaWindow(0)
    
    Set loDesktop = New cWindow
    loDesktop.hWnd = GetDesktopWindow
    loDesktop.hParent = loDesktop.hWnd
    loDesktop.sCaption = "Windows Desktop"
    Set mobjaWindow(0) = loDesktop
    lbResult = EnumChildWindows(loDesktop.hWnd, AddressOf ChildCallback, 0&)
    
End Sub

Public Function GetKeyValue(plngKeyRoot As Long, pstrKeySection As String, pstrKey As String, pstrDefault As String) As String
Dim llngResult As Long
Dim lstrVal As String
Dim llngLen As Long
Dim llngKeyType As Long
Dim lhndRegKey As Long
Dim llngReserved As Long

    llngResult = RegOpenKey(plngKeyRoot, pstrKeySection, lhndRegKey)
    If llngResult = 0 Then
        lstrVal = String$(256, 0)
        llngLen = 255
        llngKeyType = REG_SZ
        llngResult = RegQueryValueEx(lhndRegKey, pstrKey, llngReserved, llngKeyType, lstrVal, llngLen)
        If llngResult <> 0 Then '   Couldn't find the key, get the disabled extensions
            lstrVal = pstrDefault
        Else
            lstrVal = Left$(lstrVal, llngLen - 1)
        End If
        RegCloseKey (lhndRegKey)
    Else
        lstrVal = pstrDefault
    End If

End Function